Mercurial > hg > audiostuff
comparison intercom/wdisplay.tcl @ 2:13be24d74cd2
import intercom-0.4.1
| author | Peter Meerwald <pmeerw@cosy.sbg.ac.at> |
|---|---|
| date | Fri, 25 Jun 2010 09:57:52 +0200 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| 1:9cadc470e3da | 2:13be24d74cd2 |
|---|---|
| 1 #!/usr/bin/wish | |
| 2 | |
| 3 # wdisplay.tcl | |
| 4 # show vector w values | |
| 5 | |
| 6 proc fileRecv {fd} { | |
| 7 global sam | |
| 8 | |
| 9 # read 4*sam bytes (sam values) into list l | |
| 10 set r [read $fd [expr 4*$sam]] | |
| 11 | |
| 12 # detect eof only after read! | |
| 13 if {[eof $fd]} { | |
| 14 puts "fileRecv eof" | |
| 15 close $fd | |
| 16 return | |
| 17 } | |
| 18 | |
| 19 binary scan $r "f$sam" l | |
| 20 | |
| 21 # linear Scale | |
| 22 set yscale [expr 1.0] | |
| 23 | |
| 24 # erase canvas | |
| 25 .ca delete ttt | |
| 26 | |
| 27 set x 0 | |
| 28 foreach y $l { | |
| 29 set y [expr 99 - $y * $yscale] | |
| 30 .ca create line $x 100 $x $y -tags ttt | |
| 31 incr x | |
| 32 } | |
| 33 } | |
| 34 | |
| 35 proc UserOpen {fd chost cport} { | |
| 36 fconfigure $fd -translation binary -encoding binary | |
| 37 fileevent $fd readable [list fileRecv $fd] | |
| 38 } | |
| 39 | |
| 40 # ############################################################## | |
| 41 # main | |
| 42 | |
| 43 # check Programm Args | |
| 44 if {$argc < 1} { | |
| 45 puts "usage: wdisplay.tcl samples" | |
| 46 exit | |
| 47 } | |
| 48 | |
| 49 set sam [lindex $argv 0] ;# vector length - see aec.cpp | |
| 50 # puts "sam =$sam" | |
| 51 | |
| 52 # create a canvas to draw the graphical objects on | |
| 53 canvas .ca -width $sam -height 200 | |
| 54 pack .ca | |
| 55 | |
| 56 # Open Server part of TCP connection | |
| 57 socket -server UserOpen 50999 |