I386LINUX/util/I386LINUX/lib/blt2.4/demos/stripchart

   1 #!/home/people/tkys/Eos/util/I386LINUX/bin/bltwish
   2 #!../bltwish
   3
   4 source bltDemo.tcl
   5
   6 # ----------------------------------------------------------------------
   7 #  EXAMPLE: simple driver for stripchart widget
   8 # ----------------------------------------------------------------------
   9 #  Michael J. McLennan
  10 #  mmclennan@lucent.com
  11 #  Bell Labs Innovations for Lucent Technologies
  12 # ======================================================================
  13 #               Copyright (c) 1996  Lucent Technologies
  14 # ======================================================================
  15
  16 option add *x.range 20.0
  17 option add *x.shiftBy 15.0
  18 option add *bufferElements no
  19 option add *symbol scross
  20 option add *pixels 1.25m
  21 option add *PlotPad 25
  22 option add *Stripchart.width 400
  23 option add *Smooth natural
  24 #option add *Stripchart.invertXY yes
  25 #option add *x.descending yes
  26
  27 # ----------------------------------------------------------------------
  28 #  USAGE:  random ?<max>? ?<min>?
  29 #
  30 #  Returns a random number in the range <min> to <max>.
  31 #  If <min> is not specified, the default is 0; if max is not
  32 #  specified, the default is 1.
  33 # ----------------------------------------------------------------------
  34
  35 proc random {{max 1.0} {min 0.0}} {
  36     global randomSeed
  37
  38     set randomSeed [expr (7141*$randomSeed+54773) % 259200]
  39     set num  [expr $randomSeed/259200.0*($max-$min)+$min]
  40     return $num
  41 }
  42 set randomSeed 14823
  43
  44 # ----------------------------------------------------------------------
  45
  46 toplevel .addSource
  47 wm title .addSource "Add Source"
  48 wm group .addSource .
  49 wm withdraw .addSource
  50 wm protocol .addSource WM_DELETE_WINDOW {.addSource.controls.cancel invoke}
  51
  52 frame .addSource.info
  53 pack .addSource.info -expand yes -fill both -padx 4 -pady 4
  54 label .addSource.info.namel -text "Name:"
  55 entry .addSource.info.name
  56 label .addSource.info.maxl -text "Maximum:"
  57 entry .addSource.info.max
  58 label .addSource.info.minl -text "Minimum:"
  59 entry .addSource.info.min
  60 table .addSource.info \
  61     .addSource.info.namel 0,0 -anchor e \
  62     .addSource.info.name 0,1 -fill x \
  63     .addSource.info.maxl 1,0 -anchor e \
  64     .addSource.info.max 1,1 -fill x \
  65     .addSource.info.minl 2,0 -anchor e \
  66     .addSource.info.min 2,1 -fill x
  67
  68 frame .addSource.color
  69 pack .addSource.color -padx 8 -pady 4
  70 frame .addSource.color.sample -width 30 -height 30 -borderwidth 2 -relief raised
  71 pack .addSource.color.sample -side top -fill both
  72 scale .addSource.color.r -label "Red" -orient vertical \
  73     -from 100 -to 0 -command source_color
  74 pack .addSource.color.r -side left -fill y
  75 scale .addSource.color.g -label "Green" -orient vertical \
  76     -from 100 -to 0 -command source_color
  77 pack .addSource.color.g -side left -fill y
  78 scale .addSource.color.b -label "Blue" -orient vertical \
  79     -from 100 -to 0 -command source_color
  80 pack .addSource.color.b -side left -fill y
  81
  82 proc source_color {args} {
  83     set r [expr round(2.55*[.addSource.color.r get])]
  84     set g [expr round(2.55*[.addSource.color.g get])]
  85     set b [expr round(2.55*[.addSource.color.b get])]
  86     set color [format "#%2.2x%2.2x%2.2x" $r $g $b]
  87     .addSource.color.sample configure -background $color
  88 }
  89 source_color
  90
  91 frame .addSource.sep -borderwidth 1 -height 2 -relief sunken
  92 pack .addSource.sep -fill x -pady 4
  93
  94 frame .addSource.controls
  95 pack .addSource.controls -fill x -padx 4 -pady 4
  96 button .addSource.controls.ok -text "OK" -command {
  97     wm withdraw .addSource
  98     set name [.addSource.info.name get]
  99     set color [.addSource.color.sample cget -background]
 100     set max [.addSource.info.max get]
 101     set min [.addSource.info.min get]
 102     if {[catch {source_create $name $color $min $max} err] != 0} {
 103         puts "error: $err"
 104     }
 105 }
 106 pack .addSource.controls.ok -side left -expand yes -padx 4
 107 button .addSource.controls.cancel -text "Cancel" -command {
 108     wm withdraw .addSource
 109 }
 110 pack .addSource.controls.cancel -side left -expand yes -padx 4
 111
 112 proc source_create {name color min max} {
 113     global sources
 114
 115     if {[info exists sources($name-controls)]} {
 116         error "source \"$name\" already exists"
 117     }
 118     if {$max <= $min} {
 119         error "bad range: $min - $max"
 120     }
 121
 122     set unique 0
 123     set win ".sources.nb.s[incr unique]"
 124     while {[winfo exists $win]} {
 125         set win ".sources.nb.s[incr unique]"
 126     }
 127
 128     set xvname "xvector$unique"
 129     set yvname "yvector$unique"
 130     set wvname "wvector$unique"
 131     global $xvname $yvname $wvname
 132 #    catch { $xvname delete }
 133 #    catch { $yvname delete }
 134 #    catch { $wvname delete }
 135     vector $xvname $yvname $wvname
 136
 137     if {$xvname == "xvector1"} {
 138         $xvname append 0
 139     } else {
 140         xvector1 variable thisVec
 141         $xvname append $thisVec(end)
 142     }
 143     $yvname append [random $max $min]
 144     $wvname append 0
 145
 146     catch {.sc element delete $name}
 147     .sc element create $name -xdata $xvname -ydata $yvname -color $color
 148     if { $name != "default" } {
 149         .sc axis create $name -limitcolor $color -limits "%4.4g"
 150         .sc element configure $name -mapy $name
 151     }
 152     set cwin .sources.choices.rb$unique
 153     radiobutton $cwin -text $name \
 154         -variable choices -value $win -command "
 155             foreach w \[pack slaves .sources.nb\] {
 156                 pack forget \$w
 157             }
 158             pack $win -fill both
 159         "
 160     pack $cwin -anchor w
 161
 162     frame $win
 163     pack $win -fill x
 164     label $win.limsl -text "Limits:"
 165     entry $win.lims
 166     bind $win.lims <KeyPress-Return> "
 167         .sc yaxis configure -limits {%%g}
 168     "
 169     label $win.smoothl -text "Smooth:"
 170     frame $win.smooth
 171     radiobutton $win.smooth.linear -text "Linear" \
 172         -variable smooth -value linear -command "
 173             .sc element configure $name -smooth linear
 174         "
 175     pack $win.smooth.linear -side left
 176     radiobutton $win.smooth.step -text "Step" \
 177         -variable smooth -value step -command "
 178             .sc element configure $name -smooth step
 179         "
 180     pack $win.smooth.step -side left
 181     radiobutton $win.smooth.natural -text "Natural" \
 182         -variable smooth -value natural -command "
 183             .sc element configure $name -smooth natural
 184         "
 185     pack $win.smooth.natural -side left
 186     label $win.ratel -text "Sampling Rate:"
 187     scale $win.rate -orient horizontal -from 10 -to 1000
 188
 189     table $win \
 190         $win.smoothl 0,0 -anchor e \
 191         $win.smooth 0,1 -fill x -padx 4 \
 192         $win.limsl 1,0 -anchor e \
 193         $win.lims 1,1 -fill x -padx 4 \
 194         $win.ratel 2,0 -anchor e \
 195         $win.rate 2,1 -fill x -padx 2
 196
 197     if {$unique != 1} {
 198         button $win.del -text "Delete" -command [list source_delete $name]
 199         pack $win.del -anchor w
 200         table $win $win.del 3,1 -anchor e -padx 4 -pady 4
 201     }
 202
 203     $win.rate set 100
 204     catch {$win.smooth.[.sc element cget $name -smooth] invoke} mesg
 205
 206     set sources($name-choice) $cwin
 207     set sources($name-controls) $win
 208     set sources($name-stream) [after 100 [list source_event $name 100]]
 209     set sources($name-x) $xvname
 210     set sources($name-y) $yvname
 211     set sources($name-w) $wvname
 212     set sources($name-max) $max
 213     set sources($name-min) $min
 214     set sources($name-steady) [random $max $min]
 215
 216     $cwin invoke
 217 }
 218
 219 proc source_delete {name} {
 220     global sources
 221
 222     after cancel $sources($name-stream)
 223     destroy $sources($name-choice)
 224     destroy $sources($name-controls)
 225     unset sources($name-controls)
 226
 227     set first [lindex [pack slaves .sources.choices] 0]
 228     $first invoke
 229 }
 230
 231 proc source_event {name delay} {
 232     global sources
 233
 234     set xv $sources($name-x)
 235     set yv $sources($name-y)
 236     set wv $sources($name-w)
 237     global $xv $yv $wv
 238
 239     $xv variable x
 240     set x(++end) [expr $x(end) + 0.001 * $delay]
 241
 242     $yv variable y
 243     if {[random] > 0.97} {
 244         set y(++end) [random $sources($name-max) $sources($name-min)]
 245     } else {
 246         set y(++end) [expr $y(end)+0.1*($sources($name-steady)-$y(end))]
 247     }
 248
 249     set val [random]
 250     if {$val > 0.95} {
 251         $wv append 2
 252     } elseif {$val > 0.8} {
 253         $wv append 1
 254     } else {
 255         $wv append 0
 256     }
 257     $wv notify now
 258     update
 259     set win $sources($name-controls)
 260     set delay [$win.rate get]
 261     set sources($name-stream) [after $delay [list source_event $name $delay]]
 262 }
 263
 264 # ----------------------------------------------------------------------
 265 frame .mbar -borderwidth 2 -relief raised
 266 pack .mbar -fill x
 267
 268 menubutton .mbar.main -text "Main" -menu .mbar.main.m
 269 pack .mbar.main -side left -padx 4
 270 menu .mbar.main.m
 271 .mbar.main.m add command -label "Add Source..." -command {
 272     set x [expr [winfo rootx .]+50]
 273     set y [expr [winfo rooty .]+50]
 274     wm geometry .addSource +$x+$y
 275     wm deiconify .addSource
 276 }
 277 .mbar.main.m add separator
 278 .mbar.main.m add command -label "Quit" -command exit
 279
 280 menubutton .mbar.prefs -text "Preferences" -menu .mbar.prefs.m
 281 pack .mbar.prefs -side left -padx 4
 282
 283 menu .mbar.prefs.m
 284 .mbar.prefs.m add cascade -label "Warning Symbol" -menu .mbar.prefs.m.wm
 285 menu .mbar.prefs.m.wm
 286 .mbar.prefs.m add cascade -label "Error Symbol" -menu .mbar.prefs.m.em
 287 menu .mbar.prefs.m.em
 288
 289 foreach sym {square circle diamond plus cross triangle} {
 290     .mbar.prefs.m.wm add radiobutton -label $sym \
 291         -variable warningsym -value $sym \
 292         -command {.sc pen configure "warning" -symbol $warningsym}
 293
 294     .mbar.prefs.m.em add radiobutton -label $sym \
 295         -variable errorsym -value $sym \
 296         -command {.sc pen configure "error" -symbol $errorsym}
 297 }
 298 catch {.mbar.prefs.m.wm invoke "circle"}
 299 catch {.mbar.prefs.m.em invoke "cross"}
 300
 301 # ----------------------------------------------------------------------
 302 stripchart .sc -title "Stripchart"
 303 pack .sc -expand yes -fill both
 304
 305 .sc xaxis configure -title "Time (s)"
 306 .sc yaxis configure -title "Samples"
 307
 308 frame .sources
 309 pack .sources -fill x -padx 10 -pady 4
 310 frame .sources.nb -borderwidth 2 -relief sunken
 311 pack .sources.nb -side right -expand yes -fill both -padx 4 -pady 4
 312 label .sources.title -text "Sources:"
 313 pack .sources.title -side top -anchor w -padx 4
 314 frame .sources.choices -borderwidth 2 -relief groove
 315 pack .sources.choices -expand yes -fill both -padx 4 -pady 4
 316
 317 source_create default red 0 10
 318 source_create temp blue3 0 10
 319 source_create pressure green3 0 200
 320 source_create volume purple3 0 1020
 321 source_create power yellow3 0 0.01999
 322 source_create work magenta3 0 10
 323 source_create huh cyan3 0 10000
 324 source_create ok violet 0 8.001
 325
 326