Project from [RJM]

2004-08-04 Here a simple oscilloscope functionality is presented. By the time this is stripped for the primary purpose of an investigation ([event/response delay investigation]). 
Later, further functionality (e.g. axes) will be (re)added.

The application presumes a serial connection to a device providing sample data. 
Samples cause canvas update just as they arrive.

oscill.tcl provides a basic oscilloscope functionality. When a trace
is drawn, the previous trace is removed sample by sample. A small
(moving) gap in the trace shows the actual update location.
Command line options:
 1...n - specifies com port for target device delivering measuring data
   0   - oscill.tcl  automatically starts msp430dummy.tcl and creates a
         pipe
       - (no option) in internal proc provides in timing and simulated
         measuring data

datadummy.tcl replaces the original measuring frontend. Command line
options:
 1...n - specifies com port for connection with oscill.tcl via a
         nullmodem cable. When the PC provides two com ports, both
         programs can run on the same machine. However, better
         performance had been observed on separate machines during the
         phase of optimizing this experimental software.

Here both scripts are inserted:
 # oscill.tcl
 ################################################################################
 # oscillograph module
 ################################################################################
 
 array set oscpar {
     single 1
     samples 400
     plotstep 2
     timebase 50
     persist 0
     channels 2
     location +1+24
     x0 15
 }
 
 
 # initialize STRIPPED window
 proc oscinit {runcmd} {
     global oscpar
 
     # initialize Tk widgets
     if ![winfo exists .osc] {
         toplevel .osc
         wm title .osc "oscillogram"
         # specify as window not iconizable, '.' is master window
         wm transient .osc .
         wm geometry .osc $oscpar(location)
         wm geometry .osc {}   ;# ensure internal widget size appearing
     
         canvas .osc.c -width 830 -height 550 -bg white
         frame .osc.f1
         button .osc.run -text "<space> run" -command $runcmd
         checkbutton .osc.single -text "1 single" -variable oscpar(single)
         label .osc.tbl -text "2 timebase (ms/div)"
         set oscpar(tbvalues) {10 20 50 100 200 500 1000}
         spinbox .osc.tb -values $oscpar(tbvalues) -width 4 \
                        -command {tb_update %s; .osc.tb selection range 0 end}
         .osc.tb set $oscpar(timebase)
         .osc.tb configure -validate key -vcmd {regexp {^[-+]?[.\d]*$} %P}
         checkbutton .osc.persist -text "9 persistence" -variable oscpar(persist)
         button .osc.clr -text "0 clr" -command {.osc.c delete curve oldcurve}
         pack .osc.run .osc.single .osc.tbl .osc.tb \
                 .osc.persist .osc.clr -side left -fill y -padx 4 -in .osc.f1
         pack .osc.c .osc.f1
         # basic vertical lines replaces axis system
         set x $oscpar(x0)
         for {set n 0} {$n <= 10} {incr n} {
             .osc.c create line $x 0 $x 512 -fill grey
             incr x [expr {$oscpar(samples)/5}]
         }
         
         
         # here define extra osc bindtag for numeric key bindings: active only upon
         # window focus (not active when entry, spinbox etc. focus)
         bindtags .osc "wosc [bindtags .osc]"
  
         bind wosc <Key-1> {.osc.single toggle}
         bind wosc <Key-2> {focus .osc.tb}
         bind wosc <Key-9> {.osc.persist toggle}
         bind wosc <Key-0> {.osc.clr invoke}
         bind .osc.tb <Key-Escape> {focus .osc}
         bind .osc.tb <Key-Return> {tb_update [.osc.tb set]; .osc.tb selection range 0 end}
         bind wosc <Key-Escape> {destroy .osc}
         bind wosc <Key-Return> {focus .osc}
         bind all <Key-space> {.osc.run invoke; break}
         # let these bindings catch space key to only allow other bindings
         bind Spinbox <Key-space> {continue}
         bind Entry <Key-space> {continue}
         # here filter for .osc.tb: no alpha characters (space allowed, but
         # captured in a new class binding)
         bind .osc.tb <KeyPress> {
             if {[regexp -nocase {[A-Z]} %A]} {
                 break   ;# here inhibit further bind processing
             }
         }
         bind wosc <Destroy> {set oscpar(location) [wm geometry .osc]}
         tb_update $oscpar(timebase)
     }
     focus .osc
 }
 
 # argument: a list containing values for each sample, according to the number of channels
 set xpos 0
 proc plotdata {yy} {
     global oscpar y_expr lcolor
     # variables with only static nature
     global objID xpos
     
     # CREATE line first, only starting point
     if {!$xpos} {
         set xpos $oscpar(x0)
         if {$oscpar(persist)} {
             .osc.c itemconfigure curve -fill darkgrey
             .osc.c addtag oldcurve withtag curve
             .osc.c dtag curve
         } else {
             .osc.c addtag lastcurve withtag curve
             .osc.c dtag curve
             .osc.c dchars lastcurve 1 6  ;# create gap in dynamic curve plotting
         }
         catch {unset objID}
         set index 0
         foreach y $yy color $lcolor ex $y_expr {
             set y [expr $ex]
             if {$color=="-"} {
                 lappend objID 0
             } else {
                 lappend objID [.osc.c create line $xpos $y $xpos $y \
                     -fill $color -tags "object curve curve($index)"]
             }
         incr index
         }
     } else {
         # +++++++++++++ the CORE of the line drawing functionality ++++++++++++++
         # delete first coordinate pair of last curve(s)
         .osc.c dchar lastcurve 1  ;#  !!! consumes time (check if foraeach & ID would be better than tag)
         # append additional line pieces to one line object
         foreach y $yy ex $y_expr id $objID {
             set y [expr $ex]
             #set y [expr 400-$y/8.0]
             .osc.c insert $id end "$xpos $y"
         }
     }
     incr xpos ${oscpar(plotstep)}
     if {$xpos == [expr {$oscpar(samples)*$oscpar(plotstep)+$oscpar(x0)}]} {
         set xpos 0
         if {!$oscpar(single) } {
             after idle .osc.run invoke
         }
     }
 }
 
 proc tb_update {s} {
     global oscpar serial
 
     set oscpar(timebase) $s
     .osc.tb config -values $oscpar(tbvalues)
     .osc.tb set $oscpar(timebase)
     # prepare sample rate
     set interval [expr {$s*1000 / ($oscpar(samples)/10)}]
     if {$interval > 4000} \
         {set interval [expr {$interval/1000}]; set unit m} \
         {set unit u}
     if {[info exists serial]} {
         puts -nonewline $serial "T$unit[binary format S $interval]"
         flush $serial
     }
     # now prepare total scan time representation
     set unit ms
     if {$s >= 1000} {
         set unit s
         set s [expr {$s/1000}]
     }
     .osc.c delete text
     .osc.c create text 650 525 -text "scan time: [expr {$s*10}] $unit" -tags text
     return 1
 }
 
 ####################################
 
 # this every uses a repeats limit and a fixed 1ms inner interval (1 ms is a reliable rate)
 set _count 0
 set _rep 0
 proc every {ms repeats body} {
     global _count _rep
     
     if {$_rep <= 0} {set _rep $repeats}
     if {!$_count} {set _count [expr {$ms ? $ms : 1}]}
     set id [after 1 [info level 0]]   ;# use 1 and count for ms ms
     if {[incr _count -1]} return
     # timed script execute
     if 1 $body
     if {![incr _rep -1]} {after cancel $id}
 }
 
 # this proc is used when an external process (pipe or com port) supplies raw plot data
 proc plotprocess {} {
     global serial oscpar
     
     # send arming command to target device
     puts -nonewline $serial "A[binary format S $oscpar(samples)][binary format c $oscpar(channels)]"
     flush $serial
 }
 
 # this proc is used when this script supplies raw plot data according to timebase setting
 proc plotdummy {} {
     global oscpar tp
     
     set tp(n) 0
     every [expr {$oscpar(timebase)/35}] $oscpar(samples) {
         global tp
         set x $tp(n)
         incr tp(n)
         # simulate analog values in the range 0-1600 (display range 0-4095, 512 pixel)
         plotdata "[expr {4*$x}] [expr {4*(400-$x) + 100*rand()}]"
         #puts -nonewline .
     }
 }
 
 # input data words (n = number of words, returned in string)
 # note: this procedure works correct after incompleted $stream
 # next call through fileevent it will be completed
 set ser_in_cnt 0
 proc ser_in_w {n} {
     global serial stream ser_in_cnt
 
     if {!$ser_in_cnt} {set ser_in_cnt [expr {$n*2}]}
     append stream [read $serial $ser_in_cnt]
     set ser_in_cnt [expr {$n*2-[string length $stream]}]
     if {$ser_in_cnt} return
 
     binary scan $stream S$n intval
     set stream ""
     return $intval
 }
 
 proc getdata {} {
     global oscpar
     
     if {[set yy [ser_in_w $oscpar(channels)]] != ""} {
         plotdata $yy
     }
     # let next fileevent complete the receive message if not yet complete
 }
 
 ###############################################
 
 lappend y_expr {512 - $y/8.0}; lappend lcolor blue
 lappend y_expr {512 - $y/8.0}; lappend lcolor red
 
 if {$argc && [string length $argv] == 1} {
     # initialize port status
     if {!$argv} {
         # when 0, open a pipe: connects to a MSP430 hardware simulator script
         set serial [open "|wish datadummy.tcl" r+]
     } else {
         set serial [open com$argv r+]
         fconfigure $serial -timeout 1000 -handshake none -pollinterval 4
         fconfigure $serial -mode 57600,n,8,1    ;#only necessary to force 8 bit (default is 7)
     }
     fconfigure $serial -buffersize 4096
     # note: blocking 0 must be used in order to allow event loop processing when 
     # waiting for data
     fconfigure $serial -blocking 0 -encoding binary -translation binary
     fileevent $serial readable getdata
     oscinit plotprocess
 } else {
     oscinit plotdummy
 }

The drawing core of this script can be found just under the phrase "CORE".

Here is the data simulator (next filename must be used)
 # datadummy.tcl
 # dummy MSP430 unit. Uses pipes or serial port to simulate MSP430 target device
 # may also dummy remotely per serial port (start with port# as argument)
 #console show
 
 if {$argc} {
     set fid [open com$argv r+]
     fconfigure $fid -timeout 1000 -handshake none
     fconfigure $fid -mode 57600,n,8,1
     set in $fid
     set out $fid
 } else {
     set in stdin
     set out stdout
 }
 fileevent $in readable "getcommands"
 # blocking 0 should result in immediate flush return
 fconfigure $out -blocking 0 -encoding binary -translation binary
 fconfigure $in -blocking 0 -encoding binary -translation binary
 
 pack [text .t]
 array set param {
     time 1
     unit ms
     rampstart 0
     rampstep 4
 }
 
 proc getcommands {} {
     global in out param y sample
     
     .t insert end >
     switch [read $in 1] {
         A {.t insert end "Arm..."
            binary scan [read $in 2] S1 param(samples)    ;# number of samples
            read $in 1    ;# command (1 = stop/quit arming)
            set y $param(rampstart)
            set sample 0
            set ms [expr {$param(unit)=="m" ? $param(time) : $param(time)/1000}]
            .t insert end " ($ms)  $param(samples) samples\n"
            every $ms $param(samples) sample
           }
         I {.t insert end "Channel setup [read $in 2]\n"
           }
         T {.t insert end "Timebase set: [set param(unit) [read $in 1]] "
            binary scan [read $in 2] S1 param(time)
            .t insert end "$param(time)\n"
           }
         R {.t insert end "Ramp set: "
            binary scan [read $in 2] S1 param(rampstart)
            binary scan [read $in 2] S1 param(rampend)
            .t insert end "$param(rampstart)  $param(rampend)\n"
            set param(rampstep) [expr {($param(rampend)-$param(rampstart)) / 400}]
           }
         S {.t insert end "Suspend arming\n"
           }
         Q {.t insert end "Quit arming\n"
           }
         D {.t insert end "Digital Out\n"
            read $in 1
           }
         C {.t insert end "Custom: \n"
            read $in 1}
         B {.t insert end "Firmware Build\n"
            puts $out "000"; flush $out
           }
     }
     .t see insert
 }
 
 set count 0
 set rep 0
 proc every {ms repeats body} {
     global count rep
     
     if {!$rep} {set rep $repeats}
     if {!$count} {set count [expr {$ms ? $ms : 1}]}
     set id [after 1 [info level 0]]   ;# use 1 and count for ms ms
     if {[incr count -1]} return
     # timed script execute
     if 1 $body
     if {![incr rep -1]} {after cancel $id}
 }
 
 
 proc sample {} {
         global out y param sample
 
         set x $sample
         incr sample
         puts -nonewline $out [binary format S2 [list [expr {int($y)}] [expr {int(4*(400-$x)+100*rand())}]]]
         flush $out
         set y [expr {$y + $param(rampstep)}]
 }

----
[Category Application] | [Category Device Control] | [Category Animation] | 
[Category Plotting] | [Category Signal Processing]