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
|
# copyright (C) 1997-1999 Jean-Luc Fontaine (mailto:jfontain@multimania.com)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu
set rcsId {$Id: sumtable.tcl,v 2.1 1999/08/28 09:22:49 jfontain Exp $}
class summaryTable {
set ::summaryTable::(nextDataIndex) 0 ;# used when data array index is not specified as an option when creating table
set ::summaryTable::(void) 000000 ;# must look void but be a valid number since it may be dropped in another viewer as is
proc summaryTable {this parentPath args} composite {[new frame $parentPath] $args} viewer {} {
composite::complete $this
variable $($this,dataName) ;# after completion, data array name is defined
array set $($this,dataName) {
updates 0
0,label data 0,type ascii 0,message {data cell description}
1,label current 1,type real 1,message {current value (000000 means void)}
2,label average 2,type real 2,message {average value since viewer creation}
3,label minimum 3,type real 3,message {minimum value since viewer creation}
4,label maximum 4,type real 4,message {maximum value since viewer creation}
sort {0 increasing}
indexColumns 0
}
set ($this,nextRow) 0
# wait till after completion before creating table since some options are not dynamically settable
# use column widths which may have been set at this summary table construction time when data table did not exist yet
set table [new dataTable $widget::($this,path)\
-data summaryTable::$($this,dataName) -draggable $composite::($this,-draggable)\
-titlefont $composite::($this,-titlefont) -columnwidths $composite::($this,-columnwidths)\
]
### hack: drag and drop code should be separated from dataTable which should provide a selected member procedure ###
# allow dropping of data cells ### use same path as drag path to avoid drops in table from table ###
viewer::setupDropSite $this $dataTable::($table,tablePath)
if {$composite::($this,-draggable)} {
# extend data table drag capabilities ### hack ### also eventually allow row selection only instead of cells ###
dragSite::provide $dataTable::($table,drag) OBJECTS "summaryTable::dragData $this"
}
pack $widget::($table,path) -fill both -expand 1
set ($this,dataTable) $table
}
proc ~summaryTable {this} {
variable [set dataName $($this,dataName)]
variable ${this}cellRow
foreach {name wish} [array get {} $this,rowLastWish,*] { ;# delete remaining last wishes, one for each row
delete $wish ;# which in turn deletes row
}
delete $($this,dataTable)
catch {unset ${this}cellRow}
incr ${dataName}(updates) ;# so related viewers can eventually show disappeared cells
unset $dataName
if {[string length $composite::($this,-deletecommand)]>0} {
uplevel #0 $composite::($this,-deletecommand) ;# always invoke command at global level
}
}
proc iconData {} {
return {
R0lGODdhKAAoAIQAAHt5e87PzgAAANbX1v///9/f339/fzk4OUJJQlIIY2sQe2sYe4wQpXMoe70o1qUYvbUYzrUg1msge944/60YznMwe95B/+dJ/70Y3udR
/9YY984Y794o/wAAAAAAAAAAACwAAAAAKAAoAAAF/iAgjmRpnugYAELrvnAsz+0qBHgeDDi/6z6fbjhkBQjIJBKgbDKbyecSaTtCCVJo1ql82gZImniMpRpF
sELBoG672e53QUCqhl9qeDy/b7MFZQRfdy58fWuHiIBeRoQtBpCRkpOUkXQigmcsLwSInZ8FnWygoH8HCAcAgwRpBAakoaGvsaSvl0x2rJyetLGjvaJzI5kC
YLoulcnKt8Qrm4WIh3p7pggIqo3HLYZ903F/w6tp0d2J4Ji5MMrrk8xVaLu/sPK9pgep6XiusJ+z/LbhWBiDEYwfr3nC0GVTx66hO4HwoHmTI23OKXwL8ZCj
Zi4hrowSO1Z8eMORgIYOlgPSKAjsYL05L2wkmNnKHzCbtVgpWMDTBoOfBF2WahlMQIOjDmw8gBCBIcplEo5OsEEBAoVxE/10NFqhggWqFJpqzMqNI9cKF6g6
wIBVZDkBURt8ZYGh7pi7Mhp0zWCjrl8MXQMLHky4cGAMff8CNsy4cVfELDRs4ECZg+PLhTnYqMy5s+fPoDlvDk26tOcVRFKrXr06BAA7
}
}
proc options {this} {
# data index must be forced so that initialization always occur
return [list\
[list -columnwidths columnWidths ColumnWidths {} {}]\
[list -dataindex {}]\
[list -deletecommand {} {}]\
[list -draggable draggable Draggable 0 0]\
[list -titlefont titleFont TitleFont $font::(mediumBold) $font::(mediumBold)]\
]
}
proc set-columnwidths {this value} {
# data table may not have been built if option was passed at construction time
if {![info exists ($this,dataTable)]} return
composite::configure $($this,dataTable) -columnwidths $value
}
# data array name index must be specifiable so that data viewers depending on summary table data array name (through their
# monitored cells) do not fail accessing that data (required when generating viewers from save file)
proc set-dataindex {this value} {
if {$composite::($this,complete)} {
error {option -dataindex cannot be set dynamically}
}
if {[string length $value]>0} { ;# specified, else use internally generated next available index
if {$value<$(nextDataIndex)} {
error "specified data index ($value) is lower than internal summary table index"
}
set ::summaryTable::(nextDataIndex) $value
}
set ($this,dataName) $(nextDataIndex)data ;# generate unique name based on index
incr ::summaryTable::(nextDataIndex)
}
proc set-deletecommand {this value} {}
foreach option {-draggable -titlefont} {
proc set$option {this value} "
if {\$composite::(\$this,complete)} {
error {option $option cannot be set dynamically}
}
"
}
proc supportedTypes {this} {
return {integer real}
}
proc monitorCell {this array row column} {
variable [set dataName $($this,dataName)]
variable ${this}cellRow
viewer::registerTrace $this $array
set cell ${array}($row,$column)
if {[info exists ${this}cellRow($cell)]} return ;# already displayed, abort
set label [viewer::label $array $row $column]
set row $($this,nextRow) ;# next row for this data table
set ${dataName}($row,0) $label
# initialize average, minimum and maximum
array set $dataName [list $row,2 $(void) $row,3 $(void) $row,4 $(void)]
set ${dataName}($row,sum) 0.0
set ${this}cellRow($cell) $row ;# remember cell row
# setup action when a row is deleted through a cell drop in trash
set ($this,rowLastWish,$row) [new lastWish "summaryTable::deleteRow $this $cell"]
incr ($this,nextRow)
}
proc update {this array args} {
variable [set dataName $($this,dataName)]
variable ${this}cellRow
foreach {cell row} [array get ${this}cellRow] {
if {[catch {set $cell} current]||[string equal $current $(void)]} {
# cell does not exist or is another summary table void cell, so propagate here
set ${dataName}($row,1) $(void) ;# do not touch other columns as their content remains valid
} else { ;# data is valid
set ${dataName}($row,1) $current
set ${dataName}($row,2) [format %.2f\
[expr\
{[set ${dataName}($row,sum) [expr {[set ${dataName}($row,sum)]+$current}]]/([set ${dataName}(updates)]+1)}\
]\
]
set value [set ${dataName}($row,3)]
if {[string equal $value $(void)]||($current<$value)} { ;# eventually initialize minimum
set ${dataName}($row,3) $current
}
set value [set ${dataName}($row,4)]
if {[string equal $value $(void)]||($current>$value)} { ;# eventually initialize maximum
set ${dataName}($row,4) $current
}
}
}
incr ${dataName}(updates) ;# let data table update itself
}
proc cells {this} {
variable ${this}cellRow
return [array names ${this}cellRow]
}
proc dragData {this format} {
variable ${this}cellRow
foreach cell [dataTable::dragData $($this,dataTable) $format] { ;# gather rows with at least 1 selected cell
regexp {\(([^,]+)} $cell dummy row
set selected($row) {}
}
set lastWishes {}
foreach row [array names selected] {
lappend lastWishes $($this,rowLastWish,$row)
}
if {[llength $lastWishes]==0} {
return $this ;# self destruct if no rows remain
} else {
return $lastWishes
}
}
proc deleteRow {this cell} { ;# last wish object is deleted after completion of this procedure
variable [set dataName $($this,dataName)]
variable ${this}cellRow
set row [set ${this}cellRow($cell)]
unset ${dataName}($row,0) ${dataName}($row,1) ${dataName}($row,2) ${dataName}($row,3) ${dataName}($row,4)\
${dataName}($row,sum) ($this,rowLastWish,$row)
unset ${this}cellRow($cell)
dataTable::update $($this,dataTable)
}
# data index is needed so that data array that other eventual data viewers depend on is reused when initializing from save file
proc initializationConfiguration {this} {
scan $($this,dataName) %u index ;# retrieve leading index from data name
set list [list -dataindex $index]
foreach {option value} [dataTable::initializationConfiguration $($this,dataTable)] { ;# in data table
if {[string equal $option -columnwidths]} { ;# look for column widths option
lappend list -columnwidths $value
break ;# done
}
}
return $list
}
}
|
