[BACK]Return to puks.tcl CVS log [TXT] [DIR] Up to [Local Repository] / tclpuks / prgsrc

Diff for /tclpuks/prgsrc/puks.tcl between versions 1.5 and 1.6

version 1.5, 2005/08/29 19:28:13 version 1.6, 2005/08/31 17:04:31
Line 9  set waiting_for_key 0 Line 9  set waiting_for_key 0
 set question_asked 0  set question_asked 0
 set timer_started 0  set timer_started 0
   
 # Channel to talk to the MRC device  # Channel to talk to the MCR device
 set MRC 0  set MCR 0
   set MCR_DEVICE "/dev/ttyUSB0"
   
 #  Mapping of MCR codes to keys:  button(code)  #  Mapping of MCR codes to keys:  button(code)
 set buttoncode 256  set buttoncode 256
Line 21  for {set i 1} {$i <=8} {incr i} { Line 22  for {set i 1} {$i <=8} {incr i} {
   
   
 ##############################################################  ##############################################################
 #  Procedures for talking with MRC  #  Procedures for talking with MCR
 ##############################################################  ##############################################################
   
 # Open the given device for MRC.  Return 0 if successful, 1 otherwise  # Open the given device for MCR.  Return 0 if successful, 1 otherwise
 proc open_mrc {device} {  proc open_mcr {device} {
     global MRC      global MCR
     set result [catch {set MRC [open $device r+]}]      set result [catch {set MCR [open $device r+]}  error] 
     if {$result !=0} {      if {$result !=0} {
           .status.mcr configure -text $error
           .status.mcr configure -fg red
         return $result          return $result
     }      }
     fconfigure $MRC -blocking 0  -translation binary \      fconfigure $MCR -blocking 0  -translation binary \
         -encoding binary -buffering none -mode  57600,n,8,1          -encoding binary -buffering none 
   #-mode  57600,n,8,1
       .status.mcr configure -text "Opened $device"
       .status.mcr configure -fg black
           
     puts $MRC s      puts $MCR s
     after 200      after 200
     read $MRC      read $MCR
     puts $MRC r      puts $MCR r
     after 200      after 200
     read $MRC      read $MCR
     return 0      return 0
 }  }
           
   
   
 # Return the key pressed or 0  # Return the list of key pressed or empty list
 proc readbuffer {} {  proc readbuffer {} {
     global MRC  button      global MCR  button
     set key 0      set keys ""
     set message [read $MRC]      set message [read $MCR 6]
     binary scan $message s key      while { [string length $message] > 0} {
     set key [expr $key & 0xFFFF]          binary scan $message b48 msg
     if {[catch {set key $button($key)}] == 0} {          .status.mcr -configure -text $msg
         return $key          .status.mcr -configure -fg black
           binary scan $message s key 
           set key [expr $key & 0xFFFF]
           if {[catch {set key $button($key)}] == 0} {
               lappend keys $key
           }
           set message [read $MCR 6]
     }      }
     return 0      return keys
   }
   
   # Dialog for opening the device
   proc open_mcr_dialog {} {
       toplevel .mcr_dialog
       label .mcr_dialog.label -text "Open MCR port:"
       entry .mcr_dialog.entry -textvariable MCR_DEVICE
       pack .mcr_dialog.label .mcr_dialog.entry
       frame .mcr_dialog.buttons
       pack .mcr_dialog.buttons
       button .mcr_dialog.buttons.ok -command {
           open_mcr $MCR_DEVICE
           destroy .mcr_dialog
       } -text OK
       button .mcr_dialog.buttons.cancel -command {destroy .mcr_dialog}\
           -text "Cancel"
       pack .mcr_dialog.buttons.ok .mcr_dialog.buttons.cancel -side left
 }  }
   
 ##############################################################  ##############################################################
Line 69  proc readbuffer {} { Line 98  proc readbuffer {} {
 menu .mbar -type menubar -relief ridge -borderwidth 2  menu .mbar -type menubar -relief ridge -borderwidth 2
 pack .mbar -fill x  pack .mbar -fill x
   
   
 menubutton .mbar.file -text File -menu .mbar.file.m -underline 0 \  menubutton .mbar.file -text File -menu .mbar.file.m -underline 0 \
         -relief raised -borderwidth 2          -relief raised -borderwidth 2
 pack .mbar.file -side left   pack .mbar.file -side left 
Line 83  menubutton .mbar.edit -text Edit -underl Line 113  menubutton .mbar.edit -text Edit -underl
         -relief raised -borderwidth 2          -relief raised -borderwidth 2
 pack .mbar.edit -side left  pack .mbar.edit -side left
   
   menubutton .mbar.mcr -text "MCR" -menu .mbar.mcr.m -underline 0 \
       -relief raised -borderwidth 2
   pack .mbar.mcr -side left
   set m [menu .mbar.mcr.m]
   $m add command -label "Open MCR" -command open_mcr_dialog
   
 menubutton .mbar.help -text Help -menu .mbar.help.m -underline 0\  menubutton .mbar.help -text Help -menu .mbar.help.m -underline 0\
         -relief raised -borderwidth 2          -relief raised -borderwidth 2
 pack .mbar.help -side right  pack .mbar.help -side right
Removed from v.1.5  
changed lines
  Added in v.1.6

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