--- tclpuks/prgsrc/puks.tcl 2005/08/26 00:36:53 1.1 +++ tclpuks/prgsrc/puks.tcl 2005/08/29 19:28:13 1.5 @@ -0,0 +1,196 @@ +#!/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 {.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 + + + + +