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 datadatadummy.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)}]
}