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
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
|
# 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: blt2d.tcl,v 2.89 2005/02/12 21:10:04 jfontain Exp $
class blt2DViewer {
set (axisTickFont) $font::(smallNormal)
proc blt2DViewer {this parentPath path {labelsColorHeight 0} {noMinimum 0}} viewer {} {
if {$noMinimum} {set ($this,noMinimum) {}}
set ($this,path) $path ;# BLT viewer path
$path configure -background $viewer::(background) -cursor {} -highlightthickness 0\
-plotpadx 1 -plotpady 2 ;# use minimum padding for extreme values, flat zero line to be visible
$path yaxis configure -tickshadow {} -title {} -tickfont $(axisTickFont)
# $path yaxis configure -tickshadow {} -title {} -tickfont $(axisTickFont) -minorticks {0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9}
$path legend configure -hide 1 ;# use custom labeler instead allowing coloring for thresholds
set labels [new colorLabels $parentPath -colorheight $labelsColorHeight]
viewer::setupDropSite $this $parentPath ;# allow dropping of data cells in whole viewer window
set menu [menu $path.menu -tearoff 0]
set ($this,help) [new menuContextHelp $menu]
set index 0
foreach type [list maximum minimum] {
if {$noMinimum && [string equal $type minimum]} continue
$menu add command -label [mc [string totitle $type]]... -state disabled -command "
viewer::limitEntry $this $path w $index {} -y$type $type $(axisTickFont)\
{blt2DViewer::limitEntered $this $type} {blt2DViewer::plotLimit $this $type} float
"
menuContextHelp::set $($this,help) $index [mc "set ordinate $type value or automatic scaling"]
incr index
}
$menu add cascade -label [mc Labels] -menu [menu $menu.labels -tearoff 0] -state disabled
menuContextHelp::set $($this,help) $index [mc {position of data cells labels relative to the graphics}]
set ($this,labelsHelp) [new menuContextHelp $menu.labels]
$menu.labels add radiobutton -label [mc Right] -variable ::blt2DViewer::($this,labelsPosition) -value right\
-command "composite::configure $this -labelsposition right"
menuContextHelp::set $($this,labelsHelp) 0 [mc {place data cells labels on the right}]
$menu.labels add radiobutton -label [mc Bottom] -variable ::blt2DViewer::($this,labelsPosition) -value bottom\
-command "composite::configure $this -labelsposition bottom"
menuContextHelp::set $($this,labelsHelp) 1 [mc {place data cells labels on the bottom}]
$menu.labels add radiobutton -label [mc Left] -variable ::blt2DViewer::($this,labelsPosition) -value left\
-command "composite::configure $this -labelsposition left"
menuContextHelp::set $($this,labelsHelp) 2 [mc {place data cells labels on the left}]
$menu.labels add radiobutton -label [mc Top] -variable ::blt2DViewer::($this,labelsPosition) -value top\
-command "composite::configure $this -labelsposition top"
menuContextHelp::set $($this,labelsHelp) 3 [mc {place data cells labels on top}]
bindtags $parentPath [concat [bindtags $parentPath] PopupMenu$this]
bindtags $path [concat [bindtags $path] PopupMenu$this]
set ($this,colorsMenu) [viewer::createColorsMenu $path "blt2DViewer::setColor $this \$colorLabels::label::(clicked) %c"]
if {!$global::readOnly} {
bind PopupMenu$this <ButtonPress-3> "tk_popup $menu %X %Y"
}
foreach type [list maximum minimum] {
set label [new imageLabel $path -font $(axisTickFont) -bindtags PopupMenu$this]
set ($this,drop,$type) [new dropSite -path $path -formats DATACELLS -state disabled\
-regioncommand "blt2DViewer::dropRegion $this $type" -command "blt2DViewer::limitCellDrop $this $type"\
]
set ($this,tips,$type) {}
if {!$global::readOnly} {
set tip [new widgetTip -path $path -state disabled]
switch $type {
maximum {switched::configure $tip -rectangle [list 0 0 $viewer::(limitAreaWidth) $viewer::(limitAreaHeight)]}
minimum {
set ($this,tip,minimum) $tip ;# minimum tip area can move when resizing: update dynamically
}
}
lappend ($this,tips,$type) $tip
lappend ($this,tips,$type) [new widgetTip -path $widget::($label,path)]
}
set ($this,$type) $label
set ($this,limit,$type) {}
updateTip $this $type
}
set ($this,elements) {}
set ($this,labels) $labels
set ($this,menu) $menu
positionLimitLabel $this maximum 0; positionLimitLabel $this minimum 0
bind $path <Configure> "+ blt2DViewer::refresh $this" ;# track size updates
}
proc ~blt2DViewer {this} {
set ($this,destruction) {}
bind $($this,path) <Configure> {}
if {[info exists ($this,drag)]} {
delete $($this,drag)
}
eval delete $($this,elements) ;# delete existing elements
if {[info exists ($this,selector)]} {
delete $($this,selector)
}
eval delete $($this,labels) $($this,help) $($this,labelsHelp) $($this,drop,maximum) $($this,drop,minimum)\
$($this,tips,maximum) $($this,tips,minimum) $($this,maximum) $($this,minimum)
}
proc supportedTypes {this} {
return $global::numericDataTypes
}
# colors of soon to be created cells when initializing from file (invoked from derived classes option procedure)
proc setCellColors {this list} {
set ($this,nextCellIndex) 0 ;# initialize cell index in list of colors
}
proc dragData {this format} {
set legends [selector::selected $($this,selector)]
set selectedElements {}
foreach element $($this,elements) {
if {[lsearch -exact $legends $($this,legend,$element)] < 0} continue
lappend selectedElements $element
}
switch $format {
OBJECTS {
if {[llength $selectedElements] > 0} {
return $selectedElements ;# return selected elements if there are any
} elseif {[llength $($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 legend x y} {
if {($legend == 0) && ([llength $($this,elements)] == 0)} {
return 1 ;# allow drag of empty viewer
} elseif {[lsearch -exact [selector::selected $($this,selector)] $legend] >= 0} {
return 1 ;# allow dragging from selected legend only
} else {
return 0
}
}
proc monitorCell {this array row column} {
set cell ${array}($row,$column)
if {![canMonitor $this $array]} return
if {[lsearch -exact [cellsFromElements $this $($this,elements)] $cell] >= 0} return ;# already charted, abort
viewer::registerTrace $this $array
if {[info exists ($this,nextCellIndex)]} { ;# recreate data cell color from recorded configuration
set color [lindex $composite::($this,-cellcolors) $($this,nextCellIndex)]
if {[string length $color] == 0} { ;# colors list exhausted: we are done initializing from recorded data
unset color ($this,nextCellIndex)
} else {
incr ($this,nextCellIndex) ;# get ready for upcoming cell
}
}
if {![info exists color]} {set color [viewer::getDisplayColor $cell]}
set element [newElement $this $($this,path) -color $color]
if {$global::readOnly} {
set legend [colorLabels::new $($this,labels) {} -color $color]
} else {
set legend [colorLabels::new $($this,labels) $($this,colorsMenu) -color $color]
}
# keep track of element existence
switched::configure $element -deletecommand "blt2DViewer::deletedElement $this $array $element"
lappend ($this,elements) $element
updateLayout $this
foreach [list ($this,label,$element) incomplete] [viewer::label $array $row $column] {}
set ($this,legend,$element) $legend
set ($this,cell,$element) $cell
if {$composite::($this,-draggable)} { ;# selector may not exist if dragging disallowed
set labelPath $composite::($legend,label,path)
set drag [new dragSite -path $labelPath -validcommand "blt2DViewer::validateDrag $this $legend"]
dragSite::provide $drag OBJECTS "blt2DViewer::dragData $this"
dragSite::provide $drag DATACELLS "blt2DViewer::dragData $this"
set ($this,drag,$element) $drag
set selector $($this,selector)
selector::add $selector $legend
bind $labelPath <ButtonPress-1> "blt2DViewer::buttonPress $selector $legend"
bind $labelPath <Control-ButtonPress-1> "selector::toggle $selector $legend"
bind $labelPath <Shift-ButtonPress-1> "selector::extend $selector $legend"
bind $labelPath <ButtonRelease-1> "blt2DViewer::buttonRelease $selector $legend 0"
bind $labelPath <Control-ButtonRelease-1> "blt2DViewer::buttonRelease $selector $legend 1"
bind $labelPath <Shift-ButtonRelease-1> "blt2DViewer::buttonRelease $selector $legend 1"
}
if {$incomplete} { ;# label cannot be determined yet
set ($this,relabel,$element) {}
} else { ;# display label without value, which suffices when displaying data cells histories
composite::configure $($this,legend,$element) -text $($this,label,$element)
}
switched::configure $($this,drop,maximum) -state normal
foreach tip $($this,tips,maximum) {switched::configure $tip -state normal}
if {![info exists ($this,noMinimum)]} {
switched::configure $($this,drop,minimum) -state normal
foreach tip $($this,tips,minimum) {switched::configure $tip -state normal}
}
for {set index 0} {$index <= [$($this,menu) index end]} {incr index} {
$($this,menu) entryconfigure $index -state normal
}
modified $this [llength $($this,elements)]
}
virtual proc canMonitor {this array} {
return 1
}
proc cells {this} { ;# note: always return cells in the same order
return [cellsFromElements $this $($this,elements)]
}
proc deletedElement {this array element} {
viewer::unregisterTrace $this $array ;# trace may no longer be needed on this array
ldelete ($this,elements) $element
if {$composite::($this,-draggable)} {
delete $($this,drag,$element)
selector::remove $($this,selector) $($this,legend,$element)
}
colorLabels::delete $($this,labels) $($this,legend,$element)
set length [llength $($this,elements)]
if {$length == 0} { ;# nothing to monitor
updateLayout $this
composite::configure $this -ymaximum {} -ymaximumcell {} ;# possibly remove limits as Y axis becomes empty
if {![info exists ($this,noMinimum)]} {
composite::configure $this -yminimum {} -yminimumcell {}
}
positionLimitLabel $this maximum 0; positionLimitLabel $this minimum 0
switched::configure $($this,drop,maximum) -state disabled; switched::configure $($this,drop,minimum) -state disabled
foreach tip [concat $($this,tips,maximum) $($this,tips,minimum)] {switched::configure $tip -state disabled}
for {set index 0} {$index <= [$($this,menu) index end]} {incr index} {
$($this,menu) entryconfigure $index -state disabled
}
}
viewer::returnDisplayColor $($this,cell,$element)
unset ($this,cell,$element) ($this,label,$element) ($this,legend,$element)
if {![info exists ($this,destruction)]} {modified $this $length} ;# do not invoke virtual procedure while being deleted
}
virtual proc update {this array} { ;# update display using cells data (virtual for viewers that handle cells histories)
updateTimeDisplay $this [set seconds [clock seconds]]
foreach element $($this,elements) {
set cell $($this,cell,$element)
if {[string first $array $cell] != 0} continue ;# check that cell belongs to updated array
if {[catch {set value [set $cell]}]} {
updateElement $this $element $seconds ? ;# data no longer exists
composite::configure $($this,legend,$element) -text "$($this,label,$element): ?"
} else { ;# cell exists
if {[info exists ($this,relabel,$element)]} { ;# if label is not yet defined, update it
viewer::parse $cell ignore row column ignore
foreach [list ($this,label,$element) incomplete] [viewer::label $array $row $column] {}
if {!$incomplete} { ;# label now completely defined
unset ($this,relabel,$element)
}
}
if {[string is double -strict $value]} { ;# check if numeric
updateElement $this $element $seconds $value ;# may be ? if cell value is meant to be void
} else {
updateElement $this $element $seconds ? ;# do not fail on non-numeric value
}
composite::configure $($this,legend,$element) -text "$($this,label,$element): $value"
}
}
if {[info exists cell]} { ;# no limits can exist when there are no elements
updateLimit $this maximum $array
if {[info exists ($this,relabelTip,maximum)]} {updateTip $this maximum}
if {![info exists ($this,noMinimum)]} {
updateLimit $this minimum $array
if {[info exists ($this,relabelTip,minimum)]} {updateTip $this minimum}
}
refresh $this ;# since vertical axis position can change due to tick labels changing
}
}
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} {} ;# possibly let derived class (such as graph) update axis, for example
virtual proc initializationConfiguration {this} {
set colors {}
foreach element $($this,elements) {
lappend colors [switched::cget $element -color]
}
return [list -cellcolors $colors] ;# note: always return colors in the same order
}
proc cellsFromElements {this elements} {
set cells {}
foreach element $elements {
lappend cells $($this,cell,$element)
}
return $cells
}
proc monitored {this cell} {
foreach element $($this,elements) {
if {[string equal $($this,cell,$element) $cell]} {
return 1
}
}
return 0
}
proc setLegendsState {this legends select} {
if {$select} {
set relief sunken
} else {
set relief flat
}
foreach legend $legends {
composite::configure $legend -relief $relief
}
}
proc allowDrag {this} {
set ($this,drag) [new dragSite -path $($this,path) -validcommand "blt2DViewer::validateDrag $this 0"] ;# for empty viewer
dragSite::provide $($this,drag) OBJECTS "blt2DViewer::dragData $this" ;# drag sites for legends are setup dynamically
set ($this,selector) [new objectSelector -selectcommand "blt2DViewer::setLegendsState $this"]
}
proc setCellColor {this cell color} {
foreach element $($this,elements) {
if {[string equal $($this,cell,$element) $cell]} {
composite::configure $($this,legend,$element) -background $color
return ;# done since there cannot be duplicate monitored cells
}
}
}
virtual proc modified {this monitored} {} ;# number of monitored cells has changed
proc buttonPress {selector legend} {
foreach selected [selector::selected $selector] {
if {$selected == $legend} return ;# in an already selected legend, do not change selection
}
selector::select $selector $legend
}
proc buttonRelease {selector legend extended} { ;# extended means that there is an extended selection in process
if {$extended} return
set list [selector::selected $selector]
if {[llength $list] <= 1} return ;# nothing to do if there is no multiple selection
foreach selected $list {
if {$selected == $legend} { ;# in an already selected legend
selector::select $selector $legend ;# set selection to sole legend
return
}
}
}
proc reset {this type} { ;# type is either minimum or maximum
composite::configure $($this,$type) -text {} -image {}
switch $type {
maximum {$($this,path) yaxis configure -max {}}
minimum {$($this,path) yaxis configure -min {}}
}
positionLimitLabel $this $type 0
set ($this,limit,$type) {} ;# reset cache
updateTip $this $type
refresh $this
}
proc updateLimit {this type {array {}}} { ;# type is either minimum or maximum
if {[string length $composite::($this,-y$type)] > 0} { ;# fixed limit
set value $composite::($this,-y$type)
if {[string equal $value $($this,limit,$type)]} return ;# no change in cache
} elseif {([string length $array] > 0) && ![catch {set cell $($this,cell,$type)}]} { ;# limit cell
if {[string first $array $cell] != 0} return ;# check that cell belongs to updated array
set value ?; catch {set value [set $cell]}
if {[string equal $value $($this,limit,$type)]} return ;# no change in cache
} else return ;# no limit, nothing to do
set ($this,limit,$type) $value ;# cache
if {[string equal $value ?]} { ;# void limit value
set value {}
composite::configure $($this,$type) -text ? -image $viewer::(rightDarkGrayArrow)
} else { ;# valid limit value
composite::configure $($this,$type) -text $value -image $viewer::(rightRedArrow)
}
set color black
switch $type {
maximum {
set minimum [$($this,path) yaxis cget -min] ;# note: may be empty is auto-scaling
if {([string length $minimum] == 0) || ($value > $minimum)} { ;# check that current minimum value is compatible
$($this,path) yaxis configure -max $value
} else {
set color red ;# do not change maximum and show user that a problem exists
}
}
minimum {
set maximum [$($this,path) yaxis cget -max] ;# note: may be empty is auto-scaling
if {([string length $maximum] == 0) || ($value < $maximum)} { ;# check that current maximum value is compatible
$($this,path) yaxis configure -min $value
} else {
set color red ;# do not change minimum and show user that a problem exists
}
}
}
composite::configure $($this,maximum) label -foreground $color
composite::configure $($this,minimum) label -foreground $color
refresh $this
}
proc dropRegion {this type} {
set X [winfo rootx $($this,path)]
switch $type {
maximum {set Y [winfo rooty $($this,path)]}
minimum {set Y [expr {[winfo rooty $($this,path)] + [plotLimit $this minimum] - ($viewer::(limitAreaHeight) / 2)}]}
}
return [list $X $Y [expr {$X + $viewer::(limitAreaWidth)}] [expr {$Y + $viewer::(limitAreaHeight)}]]
}
proc plotLimit {this type} { ;# type is either minimum or maximum
switch $type {
maximum {return [$($this,path) yaxis transform [lindex [$($this,path) yaxis limits] 1]]}
minimum {return [$($this,path) yaxis transform [lindex [$($this,path) yaxis limits] 0]]}
}
}
proc limitCellDrop {this type} { ;# type is either minimum or maximum
if {[llength $dragSite::data(DATACELLS)] != 1} {
lifoLabel::flash $global::messenger [mc "only one data cell can be used for $type ordinate"]
bell
return
}
set cell [lindex $dragSite::data(DATACELLS) 0]
viewer::parse $cell ignore ignore ignore cellType
if {[lsearch -exact [supportedTypes $this] $cellType] < 0} { ;# type must exist since cell array exists
viewer::wrongTypeMessage $cellType
} else {
composite::configure $this -y${type}cell $cell
}
}
# invoked by derived class when -yminimum or -ymaximum is set
proc setLimit {this type value} { ;# type is either minimum or maximum
if {[string length $value] == 0} { ;# remove fixed limit value or limit cell
reset $this $type
} else {
composite::configure $this -y${type}cell {}
updateLimit $this $type
updateTip $this $type
}
}
# invoked by derived class when -yminimumcell or -ymaximumcell is set
proc setLimitCell {this type cell} { ;# type is either minimum or maximum
if {[info exists ($this,cell,$type)]} { ;# there was a limit cell
viewer::parse $($this,cell,$type) array ignore ignore ignore
viewer::unregisterTrace $this $array ;# no longer monitor
unset ($this,cell,$type)
}
if {[string length $cell] == 0} {
reset $this $type
} else {
composite::configure $this -y$type {}
viewer::parse $cell array ignore ignore ignore
viewer::registerTrace $this $array
set ($this,cell,$type) $cell
updateLimit $this $type $array
updateTip $this $type
}
}
proc positionLimitLabel {this type visible} { ;# type is either minimum or maximum
set label $($this,$type)
if {$visible} {
::update idletasks ;# so that measurements below are correct
set path $($this,path)
set width [expr {[$path extents leftmargin] - round([$path yaxis cget -ticklength] / 2.0)}]
if {$width < 0} { ;# measurement is incorrect
# try again a bit later (continuously happens in empty viewer but performance impact is negligible)
after 500 "blt2DViewer::positionLimitLabel $this $type 1"
}
composite::configure $label -width $width
# note: apply 1 pixel correction (from observation):
place $widget::($label,path) -anchor e -x $width -y [expr {[plotLimit $this $type] - 1}]
} else {
place forget $widget::($label,path)
}
}
proc limitEntered {this type value} { ;# type is either minimum or maximum
if {[string length $value] == 0} {
composite::configure $this -y${type}cell {} ;# force deletion of limit cell on empty entry
}
composite::configure $this -y$type $value
}
proc updateTip {this type} {
if {[info exists ($this,cell,$type)]} {
viewer::parse $($this,cell,$type) array row column ignore
foreach {label incomplete} [viewer::label $array $row $column] {}
if {$incomplete} {
set ($this,relabelTip,$type) {} ;# label cannot be determined yet
} else { ;# label completely defined
catch {unset ($this,relabelTip,$type)}
}
set text [format [mc "$type cell: %s"] $label]
} elseif {![catch {set value $composite::($this,-y$type)}] && ([string length $value] > 0)} {
# note: composite data does not exist yet when this procedure is invoked from the constructor of this class
set text [format [mc "fixed $type value set to %s"] $value]
} else {
set text [mc "set fixed $type value or drop cell as dynamic $type value here"]
}
foreach tip $($this,tips,$type) {switched::configure $tip -text $text}
}
proc setColor {this legend color} {
foreach element $($this,elements) {
if {$($this,legend,$element) == $legend} break
}
switched::configure $element -color $color
composite::configure $legend -color $color
}
virtual proc updateLabels {this {values 1}} {
if {$values} { ;# include values in labels
foreach element $($this,elements) {
viewer::parse $($this,cell,$element) array ignore ignore ignore
set ($this,relabel,$element) {}
set update($array) {}
}
foreach array [array names update] {
update $this $array
}
} else {
foreach element $($this,elements) {
viewer::parse $($this,cell,$element) array row column ignore
composite::configure $($this,legend,$element)\
-text [set ($this,label,$element) [lindex [viewer::label $array $row $column] 0]]
}
}
if {[info exists ($this,cell,maximum)]} {updateTip $this maximum} ;# if there is a maximum cell
if {[info exists ($this,cell,minimum)]} {updateTip $this minimum} ;# if there is a minimum cell
}
proc updateLayout {this} {
set parentPath $widget::($this,path)
set label [llength $($this,elements)]
set labelsPath $widget::($($this,labels),path)
grid propagate $parentPath 0 ;# so that -width and -height options acting on container frame in derived class work
set ($this,labelsPosition) $composite::($this,-labelsposition)
switch $($this,labelsPosition) {
top - bottom {
grid columnconfigure $parentPath 0 -minsize 0 -weight 1
grid columnconfigure $parentPath 1 -minsize 0 -weight 0
}
left - default { ;# default is right for backward compatibility
grid rowconfigure $parentPath 0 -minsize 0 -weight 1 ;# so that viewer expands vertically
grid rowconfigure $parentPath 1 -minsize 0 -weight 0
}
}
switch $($this,labelsPosition) {
left {
grid $($this,path) -row 0 -column 1 -sticky nsew
if {$label} {grid $labelsPath -row 0 -column 0 -sticky nw}
grid columnconfigure $parentPath 0 -minsize 0 -weight 1
grid columnconfigure $parentPath 1 -minsize 70 -weight 1000
}
top {
grid $($this,path) -row 1 -column 0 -sticky nsew
if {$label} {grid $labelsPath -row 0 -column 0 -sticky nw}
grid rowconfigure $parentPath 0 -minsize 0 -weight 1
grid rowconfigure $parentPath 1 -minsize 100 -weight 1000
}
bottom {
grid $($this,path) -row 0 -column 0 -sticky nsew
if {$label} {grid $labelsPath -row 1 -column 0 -sticky nw}
grid rowconfigure $parentPath 0 -minsize 100 -weight 1000
grid rowconfigure $parentPath 1 -minsize 0 -weight 1
}
default {
grid $($this,path) -row 0 -column 0 -sticky nsew
if {$label} {grid $labelsPath -row 0 -column 1 -sticky nw}
# arrange for labels to remain priorly visible and the graph minimally so:
grid columnconfigure $parentPath 0 -minsize 70 -weight 1000
grid columnconfigure $parentPath 1 -minsize 0 -weight 1
}
}
if {$label} {
grid $labelsPath -ipadx 2 -ipady 2 ;# padding needed for selection sunken relief
} else {
grid forget $labelsPath ;# no need to display an empty labels area
}
}
proc refresh {this} {
if {![info exists ($this,noMinimum)]} {
::update idletasks ;# make sure data is fresh (note: maximum objects do not move vertically)
if {[info exists ($this,tip,minimum)]} { ;# does not exist in read only mode
set y [expr {[plotLimit $this minimum] - ($viewer::(limitAreaHeight) / 2)}]
switched::configure $($this,tip,minimum)\
-rectangle [list 0 $y $viewer::(limitAreaWidth) [expr {$y + $viewer::(limitAreaHeight)}]]
}
if {[info exists ($this,cell,minimum)] || ([string length $composite::($this,-yminimum)] > 0)} {
positionLimitLabel $this minimum 1
}
}
if {[info exists ($this,cell,maximum)] || ([string length $composite::($this,-ymaximum)] > 0)} {
positionLimitLabel $this maximum 1
}
# set path $($this,path)
# foreach {minimum maximum} [$path yaxis limits] {}
# set range [expr {$maximum - $minimum}]
# if {$range <= 0} return
# set height [$path extents plotheight]
# if {$height <= 0} return
# if {\
# [info exists ($this,range)] && ($range == $($this,range)) &&\
# [info exists ($this,height)] && ($height == $($this,height))\
# } return ;# no change
# set ($this,range) $range
# set ($this,height) $height
# # major ticks step: leave at least 2 pixels between adjacent minor ticks (assuming there are 10 between major ticks)
# set step [expr {10 * pow(10, ceil(log10((2.0 * $range) / $height)))}]
# if {$step >= $range} {
# set step [expr {pow(10, floor(log10($range)))}]
# }
# set y [expr {floor($minimum / $step) * $step}]
# for {set list $y} {$y <= $maximum} {} {
# set y [expr {$y + $step}]
# lappend list $y
# }
# $path yaxis configure -majorticks $list
}
}
|
