Return to puks.tcl CVS log

Up to [Local Repository] / tclpuks / prgsrc

Annotation of tclpuks/prgsrc/puks.tcl, revision 1.3

1.2       boris       1: #!/usr/bin/wish
                      2: 
1.3     ! boris       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
1.2       boris      11: 
1.3     ! boris      12: # Channel to talk to the MRC device
        !            13: set MRC 0
1.2       boris      14: 
1.3     ! boris      15: #  Mapping of MCR codes to keys:  button(code)
1.2       boris      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: 
1.3     ! boris      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
1.2       boris      49: proc readbuffer {} {
1.3     ! boris      50:     global MRC  button
1.2       boris      51:     set key 0
1.3     ! boris      52:     set message [read $MRC]
1.2       boris      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: 
1.3     ! boris      61: ##############################################################
        !            62: #   Setup
        !            63: ##############################################################
1.2       boris      64: 
                     65: button .start -text "Start" -command start
                     66: pack .start
                     67: label .pressed 
                     68: pack .pressed
                     69: 
                     70: 
                     71: proc start {} {
                     72:     global SRLFILE state idle waiting
                     73:     readbuffer
                     74:     .start configure -state disabled -command {}
                     75:     set state $waiting
                     76: }
                     77: 
                     78: proc body  {} {
                     79:     global state idle waiting
                     80:     update idletasks
                     81:     if { $state == $waiting } {
                     82:        set pressed [readbuffer]
                     83:        if { $pressed != 0 } {
1.3     ! boris      84: #          set state $idle
        !            85: #          .start configure -state active -command start
1.2       boris      86:            .pressed configure -text "Pressed $pressed"
                     87:            puts $pressed
                     88:            readbuffer  }
                     89:     } else {
                     90:        readbuffer
                     91:     }
                     92:     after 10 body
                     93: }
                     94: 
                     95: body 
                     96: 
                     97: 
                     98: 
                     99: 
                    100: