#!/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
##############################################################
# Main menu
menu .mbar -type menubar -relief ridge -borderwidth 2
pack .mbar -fill x
menubutton .mbar.file -text File -menu .mbar.file.m -underline 0 \
-relief raised -borderwidth 2
pack .mbar.file -side left
set m [menu .mbar.file.m]
$m add command -label "Open" -state disabled
$m add command -label "Save as..." -state disabled
$m add command -label "Save" -state disabled
$m add separator
$m add command -label "Quit" -command exit
menubutton .mbar.edit -text Edit -underline 0 -state disabled\
-relief raised -borderwidth 2
pack .mbar.edit -side left
menubutton .mbar.help -text Help -menu .mbar.help.m -underline 0\
-relief raised -borderwidth 2
pack .mbar.help -side right
set m [menu .mbar.help.m]
$m add command -label "About..." -command {
tk_dialog .about "About Puks" \
"Система управления кнопками.
(C) Teytelman, 2002 (MCR code)
(C) Boris Veytsman, 2005 (Tcl/Tk version)"\
info 0 "OK"}
#Teams
frame .teams
pack .teams -side top
for {set i 0} {$i < 8} {incr i} {
frame .teams.frame($i)
pack .teams.frame($i) -side top -fill x
label .teams.frame($i).button -text 0
pack .teams.frame($i).button -side left
entry .teams.frame($i).name -width 60 -textvariable name($i)
pack .teams.frame($i).name -side left
entry .teams.frame($i).score -width 6 -textvariable score($i)
pack .teams.frame($i).score -side left
}
# Question weight
frame .weight
set weight 1
set doubled 0
pack .weight -side top -fill x
label .weight.label -text "Цена вопроса"
entry .weight.weight -textvariable weight -width 3
checkbutton .weight.doubled -variable doubled
label .weight.label2 -text "x2"
pack .weight.label .weight.weight .weight.doubled .weight.label2 -side left
# Buttons and timer
frame .control
pack .control -side top -fill x
frame .control.buttons
pack .control.buttons -side left -fill y
button .control.buttons.assign -text "Assign Buttons" -underline 0 -state disabled
pack .control.buttons.assign -fill both -side top
bind Button <a> {.control.buttons.assign invoke}
button .control.buttons.start -text Start -underline 0 -command "puts A"
pack .control.buttons.start -fill both -side top
bind Button <s> {.control.buttons.start invoke}
button .control.buttons.stop -text Stop -underline 1 -command "puts B" -state disabled
pack .control.buttons.stop -fill both -side top
bind Button <t> {.control.buttons.stop invoke}
button .control.buttons.reset -text "Reset scores" -underline 0 -state disabled
pack .control.buttons.reset -fill both -side top
bind Button <r> {.control.buttons.reset invoke}
option add *timer.font -*-palatino-*-r-normal--*-1200-*-*-*-*-*-* widgetDefault
label .control.timer -text 0 -border 5 -relief raised -borderwidth 2
pack .control.timer -side left -expand 1 -fill x
# Status line
frame .status -relief sunk -borderwidth 2
pack .status -side top -fill x
label .status.mcr -relief ridge -text "Not connected" -fg red -width 48
pack .status.mcr -side left -fill x
label .status.state -relief ridge -text "Idle"
pack .status.state -side left -fill x
# 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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>