1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
|
# copyright (C) 1997-98 Jean-Luc Fontaine (mailto:jfontain@mygale.org)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu
set rcsId {$Id: datagraf.tcl,v 1.44 1998/10/11 09:27:20 jfontain Exp $}
class dataGraph {
if {$::officialBLT} {
set (widget) stripchart
} else {
set (widget) graph
}
proc dataGraph {this parentPath args} composite {
[new $dataGraph::(widget) $parentPath -title {} -topmargin 3 -bufferelements 0 -plotborderwidth 1 -plotbackground black]
$args
} blt2DViewer {$widget::($this,path)} {
set path $widget::($this,path)
$path xaxis configure -tickfont $font::(smallNormal) -title {} -rotate 90 -command dataGraph::axisTime
if {$::officialBLT} {
$path xaxis configure -tickshadow {}
$path pen create void -linewidth 0 -symbol none ;# pen for void values
}
# track size updates (do not use Configure event since it leads to incorrect values for graph internal components)
bind $path <Visibility> "dataGraph::resized $this"
set dataGraph::($this,plotWidth) 0 ;# cache plot width
composite::complete $this
}
proc ~dataGraph {this} {
if {[string length $composite::($this,-deletecommand)]>0} {
uplevel #0 $composite::($this,-deletecommand) ;# always invoke command at global level
}
}
proc iconData {} {
return {
R0lGODdhKAAoAKUAAHt5e87PzgAAANbX1v///zFhITFhGJTXa633e6X3e5znc6Xvc3u+Wpznazk4OZTfa4zPY3NJAPffSufHOda2Mc6mKVIIY2sYexBhe4wQ
pa3X54S+zr0o1qUYvbUYzrUg1lKWrb0Y3t44/60Yzt5B/+dJ/+dR/9YY984Y7+dZ/+dh/94o/+9x/wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAKAAoAAAG/kCAcEgsGo/IYQAgaDqf0Kh02lwKAthsYIDlbrVer3Y8ZgYI6DQaoG6z2+n3Gm09wwlyeN6t
flsHd3iBgoF5fmZDBYpJAIoGBUaPj0Z1aAUHmAWEapeYB5ppBQgICQqghwKABJ2ZeYoLCwoLpYqKpbAMkISVqwyeC6CrsAoKDAzDCg3FC8aQbKhLQgW+BwsN
tdUNzdMMxb7bDuFEf5zGyp4H2osOisbbAA5y0G3cD98QuUPxjbX6fXRMVHHi5s7ZHCNz4gC8gqTWIkYQAfCCs2/Iv0IXyd2JwJEjH4wKCUxMw1GCSZMRLt4x
tDDakAgmJ8iUKSGCkY42GY2EKZNC/oWfFCbUTAmg5EmPLEUGJCmhZ4WOFYKihNl05tSMZtDwnOAzZ9GfNJv6/BlVaM2Qf4REoMD2abi3HKOy7Qo1aNeKErMS
iEDWpgM3fPsSCfzT5i69ezkK+Qu4oyGcQg5f6ROZsZ54K/cltEKls2cpViyIvoCh9IXTqFOXNp2a9OrWF6xkmI1Bg20Ms3Pnrm1bA+7dvTdguMChOAcrHTx8
wLChue8P0KGX1tDc+era1UEMDxFChAgrIzyMwACi+nPptpuDKL+hN/UN64dfCEGiPvgR0tm3X/0+Pnn98GknH3clFAgeByEg+J9z6cHHWmnr+Ycad/XZxwR3
GIawYHUOXsJ23YQYmiCiCVZwhyCCGv4X4YAYwjbiiyOWeAIKM6KAQgiuvXZBCjz26OOPQFpRo41E4phaBiGooOSSTDbppJAoOCnllFQ2acUKK7Cg5ZZcdunl
l18uQcaYZJZZZhAAOw==
}
}
proc options {this} {
set samples [expr {$configuration::(graphNumberOfIntervals)+1}]
# force size and interval values
return [list\
[list -deletecommand {} {}]\
[list -draggable draggable Draggable 0 0]\
[list -height height Height 200]\
[list -interval interval Interval 5]\
[list -samples samples Samples $samples $samples]\
[list -width width Width 300]\
]
}
proc set-deletecommand {this value} {}
foreach option {-height -width} {
proc set$option {this value} "\$widget::(\$this,path) configure $option \$value"
}
proc set-draggable {this value} {
if {$composite::($this,complete)} {
error {option -draggable cannot be set dynamically}
}
if {$value} {
blt2DViewer::allowDrag $this
}
}
proc set-interval {this value} {
set dataGraph::($this,range) [expr {($composite::($this,-samples)-1)*$value}]
updateGraduations $this
}
proc set-samples {this value} { ;# stored at composite level
if {$composite::($this,complete)} {
error {option -samples cannot be set dynamically}
}
set dataGraph::($this,range) [expr {($value-1)*$composite::($this,-interval)}]
}
proc xAxisUpdate {this currentTime} {
$widget::($this,path) xaxis configure -min [expr {$currentTime-$dataGraph::($this,range)}] -max $currentTime
}
proc axisTime {path value} {
set value [expr {int($value)}] ;### sometimes BLT passes a floating point value: bug? ###
if {($value%60)==0} {
return [clock format $value -format %H:%M]
} else {
return [clock format $value -format %T] ;# show seconds only when necessary
}
}
proc newElement {this path args} { ;# invoked from 2D viewer base class
return [eval new element $path $args]
}
proc updateTimeDisplay {this seconds} {
xAxisUpdate $this $seconds
}
proc updateElement {this element seconds value} {
element::update $element $seconds $value
}
proc updateGraduations {this} {
if {$dataGraph::($this,plotWidth)==0} return ;# plot width is not known yet
# number=$division*($range/$step) # number of divisions
# ($plotWidth/$number)>2 # make sure that there is at least 1 pixel between neighbour divisions
# => $step>((2*$division*$range)/$plotWidth)
# use the maximum division in divisions discrete list
set minimum [expr {(2*6*$dataGraph::($this,range))/$dataGraph::($this,plotWidth)}]
# choose among predefined discrete values
foreach step {10 60 300 600 1800 3600 18000 36000 86400} division {5 6 5 5 5 6 5 5 4} {
if {$step>$minimum} break
}
$widget::($this,path) xaxis configure -stepsize $step -subdivisions $division
xAxisUpdate $this [clock seconds]
}
proc resized {this} {
set width [$widget::($this,path) extents plotwidth]
if {$width!=$dataGraph::($this,plotWidth)} {
set dataGraph::($this,plotWidth) $width
updateGraduations $this ;# optimize graduations for new plot width
}
}
}
class dataGraph {
class element {
set (vectorIndex) 0 ;### remove with official BLT when #auto feature works ###
proc element {this path args} switched {$args} {
global [set ($this,xVector) vector[incr (vectorIndex)]] [set ($this,yVector) vector[incr (vectorIndex)]]
$path element create $this -label {} -symbol none ;# use object identifier as element identifier
set dots [expr {$configuration::(graphNumberOfIntervals)+1}]
if {$::officialBLT} {
### blt::vector create #auto($dots) should ultimately work ###
global [set ($this,weights) vector[incr (vectorIndex)]] ;### necessary? namespace variable automatically created? ###
blt::vector create [set ($this,xVector)]($dots) ;# x axis data vector
blt::vector create [set ($this,yVector)]($dots) ;# y axis data vector
blt::vector create [set ($this,weights)]($dots) ;# weights data vector
$path element configure $this -weight [set ($this,weights)] -styles {{void 0 0}} ;# handle void values
} else {
blt::vector [set ($this,xVector)]($dots)
blt::vector [set ($this,yVector)]($dots)
}
$path element configure $this -xdata [set ($this,xVector)] -ydata [set ($this,yVector)]
set ($this,path) $path
switched::complete $this
}
proc ~element {this} {
global [set ($this,xVector)] [set ($this,yVector)]
if {$::officialBLT} {
global [set ($this,weights)]
blt::vector destroy [set ($this,xVector)] [set ($this,yVector)] [set ($this,weights)]
} else {
unset [set ($this,xVector)] [set ($this,yVector)]
}
[set ($this,path)] element delete $this
if {[string length $switched::($this,-deletecommand)]>0} {
uplevel #0 $switched::($this,-deletecommand) ;# always invoke command at global level
}
}
proc options {this} {
return [list\
[list -color black black]\
[list -deletecommand {} {}]\
[list -label {} {}]\
]
}
foreach option {-color -label} {
proc set$option {this value} "\[set (\$this,path)\] element configure \$this $option \$value"
}
proc set-deletecommand {this value} {} ;# data is stored at switched level
if {$::officialBLT} {
proc update {this x y} {
global [set ($this,xVector)] [set ($this,yVector)] [set ($this,weights)]
if {[set [set ($this,xVector)](end)]==0} { ;# first update
if {[string length $y]==0} return ;# do nothing till we get a valid value
set [set ($this,xVector)](end) $x ;# make 2 last points identical so a dot is traced
set [set ($this,yVector)](end) $y
}
[set ($this,xVector)] delete 0 ;# achieve scrolling by deleting first element
[set ($this,yVector)] delete 0
[set ($this,weights)] delete 0
[set ($this,xVector)] append $x ;# and appending new value
if {[string length $y]==0} { ;# void new value
[set ($this,yVector)] append [set [set ($this,yVector)](end)] ;# append last known value
[set ($this,weights)] append 0 ;# and display with void style
[set ($this,path)] element configure $this -label "$switched::($this,-label): ?"
} else { ;# valid new valid
[set ($this,yVector)] append $y
[set ($this,weights)] append 1 ;# normal style
[set ($this,path)] element configure $this -label "$switched::($this,-label): $y"
}
}
} else {
proc update {this x y} {
global [set ($this,xVector)] [set ($this,yVector)]
if {[string length $y]==0} { ;# void new value
set y 0 ;# cannot handle void type
[set ($this,path)] element configure $this -label "$switched::($this,-label): ?"
} else {
[set ($this,path)] element configure $this -label "$switched::($this,-label): $y"
}
if {[set [set ($this,xVector)](end)]==0} { ;# first update
set [set ($this,xVector)](:) $x ;# make all points identical so curve seems to start from first valid value
set [set ($this,yVector)](:) $y
}
[set ($this,xVector)] delete 0 ;# achieve scrolling by deleting first element
[set ($this,yVector)] delete 0
[set ($this,xVector)] append $x ;# and appending new value
[set ($this,yVector)] append $y
}
}
}
}
|
