File: datagraf.tcl

package info (click to toggle)
moomps 4.6-2
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 2,444 kB
  • ctags: 2,307
  • sloc: tcl: 34,882; sh: 167; makefile: 91
file content (344 lines) | stat: -rw-r--r-- 18,367 bytes parent folder | download | duplicates (2)
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
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
# copyright (C) 1997-2005 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: datagraf.tcl,v 2.70 2005/02/05 21:25:47 jfontain Exp $


class dataGraph {

    proc dataGraph {this parentPath args} composite {[new frame $parentPath] $args} blt2DViewer {
        $widget::($this,path) [blt::stripchart $widget::($this,path).graph -title {}] 5
    } {
        set ($this,graphPath) $widget::($this,path).graph
        $($this,graphPath) pen create void -linewidth 0 -symbol none                                          ;# pen for void values
        $($this,graphPath) grid configure -minor 0
        set graph [new bltGraph $($this,graphPath) $this]
        bltGraph::hideAxisAndCrossHair $graph 1
        $blt2DViewer::($this,menu) add checkbutton\
            -label $bltGraph::(menu,grid,label) -command "composite::configure $this -grid \$dataGraph::($this,-grid)"\
            -variable dataGraph::($this,-grid) -offvalue 0 -onvalue 1                                ;# add grid toggling menu entry
        menuContextHelp::set $blt2DViewer::($this,help) [$blt2DViewer::($this,menu) index end] $bltGraph::(menu,grid,help)
        after idle "dataGraph::updateMessage $this"                               ;# delayed since it needs object to be constructed
        set ($this,graph) $graph
        composite::complete $this
    }

    proc ~dataGraph {this} {
        delete $($this,graph)
        if {[string length $composite::($this,-deletecommand)] > 0} {
            uplevel #0 $composite::($this,-deletecommand)                                   ;# always invoke command at global level
        }
    }

    proc iconData {} {
        return {
            R0lGODdhJAAkAKUAAPj8+Hh4eDBgIDBgGKDscJDcaIjQYHjAWDg4OHC0UGikSFiYQHh8eHBIAPDcSODQQNjEONC8MMiwMMCoKLicIAAAABBgeICEgKjU4JCY
            kLi8uIiQiJjI2IjA0NDY0KCkoIC4yKisqHCwwGikuMDEwFicsMjQyODk4Ojs6AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAJAAkAAAG/kCAcCgMEI/G4zBZVBKZSijy6VxWAVKqFRsICL7dsNgrGAjGAbMZLRQQ3gKs0v0mxId0eBNf
            6BfORF9+fl+Cg4BQAgaLi3cAioyRkoxnRklhAgeamoWbnJmem18IpGKBCaipqmAIX6tnCExZjwq1trWVAbFkYF0IWnMCC8PDlXtje8dovL1jDMvQVbthwFHV
            Sg3Z2VNVULMA2Q7i4g3X1ZdiDQ/r7OsNaNrv0F1EDRD3+PnbAdn65d5HGkQYOFAbwYICDxLctkVIAwkQIcrjF7GixYrllDWYwHFCA1Igs3XsGG+kx2lJGlBY
            +e7XE5UrKUzkF1OmpYDZfEWJF4DBzxKeN5HQcxkllk8iz3btqcC0qdOnUKNKZUDVglWqWLMysHpVK1cLWhlcuGABg1kLGdKqTVvWLAYLGuJqaHtW7NgLGzZY
            4MCXA1y5c/f25ft1sF8GefOy7cCYsQUPkC00nkx5MlgGaz9otgCic2eunkF8De25q+bTIVKHsCCitevXXa3CvsxAtWrAc0fo3q2btoaqXLHilkuiuHGrJZIn
            v2y8uNbm0EmYmE7dxNavVKtr374dsnfvYb+LH0/+hPnz6NOrX88ehfv38OPLn08/CAA7
        }
    }

    proc options {this} {
        set samples [expr {$global::graphNumberOfIntervals + 1}]
        return [list\
            [list -cellcolors {} {}]\
            [list -deletecommand {} {}]\
            [list -draggable 0 0]\
            [list -grid $global::graphDisplayGrid]\
            [list -height $global::viewerHeight]\
            [list -interval 0 0]\
            [list -labelsposition right]\
            [list -plotbackground $global::graphPlotBackground]\
            [list -samples $samples $samples]\
            [list -width $global::viewerWidth]\
            [list -xlabelsrotation $global::graphXAxisLabelsRotation]\
            [list -ymaximum {} {}]\
            [list -ymaximumcell {} {}]\
            [list -yminimum $global::graphMinimumY]\
            [list -yminimumcell {} {}]\
        ]
    }

    proc set-cellcolors {this value} {                             ;# colors of soon to be created cells when initializing from file
        if {$composite::($this,complete)} {
            error {option -cellcolors cannot be set dynamically}
        }
        blt2DViewer::setCellColors $this $value
    }

    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
            bltGraph::allowDrag $($this,graph) $blt2DViewer::($this,drag)                                     ;# extend drag formats
        }
    }

    proc set-grid {this value} {
        if {$value} {
            $($this,graphPath) grid configure -hide no
        } else {
            $($this,graphPath) grid configure -hide yes
        }
        set ($this,-grid) $value                                                ;# so that corresponding popup menu entry is updated
    }

    proc set-interval {this value} {
        set graph $($this,graph)
        bltGraph::setRange $graph [expr {($composite::($this,-samples) - 1) * $value}]
        bltGraph::xAxisUpdateRange $graph
        bltGraph::xUpdateGraduations $graph
    }

    proc set-samples {this value} {                                                                     ;# stored at composite level
        if {$composite::($this,-interval) == 0} return                                           ;# useless in database history mode
        set graph $($this,graph)
        bltGraph::setRange $graph [expr {($value - 1) * $composite::($this,-interval)}]
        bltGraph::xAxisUpdateRange $graph
        bltGraph::xUpdateGraduations $graph
    }

    proc set-labelsposition {this value} {
        blt2DViewer::updateLayout $this
    }

    proc set-plotbackground {this value} {
        $($this,graphPath) configure -plotbackground $value
        $($this,graphPath) pen configure void -color $value
        $($this,graphPath) grid configure -color [visibleForeground $value]
    }

    proc set-xlabelsrotation {this value} {
        bltGraph::xRotateLabels $($this,graph) $value
    }

    proc set-ymaximum {this value} {
        blt2DViewer::setLimit $this maximum $value
    }
    proc set-ymaximumcell {this value} {
        blt2DViewer::setLimitCell $this maximum $value
    }
    proc set-yminimum {this value} {
        blt2DViewer::setLimit $this minimum $value
    }
    proc set-yminimumcell {this value} {
        blt2DViewer::setLimitCell $this minimum $value
    }

    proc newElement {this path args} {                                                          ;# invoked from 2D viewer base class
        return [eval new element $path $composite::($this,-interval) $args]
    }

    proc updateTimeDisplay {this seconds} {
        bltGraph::xAxisUpdateRange $($this,graph) $seconds
    }

    proc updateElement {this element seconds value} {                           ;# value is either a valid number or the ? character
        element::update $element $seconds $value
    }

    proc canMonitor {this array} {
        if {$composite::($this,-interval) > 0} {
            return 1                                                                                             ;# not history mode
        } else {                              ;# check that cells belong to instance module, and not summary table data, for example
            return [string equal [lindex [modules::decoded $array] 0] instance]
        }
    }

    proc update {this array} {               ;# update display using cells data (implementation identical to dataStackedGraph class)
        if {$composite::($this,-interval) > 0} {                                                                 ;# not history mode
            return [blt2DViewer::_update $this $array]                                                    ;# use base implementation
        }
        foreach element $blt2DViewer::($this,elements) {                                                             ;# history mode
            set cell $blt2DViewer::($this,cell,$element)
            foreach {start end} [databaseInstances::range $cell] {}           ;# database cell range in seconds (limited by cursors)
            if {[string length $start] == 0} {                                                                    ;# no history data
                element::range $element {}                                                                       ;# let element know
                continue
            }
            set start [clock scan $start]
            set end [clock scan $end]
            if {($element::($element,start) == $start) && ($element::($element,end) == $end)} {
                continue                                                ;# no range change: avoid potentially lengthy database query
            }
            element::range $element [databaseInstances::history $cell]                                    ;# (inside cursors limits)
        }
        foreach {minimum maximum} [databaseInstances::cursorsRange] {}                                                 ;# in seconds
        set graph $($this,graph)
        bltGraph::setRange $graph [expr {$maximum - $minimum}]
        bltGraph::xUpdateGraduations $graph
        bltGraph::xAxisUpdateRange $graph $maximum
        if {[info exists cell]} {                                                 ;# no maximum can exist when there are no elements
            blt2DViewer::updateLimit $this maximum $array                      ;# note: maximum cell will take value at end of range
        }
    }

    proc modified {this monitored} {                                                                    ;# number of monitored cells
        bltGraph::hideAxisAndCrossHair $($this,graph) [expr {$monitored == 0}]                     ;# hide if no elements to display
        updateMessage $this
    }

    proc updateMessage {this} {
        if {[llength [blt2DViewer::cells $this]] == 0} {
            centerMessage $widget::($this,path)\
                [mc "graph chart:\ndrop data cell(s)"] $composite::($this,-plotbackground) $global::viewerMessageColor
        } else {
            centerMessage $widget::($this,path) {}
        }
    }

    proc initializationConfiguration {this} {
        return [concat\
            [list\
                -ymaximum $composite::($this,-ymaximum) -ymaximumcell $composite::($this,-ymaximumcell)\
                -yminimum $composite::($this,-yminimum) -yminimumcell $composite::($this,-yminimumcell)\
                -labelsposition $composite::($this,-labelsposition) -grid $composite::($this,-grid)\
            ] [blt2DViewer::_initializationConfiguration $this]\
        ]
    }

    virtual proc updateLabels {this} {
        blt2DViewer::_updateLabels $this [expr {$composite::($this,-interval) > 0}]             ;# no values display in history mode
    }

}


class dataGraph {

    class element {

        proc element {this path interval args} switched {$args} {
            variable x$this
            variable y$this
            variable weight$this

            if {$interval == 0} {                                               ;# history mode: whole samples set will come at once
                blt::vector create x${this}
                blt::vector create y${this}
                blt::vector create weight${this}
                set ($this,start) 0
                set ($this,end) 0
            } else {                                                            ;# interval is required to properly draw first point
                set dots [expr {$global::graphNumberOfIntervals + 1}]
                blt::vector create x${this}($dots)                                                             ;# x axis data vector
                blt::vector create y${this}($dots)                                                             ;# y axis data vector
                blt::vector create weight${this}($dots)                                                       ;# weights data vector
            }
            # use object identifier as element identifier, and handle void values
            $path element create $this -label {} -xdata x$this -ydata y$this -weight weight$this -styles {{void 0 0}}
            if {$interval == 0} {
                $path element configure $this -pixels 1               ;# so that lone valid sample among voids is displayed as a dot
            } else {
                $path element configure $this -symbol none
            }
            set ($this,path) $path
            set ($this,interval) $interval
            switched::complete $this
        }

        proc ~element {this} {
            variable x$this
            variable y$this
            variable weight$this

            blt::vector destroy x$this y$this weight$this
            $($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 {} {}]\
            ]
        }

        proc set-color {this value} {
            $($this,path) element configure $this -color $value
        }

        proc set-deletecommand {this value} {}                                                   ;# data is stored at switched level

        proc update {this x y} {                         ;# when interval is not zero. y is either a valid number or the ? character
            variable x$this
            variable y$this
            variable weight$this

            if {[x${this} index end] == 0} {                                                                         ;# first update
                if {[string equal $y ?]} return                                              ;# do nothing till we get a valid value
                # make an horizontal line as short as possible so that first point is visible:
                x${this} index : [expr {$x - $($this,interval)}]
                y${this} index : $y
                weight${this} index end 1
                unset ($this,interval)                                                                           ;# free some memory
            }
            set length [llength [x$this search 0 [$($this,path) xaxis cget -min]]]
            incr length -2          ;# scroll by removing points to the left of the x axis minimum (fails when there is no data yet)
            catch {x$this delete :$length; y$this delete :$length; weight$this delete :$length}
            x$this append $x                                                                              ;# and appending new value
            if {[string equal $y ?]} {                                                                             ;# void new value
                y$this append [y${this} index end]                                                        ;# append last known value
                weight$this append 0                                                                  ;# and display with void style
            } else {                                                                                              ;# valid new value
                y$this append $y
                weight$this append 1                                                                                 ;# normal style
            }
        }

        proc range {this list} {    ;# when interval is zero. set a whole set of points at once. list is flat: timestamp, value, ...
            variable x$this
            variable y$this
            variable weight$this

            ### note: do not use the following code since that causes parasite lines to be displayed (using BLT 2.4z):
            # catch {x$this delete 0 end; y$this delete 0 end; weight$this delete 0 end}
            blt::vector destroy x$this y$this weight$this                               ;# clear first so only new data is displayed
            blt::vector create x${this}; blt::vector create y${this}; blt::vector create weight${this}
            foreach {stamp value} $list {                                        ;# assumes that timestamps are ordered increasingly
                set stamp [clock scan $stamp]
                if {[string length $value] == 0} {        ;# void value (instead of ? since data is assumed to come from a database)
                    if {[info exists xValid]} {
                        x$this append $xValid; y$this append $yValid      ;# use last known valid value for start point of void line
                        weight$this append 0                                                              ;# display with void style
                        unset xValid yValid
                    }
                    set void {}                                                              ;# delay drawing until next valid value
                } else {
                    if {[info exists void]} {                                                                           ;# in a hole
                        x$this append $stamp; y$this append $value                ;# use next valid value for end point of void line
                        weight$this append 0                                                              ;# display with void style
                        unset void
                    }
                    x$this append [set xValid $stamp]; y$this append [set yValid $value]
                    weight$this append 1                                                                             ;# normal style
                }
            }
            $($this,path) element configure $this -xdata x$this -ydata y$this -weight weight$this
            if {[llength $list] == 0} {                                                                         ;# no samples at all
                set ($this,start) 0
                set ($this,end) 0
            } else {                                                       ;# remember whole data (even including voids) time limits
                set ($this,start) [clock scan [lindex $list 0]]                                 ;# remember range extents separately
                set ($this,end) [clock scan [lindex $list end-1]]              ;# (since null values are not saved in vectors above)
            }
        }

    }

}