Annotation of tclpuks/prgsrc/puks.tcl, revision 1.3
1.2 boris 1: #!/usr/bin/wish
2:
1.3 ! boris 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
1.2 boris 11:
1.3 ! boris 12: # Channel to talk to the MRC device
! 13: set MRC 0
1.2 boris 14:
1.3 ! boris 15: # Mapping of MCR codes to keys: button(code)
1.2 boris 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:
1.3 ! boris 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
1.2 boris 49: proc readbuffer {} {
1.3 ! boris 50: global MRC button
1.2 boris 51: set key 0
1.3 ! boris 52: set message [read $MRC]
1.2 boris 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:
1.3 ! boris 61: ##############################################################
! 62: # Setup
! 63: ##############################################################
1.2 boris 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 } {
1.3 ! boris 84: # set state $idle
! 85: # .start configure -state active -command start
1.2 boris 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:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>