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 MCR device
13: set MCR 0
14: set MCR_DEVICE "/dev/ttyUSB0"
15:
16: # Mapping of MCR codes to keys: button(code)
17: set buttoncode 256
18: for {set i 1} {$i <=8} {incr i} {
19: set button($buttoncode) $i
20: set buttoncode [expr $buttoncode*2]
21: }
22:
23:
24: ##############################################################
25: # Procedures for talking with MCR
26: ##############################################################
27:
28: # Open the given device for MCR. Return 0 if successful, 1 otherwise
29: proc open_mcr {device} {
30: global MCR
31: set result [catch {set MCR [open $device r+]} error]
32: if {$result !=0} {
33: .status.mcr configure -text $error
34: .status.mcr configure -fg red
35: return $result
36: }
37: fconfigure $MCR -blocking 0 -translation binary \
38: -encoding binary -buffering none
39: #-mode 57600,n,8,1
40: .status.mcr configure -text "Opened $device"
41: .status.mcr configure -fg black
42:
43: puts $MCR s
44: after 200
45: read $MCR
46: puts $MCR r
47: after 200
48: read $MCR
49: return 0
50: }
51:
52:
53:
54: # Return the list of key pressed or empty list
55: proc readbuffer {} {
56: global MCR button
57: set keys ""
58: set message [read $MCR 6]
59: while { [string length $message] > 0} {
60: binary scan $message b48 msg
61: .status.mcr -configure -text $msg
62: .status.mcr -configure -fg black
63: binary scan $message s key
64: set key [expr $key & 0xFFFF]
65: if {[catch {set key $button($key)}] == 0} {
66: lappend keys $key
67: }
68: set message [read $MCR 6]
69: }
70: return keys
71: }
72:
73: # Dialog for opening the device
74: proc open_mcr_dialog {} {
75: toplevel .mcr_dialog
76: label .mcr_dialog.label -text "Open MCR port:"
77: entry .mcr_dialog.entry -textvariable MCR_DEVICE
78: pack .mcr_dialog.label .mcr_dialog.entry
79: frame .mcr_dialog.buttons
80: pack .mcr_dialog.buttons
81: button .mcr_dialog.buttons.ok -command {
82: open_mcr $MCR_DEVICE
83: destroy .mcr_dialog
84: } -text OK
85: button .mcr_dialog.buttons.cancel -command {destroy .mcr_dialog}\
86: -text "Cancel"
87: pack .mcr_dialog.buttons.ok .mcr_dialog.buttons.cancel -side left
88: }
89:
90: ##############################################################
91: # Setup
92: ##############################################################
93:
94:
95:
96: # Main menu
97:
98: menu .mbar -type menubar -relief ridge -borderwidth 2
99: pack .mbar -fill x
100:
101:
102: menubutton .mbar.file -text File -menu .mbar.file.m -underline 0 \
103: -relief raised -borderwidth 2
104: pack .mbar.file -side left
105: set m [menu .mbar.file.m]
106: $m add command -label "Open" -state disabled
107: $m add command -label "Save as..." -state disabled
108: $m add command -label "Save" -state disabled
109: $m add separator
110: $m add command -label "Quit" -command exit
111:
112: menubutton .mbar.edit -text Edit -underline 0 -state disabled\
113: -relief raised -borderwidth 2
114: pack .mbar.edit -side left
115:
116: menubutton .mbar.mcr -text "MCR" -menu .mbar.mcr.m -underline 0 \
117: -relief raised -borderwidth 2
118: pack .mbar.mcr -side left
119: set m [menu .mbar.mcr.m]
120: $m add command -label "Open MCR" -command open_mcr_dialog
121:
122: menubutton .mbar.help -text Help -menu .mbar.help.m -underline 0\
123: -relief raised -borderwidth 2
124: pack .mbar.help -side right
125: set m [menu .mbar.help.m]
126: $m add command -label "About..." -command {
127: tk_dialog .about "About Puks" \
128: "Система управления кнопками.
129: (C) Teytelman, 2002 (MCR code)
130: (C) Boris Veytsman, 2005 (Tcl/Tk version)"\
131: info 0 "OK"}
132:
133:
134: #Teams
135: frame .teams
136: pack .teams -side top
137: for {set i 0} {$i < 8} {incr i} {
138: frame .teams.frame($i)
139: pack .teams.frame($i) -side top -fill x
140: label .teams.frame($i).button -text 0
141: pack .teams.frame($i).button -side left
142: entry .teams.frame($i).name -width 60 -textvariable name($i)
143: pack .teams.frame($i).name -side left
144: entry .teams.frame($i).score -width 6 -textvariable score($i)
145: pack .teams.frame($i).score -side left
146: }
147:
148:
149: # Question weight
150: frame .weight
151: set weight 1
152: set doubled 0
153: pack .weight -side top -fill x
154: label .weight.label -text "Цена вопроса"
155: entry .weight.weight -textvariable weight -width 3
156: checkbutton .weight.doubled -variable doubled
157: label .weight.label2 -text "x2"
158: pack .weight.label .weight.weight .weight.doubled .weight.label2 -side left
159:
160: # Buttons and timer
161: frame .control
162: pack .control -side top -fill x
163: frame .control.buttons
164: pack .control.buttons -side left -fill y
165:
166: button .control.buttons.assign -text "Assign Buttons" -underline 0 -state disabled
167: pack .control.buttons.assign -fill both -side top
168: bind Button <a> {.control.buttons.assign invoke}
169:
170: button .control.buttons.start -text Start -underline 0 -command "puts A"
171: pack .control.buttons.start -fill both -side top
172: bind Button <s> {.control.buttons.start invoke}
173:
174: button .control.buttons.stop -text Stop -underline 1 -command "puts B" -state disabled
175: pack .control.buttons.stop -fill both -side top
176: bind Button <t> {.control.buttons.stop invoke}
177:
178: button .control.buttons.reset -text "Reset scores" -underline 0 -state disabled
179: pack .control.buttons.reset -fill both -side top
180: bind Button <r> {.control.buttons.reset invoke}
181:
182:
183:
184: option add *timer.font -*-palatino-*-r-normal--*-1200-*-*-*-*-*-* widgetDefault
185: label .control.timer -text 0 -border 5 -relief raised -borderwidth 2
186: pack .control.timer -side left -expand 1 -fill x
187:
188: # Status line
189: frame .status -relief sunk -borderwidth 2
190: pack .status -side top -fill x
191: label .status.mcr -relief ridge -text "Not connected" -fg red -width 48
192: pack .status.mcr -side left -fill x
193: label .status.state -relief ridge -text "Idle"
194: pack .status.state -side left -fill x
195:
196:
197: # button .start -text "Start" -command start
198: # pack .start
199: # label .pressed
200: # pack .pressed
201:
202:
203: proc start {} {
204: global SRLFILE state idle waiting
205: readbuffer
206: .start configure -state disabled -command {}
207: set state $waiting
208: }
209:
210: proc body {} {
211: global state idle waiting
212: update idletasks
213: if { $state == $waiting } {
214: set pressed [readbuffer]
215: if { $pressed != 0 } {
216: # set state $idle
217: # .start configure -state active -command start
218: .pressed configure -text "Pressed $pressed"
219: puts $pressed
220: readbuffer }
221: } else {
222: readbuffer
223: }
224: after 10 body
225: }
226:
227: #body
228:
229:
230:
231:
232:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>