Return to puks.tcl CVS log

Up to [Local Repository] / tclpuks / prgsrc

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

1.2     ! boris       1: #!/usr/bin/wish
        !             2: set DEVICE "/dev/ttyUSB0"
        !             3: 
        !             4: set SRLFILE [open $DEVICE r+]
        !             5: fconfigure $SRLFILE -blocking 0  -translation binary -encoding binary -buffering none -mode  57600,n,8,1
        !             6: 
        !             7: set idle 0
        !             8: set waiting 1
        !             9: 
        !            10: set state $idle
        !            11: 
        !            12: 
        !            13: set buttoncode 256
        !            14: for {set i 1} {$i <=8} {incr i} {
        !            15:     set button($buttoncode) $i
        !            16:     set buttoncode [expr $buttoncode*2]
        !            17: }
        !            18: 
        !            19: proc readbuffer {} {
        !            20:     global SRLFILE  button
        !            21:     set key 0
        !            22:     set message [read $SRLFILE]
        !            23:     binary scan $message s key
        !            24:     set key [expr $key & 0xFFFF]
        !            25:     if {[catch {set key $button($key)}] == 0} {
        !            26:        return $key
        !            27:     }
        !            28:     return 0
        !            29: }
        !            30: 
        !            31: puts $SRLFILE s
        !            32: after 200
        !            33: readbuffer
        !            34: puts $SRLFILE r
        !            35: after 200
        !            36: readbuffer
        !            37: 
        !            38: 
        !            39: 
        !            40: button .start -text "Start" -command start
        !            41: pack .start
        !            42: label .pressed 
        !            43: pack .pressed
        !            44: 
        !            45: 
        !            46: proc start {} {
        !            47:     global SRLFILE state idle waiting
        !            48:     readbuffer
        !            49:     .start configure -state disabled -command {}
        !            50:     set state $waiting
        !            51: }
        !            52: 
        !            53: proc body  {} {
        !            54:     global state idle waiting
        !            55:     update idletasks
        !            56:     if { $state == $waiting } {
        !            57:        set pressed [readbuffer]
        !            58:        if { $pressed != 0 } {
        !            59:            set state $idle
        !            60:            .start configure -state active -command start
        !            61:            .pressed configure -text "Pressed $pressed"
        !            62:            puts $pressed
        !            63:            readbuffer  }
        !            64:     } else {
        !            65:        readbuffer
        !            66:     }
        !            67:     after 10 body
        !            68: }
        !            69: 
        !            70: body 
        !            71: 
        !            72: 
        !            73: 
        !            74: 
        !            75: