--- tclpuks/prgsrc/puks.tcl 2005/08/27 05:31:18 1.2 +++ tclpuks/prgsrc/puks.tcl 2005/08/31 17:04:31 1.6 @@ -1,46 +1,203 @@ #!/usr/bin/wish -set DEVICE "/dev/ttyUSB0" - -set SRLFILE [open $DEVICE r+] -fconfigure $SRLFILE -blocking 0 -translation binary -encoding binary -buffering none -mode 57600,n,8,1 - -set idle 0 -set waiting 1 - -set state $idle +############################################################## +# 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] } -proc readbuffer {} { - global SRLFILE button - set key 0 - set message [read $SRLFILE] - binary scan $message s key - set key [expr $key & 0xFFFF] - if {[catch {set key $button($key)}] == 0} { - return $key + +############################################################## +# 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 +} + -puts $SRLFILE s -after 200 -readbuffer -puts $SRLFILE r -after 200 -readbuffer +# 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} -button .start -text "Start" -command start -pack .start -label .pressed -pack .pressed +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 {} { @@ -56,8 +213,8 @@ proc body {} { if { $state == $waiting } { set pressed [readbuffer] if { $pressed != 0 } { - set state $idle - .start configure -state active -command start +# set state $idle +# .start configure -state active -command start .pressed configure -text "Pressed $pressed" puts $pressed readbuffer } @@ -67,7 +224,7 @@ proc body {} { after 10 body } -body +#body