Return to puks.tcl CVS log

Up to [Local Repository] / tclpuks / prgsrc

Some progress on main window

    1: #!/usr/bin/wish
    2: 
    3: ##############################################################
    4: #    Global flags and variables
    5: ##############################################################
    6: 
    7: # Flags
    8: set waiting_for_key 0
    9: set question_asked 0
   10: set timer_started 0
   11: 
   12: # Channel to talk to the MRC device
   13: set MRC 0
   14: 
   15: #  Mapping of MCR codes to keys:  button(code)
   16: set buttoncode 256
   17: for {set i 1} {$i <=8} {incr i} {
   18:     set button($buttoncode) $i
   19:     set buttoncode [expr $buttoncode*2]
   20: }
   21: 
   22: 
   23: ##############################################################
   24: #  Procedures for talking with MRC
   25: ##############################################################
   26: 
   27: # Open the given device for MRC.  Return 0 if successful, 1 otherwise
   28: proc open_mrc {device} {
   29:     global MRC
   30:     set result [catch {set MRC [open $device r+]}]
   31:     if {$result !=0} {
   32: 	return $result
   33:     }
   34:     fconfigure $MRC -blocking 0  -translation binary \
   35: 	-encoding binary -buffering none -mode  57600,n,8,1
   36:     
   37:     puts $MRC s
   38:     after 200
   39:     read $MRC
   40:     puts $MRC r
   41:     after 200
   42:     read $MRC
   43:     return 0
   44: }
   45:     
   46: 
   47: 
   48: # Return the key pressed or 0
   49: proc readbuffer {} {
   50:     global MRC  button
   51:     set key 0
   52:     set message [read $MRC]
   53:     binary scan $message s key
   54:     set key [expr $key & 0xFFFF]
   55:     if {[catch {set key $button($key)}] == 0} {
   56: 	return $key
   57:     }
   58:     return 0
   59: }
   60: 
   61: ##############################################################
   62: #   Setup
   63: ##############################################################
   64: 
   65: 
   66: 
   67: # Main menu
   68: 
   69: menu .mbar -type menubar -relief ridge -borderwidth 2
   70: pack .mbar -fill x
   71: 
   72: menubutton .mbar.file -text File -menu .mbar.file.m -underline 0 \
   73: 	-relief raised -borderwidth 2
   74: pack .mbar.file -side left 
   75: set m [menu .mbar.file.m]
   76: $m add command -label "Open" -state disabled
   77: $m add command -label "Save as..." -state disabled
   78: $m add command -label "Save" -state disabled
   79: $m add separator
   80: $m add command -label "Quit" -command exit
   81: 
   82: menubutton .mbar.edit -text Edit -underline 0 -state disabled\
   83: 	-relief raised -borderwidth 2
   84: pack .mbar.edit -side left
   85: 
   86: menubutton .mbar.help -text Help -menu .mbar.help.m -underline 0\
   87: 	-relief raised -borderwidth 2
   88: pack .mbar.help -side right
   89: set m [menu .mbar.help.m]
   90: $m add command -label "About..." -command {
   91:     tk_dialog .about "About Puks" \
   92: 	    "Система управления кнопками.
   93: (C) Teytelman, 2002 (MCR code)
   94: (C) Boris Veytsman, 2005 (Tcl/Tk version)"\
   95: 	info  0 "OK"}
   96:     
   97: 
   98: #Teams
   99: frame .teams 
  100: pack .teams -side top
  101: for {set  i 0} {$i < 8} {incr i} {
  102:     frame .teams.frame($i) 
  103:     pack .teams.frame($i) -side top -fill x
  104:     label .teams.frame($i).button -text 0
  105:     pack .teams.frame($i).button -side left
  106:     entry .teams.frame($i).name -width 60 -textvariable name($i)
  107:     pack .teams.frame($i).name -side left
  108:     entry .teams.frame($i).score -width 6 -textvariable score($i)
  109:     pack .teams.frame($i).score -side left
  110: }
  111: 
  112: #  button .start -text "Start" -command start
  113: #  pack .start
  114: #  label .pressed 
  115: #  pack .pressed
  116: 
  117: 
  118: proc start {} {
  119:     global SRLFILE state idle waiting
  120:     readbuffer
  121:     .start configure -state disabled -command {}
  122:     set state $waiting
  123: }
  124: 
  125: proc body  {} {
  126:     global state idle waiting
  127:     update idletasks
  128:     if { $state == $waiting } {
  129: 	set pressed [readbuffer]
  130: 	if { $pressed != 0 } {
  131: #	    set state $idle
  132: #	    .start configure -state active -command start
  133: 	    .pressed configure -text "Pressed $pressed"
  134: 	    puts $pressed
  135: 	    readbuffer	}
  136:     } else {
  137: 	readbuffer
  138:     }
  139:     after 10 body
  140: }
  141: 
  142: #body 
  143: 
  144: 
  145: 
  146: 
  147: