Diff for /tclpuks/prgsrc/puks.tcl between versions 1.2 and 1.3

version 1.2, 2005/08/27 05:31:18 version 1.3, 2005/08/29 14:22:27
Line 1 Line 1
 #!/usr/bin/wish  #!/usr/bin/wish
 set DEVICE "/dev/ttyUSB0"  
   
 set SRLFILE [open $DEVICE r+]  ##############################################################
 fconfigure $SRLFILE -blocking 0  -translation binary -encoding binary -buffering none -mode  57600,n,8,1  #    Global flags and variables
   ##############################################################
 set idle 0  
 set waiting 1  # Flags
   set waiting_for_key 0
 set state $idle  set question_asked 0
   set timer_started 0
   
   # Channel to talk to the MRC device
   set MRC 0
   
   #  Mapping of MCR codes to keys:  button(code)
 set buttoncode 256  set buttoncode 256
 for {set i 1} {$i <=8} {incr i} {  for {set i 1} {$i <=8} {incr i} {
     set button($buttoncode) $i      set button($buttoncode) $i
     set buttoncode [expr $buttoncode*2]      set buttoncode [expr $buttoncode*2]
 }  }
   
   
   ##############################################################
   #  Procedures for talking with MRC
   ##############################################################
   
   # Open the given device for MRC.  Return 0 if successful, 1 otherwise
   proc open_mrc {device} {
       global MRC
       set result [catch {set MRC [open $device r+]}]
       if {$result !=0} {
           return $result
       }
       fconfigure $MRC -blocking 0  -translation binary \
           -encoding binary -buffering none -mode  57600,n,8,1
       
       puts $MRC s
       after 200
       read $MRC
       puts $MRC r
       after 200
       read $MRC
       return 0
   }
       
   
   
   # Return the key pressed or 0
 proc readbuffer {} {  proc readbuffer {} {
     global SRLFILE  button      global MRC  button
     set key 0      set key 0
     set message [read $SRLFILE]      set message [read $MRC]
     binary scan $message s key      binary scan $message s key
     set key [expr $key & 0xFFFF]      set key [expr $key & 0xFFFF]
     if {[catch {set key $button($key)}] == 0} {      if {[catch {set key $button($key)}] == 0} {
Line 28  proc readbuffer {} { Line 58  proc readbuffer {} {
     return 0      return 0
 }  }
   
 puts $SRLFILE s  ##############################################################
 after 200  #   Setup
 readbuffer  ##############################################################
 puts $SRLFILE r  
 after 200  
 readbuffer  
   
   
   
 button .start -text "Start" -command start  button .start -text "Start" -command start
 pack .start  pack .start
Line 56  proc body  {} { Line 81  proc body  {} {
     if { $state == $waiting } {      if { $state == $waiting } {
         set pressed [readbuffer]          set pressed [readbuffer]
         if { $pressed != 0 } {          if { $pressed != 0 } {
             set state $idle  #           set state $idle
             .start configure -state active -command start  #           .start configure -state active -command start
             .pressed configure -text "Pressed $pressed"              .pressed configure -text "Pressed $pressed"
             puts $pressed              puts $pressed
             readbuffer  }              readbuffer  }

Removed from v.1.2  
changed lines
  Added in v.1.3


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>