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
|
# 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: blt2d.tcl,v 1.25 1998/10/10 20:58:19 jfontain Exp $}
class blt2DViewer {
# use pie colors for consistency
set blt2DViewer::(colors) {#7FFFFF #7FFF7F #FF7F7F #FFFF7F #7F7FFF #FFBF00 #BFBFBF #FF7FFF #FFFFFF}
proc blt2DViewer {this path} viewer {} {
$path configure -cursor {}
if {$::officialBLT} {
$path configure -plotpadx 2 -plotpady 2 ;# use minimum padding for extreme values and flat zero line to be visible
$path yaxis configure -tickshadow {}
}
$path yaxis configure -title {} -tickfont $font::(smallNormal)
$path legend configure -borderwidth 1 -font $font::(mediumNormal) -activebackground white
# allow dropping of data cells
set blt2DViewer::($this,drop) [new dropSite\
-path $path -formats DATACELLS -command "viewer::view $this \$dragSite::data(DATACELLS)"\
]
set blt2DViewer::($this,elements) {} ;# initialize list of data line identifiers
set blt2DViewer::($this,colorIndex) 0
set blt2DViewer::($this,path) $path
}
proc ~blt2DViewer {this} {
catch {delete $blt2DViewer::($this,drag)}
delete $blt2DViewer::($this,drop)
catch {delete $blt2DViewer::($this,selector)}
eval delete $blt2DViewer::($this,elements) ;# delete existing elements
}
proc supportedTypes {this} {
return {integer real}
}
proc dragData {this format} {
set selectedElements [selector::selected $blt2DViewer::($this,selector)]
switch $format {
OBJECTS {
if {[llength $selectedElements]>0} {
return $selectedElements ;# return selected elements if there are any
} elseif {[llength $blt2DViewer::($this,elements)]==0} {
return $this ;# return graph itself if it contains no elements
} else {
return {} ;# return nothing otherwise
}
}
DATACELLS {
return [cellsFromElements $this $selectedElements]
}
}
}
proc validateDrag {this x y} {
if {[llength $blt2DViewer::($this,elements)]==0} {
return 1 ;# allow drag of empty viewer
}
# allow dragging if only from a selected cell
return [expr {\
[lsearch -exact [selector::selected $blt2DViewer::($this,selector)] [$blt2DViewer::($this,path) legend get @$x,$y]]>=0\
}]
}
proc monitorCell {this array row column} {
viewer::registerTrace $this $array
set cell ${array}($row,$column)
if {[lsearch -exact [cellsFromElements $this $blt2DViewer::($this,elements)] $cell]>=0} return ;# already charted, abort
set element [newElement $this $blt2DViewer::($this,path) -label [viewer::label $array $row $column]]
switched::configure $element -color [lindex $blt2DViewer::(colors) $blt2DViewer::($this,colorIndex)]
# keep track of element existence
switched::configure $element -deletecommand "blt2DViewer::deletedElement $this $array $element"
# circle through colors
set blt2DViewer::($this,colorIndex) [expr {($blt2DViewer::($this,colorIndex)+1)%[llength $blt2DViewer::(colors)]}]
lappend blt2DViewer::($this,elements) $element ;# register new data line
set blt2DViewer::($this,cell,$element) $cell
catch {selector::add $blt2DViewer::($this,selector) $element} ;# selector may not exist if dragging disallowed
}
proc cells {this} {
return [cellsFromElements $this $blt2DViewer::($this,elements)]
}
proc deletedElement {this array element} {
viewer::unregisterTrace $this $array ;# trace may no longer be needed on this array
ldelete blt2DViewer::($this,elements) $element
catch {selector::remove $blt2DViewer::($this,selector) $element} ;# selector may not exist if dragging disallowed
unset blt2DViewer::($this,cell,$element)
if {[llength $blt2DViewer::($this,elements)]==0} {
delete $this ;# self destruct when there are no more elements
}
}
proc update {this array args} { ;# update display using cells data
updateTimeDisplay $this [set seconds [clock seconds]]
foreach element $blt2DViewer::($this,elements) {
set cell $blt2DViewer::($this,cell,$element)
if {[string first $array $cell]<0} continue ;# check that cell belongs to updated array
set value {} ;# set default to void in case data no longer exists
catch {set value [set $cell]}
updateElement $this $element $seconds $value
}
}
virtual proc newElement {this path args} ;# let derived class create an element of its own
virtual proc updateElement {this element seconds value} ;# let derived class (such as graph, bar chart, ...) update element
virtual proc updateTimeDisplay {this seconds} {} ;# eventually let derived class (such as graph) update axis, for example
proc cellsFromElements {this elements} {
set cells {}
foreach element $elements {
lappend cells $blt2DViewer::($this,cell,$element)
}
return $cells
}
proc setElementsState {this elements select} {
if {$select} {
set action activate
} else {
set action deactivate
}
set path $blt2DViewer::($this,path)
foreach element $elements {
$path legend $action $element
}
}
proc setSelection {this x y} {
if {[string length [set element [$blt2DViewer::($this,path) legend get @$x,$y]]]>0} { ;# in a legend
selector::select $blt2DViewer::($this,selector) $element
}
}
proc toggleSelection {this x y} {
if {[string length [set element [$blt2DViewer::($this,path) legend get @$x,$y]]]>0} { ;# in a legend
selector::toggle $blt2DViewer::($this,selector) $element
}
}
proc extendSelection {this x y} {
if {[string length [set element [$blt2DViewer::($this,path) legend get @$x,$y]]]>0} { ;# in a legend
selector::extend $blt2DViewer::($this,selector) $element
}
}
proc allowDrag {this} {
set path $blt2DViewer::($this,path)
set blt2DViewer::($this,drag) [new dragSite -path $path -validcommand "blt2DViewer::validateDrag $this"]
dragSite::provide $blt2DViewer::($this,drag) OBJECTS "blt2DViewer::dragData $this" ;# provide list of objects
dragSite::provide $blt2DViewer::($this,drag) DATACELLS "blt2DViewer::dragData $this"
set blt2DViewer::($this,selector) [new objectSelector -selectcommand "blt2DViewer::setElementsState $this"]
bind $path <ButtonRelease-1> "blt2DViewer::setSelection $this %x %y"
bind $path <Control-ButtonRelease-1> "blt2DViewer::toggleSelection $this %x %y"
bind $path <Shift-ButtonRelease-1> "blt2DViewer::extendSelection $this %x %y"
}
}
|
