[LON-CAPA-cvs] cvs: modules /albertel scanner.tcl

[albertel]

albertel		Sun Feb  8 01:17:23 2004 EDT

  Modified files:              
    /modules/albertel	scanner.tcl 
  Log:
  - better support for some of the commands, now know which commands send back data and reads it
  - interprets the "q" (status) command
  
  - still doesn't support diagnostc mode, and probably should always reset the scanner to a knwon state on startup.
  
  
  
Index: modules/albertel/scanner.tcl
diff -u modules/albertel/scanner.tcl:1.1 modules/albertel/scanner.tcl:1.2
--- modules/albertel/scanner.tcl:1.1	Sun Feb  8 00:04:37 2004
+++ modules/albertel/scanner.tcl	Sun Feb  8 01:17:23 2004
@@ -133,6 +133,7 @@
 
 proc readdata {} {
     global scanner
+    puts "readdata"
     while { 1 } {
 	append line [read $scanner]
 	set lastchar [string index $line end]
@@ -153,8 +154,118 @@
 
 proc sendcommand { command } {
     global scanner
-    puts -nonewline $scanner $command
-    flush $scanner
+    for { set i 0 } {$i < [string length $command]} {incr i} {
+	set command [string index $command $i]
+	switch $command {
+	    0 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - e - a - g - h - k - n - o - y {
+		puts -nonewline $scanner $command
+		flush $scanner
+	    }
+	    v - w - p - t - + - - {
+		disableexamscan
+		puts -nonewline $scanner $command
+		flush $scanner
+		after 300
+		while {1} {
+		    set current [read $scanner]
+		    append result $current
+		    if {$current == ""} { break }
+		    after 10
+		}
+		puts "Returned \n$result"
+		enableexamscan
+	    }
+	    q {
+		disableexamscan
+		puts -nonewline $scanner $command
+		flush $scanner
+		after 300
+		while {1} {
+		    set current [read $scanner]
+		    append result $current
+		    if {$current == ""} { break }
+		    after 10
+		}
+		binary scan $result b1b* escape binary
+		puts "$binary"
+		if { [string index $binary 0] == 1 } {
+		    puts "Rear:\t   Covered"
+		} else {
+		    puts "Rear:\t   Empty"
+		}
+		if { [string index $binary 1] == 1 } {
+		    puts "Front:\t   Covered"
+		} else {
+		    puts "Front:\t   Empty"
+		}
+		if { [string index $binary 2] == 0 } {
+		    puts "Data:\t   On-clock"
+		} else {
+		    puts "Data:\t   Between-clock"
+		}
+		if { [string index $binary 3] == 1 } {
+		    puts "Document:  Escrow"
+		} else {
+		    puts "Document:  None"
+		}
+		if { [string index $binary 4] == 1 } {
+		    puts "Mode:\t   Diagnostic"
+		} else {
+		    puts "Mode:\t   User"
+		}
+		if { [string index $binary 5] == 1 } {
+		    puts "Scanner:   Enabled"
+		} else {
+		    puts "Scanner:   Disabled"
+		}
+		if { [string index $binary 6] == 1 } {
+		    puts "Path:\t   Jammed"
+		} else {
+		    puts "Path:\t   Clear"
+		}
+		if { [string index $binary 7] == 1 } {
+		    puts "Device:\t   Ready"
+		} else {
+		    puts "Device:\t   Not Ready"
+		}
+		if { [string index $binary 8] == 1 } {
+		    puts "Device:\t   Ready"
+		} else {
+		    puts "Device:\t   Not Ready"
+		}
+		if { [string index $binary 9] == 1 } {
+		    puts "Clock:\t   Test for channel"
+		} else {
+		    puts "Clock:\t   Static channel"
+		}
+		if { [string index $binary 10] == 1 } {
+		    puts "Receipt:   Enabled"
+		} else {
+		    puts "Receipt:   Disabled"
+		}
+		if { [string index $binary 11] == 1 } {
+		    puts "Eject:\t   Auto"
+		} else {
+		    puts "Eject:\t   Command (Escrow)"
+		}
+		if { [string index $binary 12] == 1 } {
+		    puts "Form Read: Whenever one is inserted"
+		} else {
+		    puts "Form Read: Only when commanded (8) too"
+		}
+		# bits 13 and 14 have no meaning
+		if { [string index $binary 15] == 1 } {
+		    puts "Clock:\t   Left"
+		} else {
+		    puts "Clock:\t   Right"
+		}
+		enableexamscan
+	    }
+	    default {
+		puts "Ignoring command $command"
+	    }
+	}
+    }
 }
 
 proc readcommand {} {
@@ -166,11 +277,21 @@
 	}
 	s* {
 	    set command [string range $line 1 end]
-	    puts "sending command to scanner $command"
 	    sendcommand $command
-	    puts "sent"
 	}
     }
+}
+
+proc enableexamscan {} {
+    global scanner
+    fileevent $scanner readable readdata
+    fconfigure $scanner -blocking 0 -translation binary
+}
+
+proc disableexamscan {} {
+    global scanner
+    fileevent $scanner readable ""
+#    fconfigure $scanner -blocking 1 -translation auto
 }
 
 proc main {} {