Return to puks.tcl CVS log

Up to [Local Repository] / tclpuks / prgsrc

Added some mcr menus

#!/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 <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