#!/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 MCR device set MCR 0 set MCR_DEVICE "/dev/ttyUSB0" # 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 MCR ############################################################## # Open the given device for MCR. Return 0 if successful, 1 otherwise proc open_mcr {device} { global MCR set result [catch {set MCR [open $device r+]} error] if {$result !=0} { .status.mcr configure -text $error .status.mcr configure -fg red return $result } fconfigure $MCR -blocking 0 -translation binary \ -encoding binary -buffering none #-mode 57600,n,8,1 .status.mcr configure -text "Opened $device" .status.mcr configure -fg black puts $MCR s after 200 read $MCR puts $MCR r after 200 read $MCR return 0 } # Return the list of key pressed or empty list proc readbuffer {} { global MCR button set keys "" set message [read $MCR 6] while { [string length $message] > 0} { binary scan $message b48 msg .status.mcr -configure -text $msg .status.mcr -configure -fg black binary scan $message s key set key [expr $key & 0xFFFF] if {[catch {set key $button($key)}] == 0} { lappend keys $key } set message [read $MCR 6] } return keys } # Dialog for opening the device proc open_mcr_dialog {} { toplevel .mcr_dialog label .mcr_dialog.label -text "Open MCR port:" entry .mcr_dialog.entry -textvariable MCR_DEVICE pack .mcr_dialog.label .mcr_dialog.entry frame .mcr_dialog.buttons pack .mcr_dialog.buttons button .mcr_dialog.buttons.ok -command { open_mcr $MCR_DEVICE destroy .mcr_dialog } -text OK button .mcr_dialog.buttons.cancel -command {destroy .mcr_dialog}\ -text "Cancel" pack .mcr_dialog.buttons.ok .mcr_dialog.buttons.cancel -side left } ############################################################## # 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.mcr -text "MCR" -menu .mbar.mcr.m -underline 0 \ -relief raised -borderwidth 2 pack .mbar.mcr -side left set m [menu .mbar.mcr.m] $m add command -label "Open MCR" -command open_mcr_dialog 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 {.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 {.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 {.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 {.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