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
|
# 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: sumtable.tcl,v 1.9 1998/10/11 09:27:20 jfontain Exp $}
class summaryTable {
proc summaryTable {this parentPath args} composite {[new frame $parentPath] $args} viewer {} {
variable ${this}data
array set ${this}data {
updates 0
0,label data 0,type ascii 0,message {data cell description}
1,label current 1,type real 1,message {current value}
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 summaryTable::($this,nextRow) 0
composite::complete $this
# wait till after completion before creating table since some options are not dynamically settable
set table [new dataTable $widget::($this,path)\
-data summaryTable::${this}data -draggable $composite::($this,-draggable) -titlefont $composite::($this,-titlefont)\
]
### 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 ###
set summaryTable::($this,drop) [new dropSite\
-path $dataTable::($table,tablePath) -formats DATACELLS -command "viewer::view $this \$dragSite::data(DATACELLS)"\
]
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 summaryTable::($this,dataTable) $table
}
proc ~summaryTable {this} {
variable ${this}data
variable ${this}cellRow
delete $summaryTable::($this,dataTable) $summaryTable::($this,drop)
unset ${this}data
catch {unset ${this}cellRow}
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} {
return [list\
[list -deletecommand {} {}]\
[list -draggable draggable Draggable 0 0]\
[list -titlefont titleFont TitleFont $font::(mediumBold) $font::(mediumBold)]\
]
}
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 ${this}data
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 $summaryTable::($this,nextRow) ;# next row for this data table
set ${this}data($row,0) $label
array set ${this}data "$row,2 {} $row,3 {} $row,4 {}" ;# initialize average, minimum and maximum to empty values
set ${this}data($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 summaryTable::($this,rowLastWish,$row) [new lastWish "summaryTable::deleteRow $this $cell"]
incr summaryTable::($this,nextRow)
}
proc update {this array args} {
variable ${this}data
variable ${this}cellRow
foreach cell [array names ${this}cellRow] {
set row [set ${this}cellRow($cell)]
if {[catch {set $cell} current]} { ;# cell does not exist
set ${this}data($row,1) ? ;# do not touch other columns as their content stays valid
} else {
set ${this}data($row,1) $current
set ${this}data($row,2) [format %.2f\
[expr\
{[set ${this}data($row,sum) [expr {[set ${this}data($row,sum)]+$current}]]/([set ${this}data(updates)]+1)}\
]\
]
set value [set ${this}data($row,3)]
if {([string length $value]==0)||($current<$value)} {
set ${this}data($row,3) $current
}
set value [set ${this}data($row,4)]
if {([string length $value]==0)||($current>$value)} {
set ${this}data($row,4) $current
}
}
}
incr ${this}data(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 $summaryTable::($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 $summaryTable::($this,rowLastWish,$row)
}
if {([llength $lastWishes]==[array size ${this}cellRow])||([llength $lastWishes]==0)} {
return $this ;# self destruct if all rows are selected or no rows remain
} else {
return $lastWishes
}
}
proc deleteRow {this cell} {
variable ${this}data
variable ${this}cellRow
set row [set ${this}cellRow($cell)]
unset ${this}data($row,0) ${this}data($row,1) ${this}data($row,2) ${this}data($row,3) ${this}data($row,4)\
${this}data($row,sum) summaryTable::($this,rowLastWish,$row)
unset ${this}cellRow($cell)
dataTable::update $summaryTable::($this,dataTable)
}
}
|
