File:  [Local Repository] / tclpuks / prgsrc / puks.tcl
Revision 1.2: download - view: text, annotated - select for diffs - revision graph
Sat Aug 27 05:31:18 2005 UTC (18 years, 10 months ago) by boris
Branches: MAIN
CVS tags: HEAD
Now I can read the microprocessor

    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: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>