--- tclpuks/prgsrc/puks.tcl 2005/08/26 00:36:53 1.1 +++ tclpuks/prgsrc/puks.tcl 2005/08/29 14:22:27 1.3 @@ -0,0 +1,100 @@ +#!/usr/bin/wish + +############################################################## +# Global flags and variables +############################################################## + +# Flags +set waiting_for_key 0 +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 +for {set i 1} {$i <=8} {incr i} { + set button($buttoncode) $i + 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 {} { + global MRC button + set key 0 + set message [read $MRC] + binary scan $message s key + set key [expr $key & 0xFFFF] + if {[catch {set key $button($key)}] == 0} { + return $key + } + return 0 +} + +############################################################## +# Setup +############################################################## + +button .start -text "Start" -command start +pack .start +label .pressed +pack .pressed + + +proc start {} { + global SRLFILE state idle waiting + readbuffer + .start configure -state disabled -command {} + set state $waiting +} + +proc body {} { + global state idle waiting + update idletasks + if { $state == $waiting } { + set pressed [readbuffer] + if { $pressed != 0 } { +# set state $idle +# .start configure -state active -command start + .pressed configure -text "Pressed $pressed" + puts $pressed + readbuffer } + } else { + readbuffer + } + after 10 body +} + +body + + + + +