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 MRC device
13: set MRC 0
14:
15: # Mapping of MCR codes to keys: button(code)
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:
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
49: proc readbuffer {} {
50: global MRC button
51: set key 0
52: set message [read $MRC]
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:
61: ##############################################################
62: # Setup
63: ##############################################################
64:
65:
66:
67: # Main menu
68:
69: menu .mbar -type menubar -relief ridge -borderwidth 2
70: pack .mbar -fill x
71:
72: menubutton .mbar.file -text File -menu .mbar.file.m -underline 0 \
73: -relief raised -borderwidth 2
74: pack .mbar.file -side left
75: set m [menu .mbar.file.m]
76: $m add command -label "Open" -state disabled
77: $m add command -label "Save as..." -state disabled
78: $m add command -label "Save" -state disabled
79: $m add separator
80: $m add command -label "Quit" -command exit
81:
82: menubutton .mbar.edit -text Edit -underline 0 -state disabled\
83: -relief raised -borderwidth 2
84: pack .mbar.edit -side left
85:
86: menubutton .mbar.help -text Help -menu .mbar.help.m -underline 0\
87: -relief raised -borderwidth 2
88: pack .mbar.help -side right
89: set m [menu .mbar.help.m]
90: $m add command -label "About..." -command {
91: tk_dialog .about "About Puks" \
92: "Система управления кнопками.
93: (C) Teytelman, 2002 (MCR code)
94: (C) Boris Veytsman, 2005 (Tcl/Tk version)"\
95: info 0 "OK"}
96:
97:
98: #Teams
99: frame .teams
100: pack .teams -side top
101: for {set i 0} {$i < 8} {incr i} {
102: frame .teams.frame($i)
103: pack .teams.frame($i) -side top -fill x
104: label .teams.frame($i).button -text 0
105: pack .teams.frame($i).button -side left
106: entry .teams.frame($i).name -width 60 -textvariable name($i)
107: pack .teams.frame($i).name -side left
108: entry .teams.frame($i).score -width 6 -textvariable score($i)
109: pack .teams.frame($i).score -side left
110: }
111:
112:
113: # Question weight
114: frame .weight
115: set weight 1
116: set doubled 0
117: pack .weight -side top -fill x
118: label .weight.label -text "Цена вопроса"
119: entry .weight.weight -textvariable weight -width 3
120: checkbutton .weight.doubled -variable doubled
121: label .weight.label2 -text "x2"
122: pack .weight.label .weight.weight .weight.doubled .weight.label2 -side left
123:
124: # Buttons and timer
125: frame .control
126: pack .control -side top -fill x
127: frame .control.buttons
128: pack .control.buttons -side left -fill y
129:
130: button .control.buttons.assign -text "Assign Buttons" -underline 0 -state disabled
131: pack .control.buttons.assign -fill both -side top
132: bind Button <a> {.control.buttons.assign invoke}
133:
134: button .control.buttons.start -text Start -underline 0 -command "puts A"
135: pack .control.buttons.start -fill both -side top
136: bind Button <s> {.control.buttons.start invoke}
137:
138: button .control.buttons.stop -text Stop -underline 1 -command "puts B" -state disabled
139: pack .control.buttons.stop -fill both -side top
140: bind Button <t> {.control.buttons.stop invoke}
141:
142: button .control.buttons.reset -text "Reset scores" -underline 0 -state disabled
143: pack .control.buttons.reset -fill both -side top
144: bind Button <r> {.control.buttons.reset invoke}
145:
146:
147:
148: option add *timer.font -*-palatino-*-r-normal--*-1200-*-*-*-*-*-* widgetDefault
149: label .control.timer -text 0 -border 5 -relief raised -borderwidth 2
150: pack .control.timer -side left -expand 1 -fill x
151:
152: # Status line
153: frame .status -relief sunk -borderwidth 2
154: pack .status -side top -fill x
155: label .status.mcr -relief ridge -text "Not connected" -fg red -width 48
156: pack .status.mcr -side left -fill x
157: label .status.state -relief ridge -text "Idle"
158: pack .status.state -side left -fill x
159:
160:
161: # button .start -text "Start" -command start
162: # pack .start
163: # label .pressed
164: # pack .pressed
165:
166:
167: proc start {} {
168: global SRLFILE state idle waiting
169: readbuffer
170: .start configure -state disabled -command {}
171: set state $waiting
172: }
173:
174: proc body {} {
175: global state idle waiting
176: update idletasks
177: if { $state == $waiting } {
178: set pressed [readbuffer]
179: if { $pressed != 0 } {
180: # set state $idle
181: # .start configure -state active -command start
182: .pressed configure -text "Pressed $pressed"
183: puts $pressed
184: readbuffer }
185: } else {
186: readbuffer
187: }
188: after 10 body
189: }
190:
191: #body
192:
193:
194:
195:
196:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to puks.tcl CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Local Repository] / tclpuks / prgsrc