Return to puks.tcl CVS log

Up to [Local Repository] / tclpuks / prgsrc

Added

    1: #!/usr/bin/wish
    2: 
    3: ##############################################################
    4: #    Global flags and variables
    5: ##############################################################
    6: 
    7: # Flags
    8: set waiting_for_key 0
    9: set question_asked 0
   10: set timer_started 0
   11: 
   12: # Channel to talk to the MRC device
   13: set MRC 0
   14: 
   15: #  Mapping of MCR codes to keys:  button(code)
   16: set buttoncode 256
   17: for {set i 1} {$i <=8} {incr i} {
   18:     set button($buttoncode) $i
   19:     set buttoncode [expr $buttoncode*2]
   20: }
   21: 
   22: 
   23: ##############################################################
   24: #  Procedures for talking with MRC
   25: ##############################################################
   26: 
   27: # Open the given device for MRC.  Return 0 if successful, 1 otherwise
   28: proc open_mrc {device} {
   29:     global MRC
   30:     set result [catch {set MRC [open $device r+]}]
   31:     if {$result !=0} {
   32: 	return $result
   33:     }
   34:     fconfigure $MRC -blocking 0  -translation binary \
   35: 	-encoding binary -buffering none -mode  57600,n,8,1
   36:     
   37:     puts $MRC s
   38:     after 200
   39:     read $MRC
   40:     puts $MRC r
   41:     after 200
   42:     read $MRC
   43:     return 0
   44: }
   45:     
   46: 
   47: 
   48: # Return the key pressed or 0
   49: proc readbuffer {} {
   50:     global MRC  button
   51:     set key 0
   52:     set message [read $MRC]
   53:     binary scan $message s key
   54:     set key [expr $key & 0xFFFF]
   55:     if {[catch {set key $button($key)}] == 0} {
   56: 	return $key
   57:     }
   58:     return 0
   59: }
   60: 
   61: ##############################################################
   62: #   Setup
   63: ##############################################################
   64: 
   65: button .start -text "Start" -command start
   66: pack .start
   67: label .pressed 
   68: pack .pressed
   69: 
   70: 
   71: proc start {} {
   72:     global SRLFILE state idle waiting
   73:     readbuffer
   74:     .start configure -state disabled -command {}
   75:     set state $waiting
   76: }
   77: 
   78: proc body  {} {
   79:     global state idle waiting
   80:     update idletasks
   81:     if { $state == $waiting } {
   82: 	set pressed [readbuffer]
   83: 	if { $pressed != 0 } {
   84: #	    set state $idle
   85: #	    .start configure -state active -command start
   86: 	    .pressed configure -text "Pressed $pressed"
   87: 	    puts $pressed
   88: 	    readbuffer	}
   89:     } else {
   90: 	readbuffer
   91:     }
   92:     after 10 body
   93: }
   94: 
   95: body 
   96: 
   97: 
   98: 
   99: 
  100: