1 | # -*- mode: tcl; indent-tabs-mode: nil -*- |
---|
2 | # ---------------------------------------------------------------------- |
---|
3 | # COMPONENT: sequence - represents a sequence of output results |
---|
4 | # |
---|
5 | # This object represents a sequence of other output results. Each |
---|
6 | # element in the sequence has an index and a value. All values in |
---|
7 | # the sequence must have the same type, but they can all be curves, |
---|
8 | # images, or other results. |
---|
9 | # ====================================================================== |
---|
10 | # AUTHOR: Michael McLennan, Purdue University |
---|
11 | # Copyright (c) 2004-2012 HUBzero Foundation, LLC |
---|
12 | # |
---|
13 | # See the file "license.terms" for information on usage and |
---|
14 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
15 | # ====================================================================== |
---|
16 | package require Itcl |
---|
17 | package require BLT |
---|
18 | |
---|
19 | namespace eval Rappture { # forward declaration } |
---|
20 | |
---|
21 | itcl::class Rappture::Sequence { |
---|
22 | constructor {xmlobj path} { # defined below } |
---|
23 | destructor { # defined below } |
---|
24 | |
---|
25 | public method value {pos} |
---|
26 | public method label {pos} |
---|
27 | public method index {pos} |
---|
28 | public method size {} |
---|
29 | public method hints {{keyword ""}} |
---|
30 | |
---|
31 | private variable _xmlobj "" ;# ref to lib obj with sequence data |
---|
32 | private variable _dataobjs ;# maps index => data object |
---|
33 | private variable _labels ;# maps index => labels |
---|
34 | private variable _indices ;# list of sorted index values |
---|
35 | private variable _hints ;# cache of hints stored in XML |
---|
36 | } |
---|
37 | |
---|
38 | # ---------------------------------------------------------------------- |
---|
39 | # CONSTRUCTOR |
---|
40 | # ---------------------------------------------------------------------- |
---|
41 | itcl::body Rappture::Sequence::constructor {xmlobj path} { |
---|
42 | if {![Rappture::library isvalid $xmlobj]} { |
---|
43 | error "bad value \"$xmlobj\": should be LibraryObj" |
---|
44 | } |
---|
45 | set _xmlobj [$xmlobj element -as object $path] |
---|
46 | |
---|
47 | # |
---|
48 | # Extract data values from the element definitions. |
---|
49 | # |
---|
50 | foreach name [$_xmlobj children -type element] { |
---|
51 | set index [$xmlobj get $path.$name.index] |
---|
52 | if {"" == $index} { |
---|
53 | continue |
---|
54 | } |
---|
55 | |
---|
56 | # check for an element about.label stanza |
---|
57 | set elelabel [$xmlobj get $path.$name.about.label] |
---|
58 | |
---|
59 | set ctype "" |
---|
60 | set _dataobjs($index) "" |
---|
61 | set _labels($index) "" |
---|
62 | foreach cname [$_xmlobj children $name] { |
---|
63 | set type [$xmlobj element -as type $path.$name.$cname] |
---|
64 | switch -- $type { |
---|
65 | index { |
---|
66 | # ignore this |
---|
67 | continue |
---|
68 | } |
---|
69 | about { |
---|
70 | # ignore this |
---|
71 | continue |
---|
72 | } |
---|
73 | curve { |
---|
74 | set obj [Rappture::Curve ::\#auto $xmlobj $path.$name.$cname] |
---|
75 | } |
---|
76 | drawing { |
---|
77 | set obj [Rappture::Drawing ::\#auto $xmlobj $path.$name.$cname] |
---|
78 | } |
---|
79 | datatable { |
---|
80 | set obj [Rappture::DataTable ::\#auto $xmlobj $path.$name.$cname] |
---|
81 | } |
---|
82 | histogram { |
---|
83 | set obj [Rappture::Histogram ::\#auto $xmlobj $path.$name.$cname] |
---|
84 | } |
---|
85 | field { |
---|
86 | set obj [Rappture::Field ::\#auto $xmlobj $path.$name.$cname] |
---|
87 | } |
---|
88 | image { |
---|
89 | set obj [Rappture::Image ::\#auto $xmlobj $path.$name.$cname] |
---|
90 | } |
---|
91 | map { |
---|
92 | set obj [Rappture::Map ::\#auto $xmlobj $path.$name.$cname] |
---|
93 | } |
---|
94 | mesh { |
---|
95 | set obj [Rappture::Mesh ::\#auto $xmlobj $path.$name.$cname] |
---|
96 | } |
---|
97 | structure { |
---|
98 | # extract unique result set prefix |
---|
99 | scan $xmlobj "::libraryObj%d" rset |
---|
100 | |
---|
101 | # object rooted at x.sequence(y).element(z).structure |
---|
102 | set obj [$xmlobj element -as object $path.$name.$cname] |
---|
103 | |
---|
104 | # scene id (sequence id) |
---|
105 | set sceneid [$xmlobj element -as id $path]-$rset |
---|
106 | |
---|
107 | # sequence/element/frame number starting at 1 |
---|
108 | set frameid [expr [$xmlobj element -as id $path.$name] + 1] |
---|
109 | |
---|
110 | # only supporting one molecule per structure at the moment |
---|
111 | # otherwise should go through all children that are molecules |
---|
112 | # and insert scene/frame data. |
---|
113 | $obj put "components.molecule.state" $frameid |
---|
114 | $obj put "components.molecule.model" $sceneid |
---|
115 | } |
---|
116 | default { |
---|
117 | error "don't know how to handle sequences of $type" |
---|
118 | } |
---|
119 | } |
---|
120 | if {"" == $ctype} { |
---|
121 | set ctype $type |
---|
122 | } |
---|
123 | if {$type == $ctype} { |
---|
124 | lappend _dataobjs($index) $obj |
---|
125 | set _labels($index) $elelabel |
---|
126 | } else { |
---|
127 | itcl::delete object $obj |
---|
128 | } |
---|
129 | } |
---|
130 | } |
---|
131 | # |
---|
132 | # Generate a list of sorted index values. |
---|
133 | # |
---|
134 | set units [$xmlobj get $path.index.units] |
---|
135 | if {"" != $units} { |
---|
136 | # build up a list: {10m 10} {10cm 0.1} ... |
---|
137 | set vals "" |
---|
138 | foreach key [array names _dataobjs] { |
---|
139 | lappend vals [list $key [Rappture::Units::convert $key \ |
---|
140 | -context $units -to $units -units off]] |
---|
141 | } |
---|
142 | |
---|
143 | # sort according to raw values; store both values |
---|
144 | set _indices [lsort -real -index 1 $vals] |
---|
145 | } else { |
---|
146 | # are the indices integers, reals, or strings? |
---|
147 | set how -integer |
---|
148 | foreach key [array names _dataobjs] { |
---|
149 | if {[regexp {^[0-9]+[eE][-+]?[0-9]+|([0-9]+)?\.[0-9]+([eE][-+]?[0-9]+)?$} $key]} { |
---|
150 | set how -real |
---|
151 | break |
---|
152 | } elseif {![regexp {^[0-9]+$} $key]} { |
---|
153 | set how -dictionary |
---|
154 | break |
---|
155 | } |
---|
156 | } |
---|
157 | |
---|
158 | # keep a list of indices sorted in order |
---|
159 | set _indices "" |
---|
160 | if {[string equal $how -dictionary]} { |
---|
161 | set n 0 |
---|
162 | foreach val [lsort $how [array names _dataobjs]] { |
---|
163 | lappend _indices [list $val $n] |
---|
164 | incr n |
---|
165 | } |
---|
166 | } else { |
---|
167 | foreach val [lsort $how [array names _dataobjs]] { |
---|
168 | lappend _indices [list $val $val] |
---|
169 | } |
---|
170 | } |
---|
171 | } |
---|
172 | } |
---|
173 | |
---|
174 | # ---------------------------------------------------------------------- |
---|
175 | # DESTRUCTOR |
---|
176 | # ---------------------------------------------------------------------- |
---|
177 | itcl::body Rappture::Sequence::destructor {} { |
---|
178 | foreach key [array names _dataobjs] { |
---|
179 | eval itcl::delete object $_dataobjs($key) |
---|
180 | } |
---|
181 | itcl::delete object $_xmlobj |
---|
182 | } |
---|
183 | |
---|
184 | # ---------------------------------------------------------------------- |
---|
185 | # USAGE: value <pos> |
---|
186 | # |
---|
187 | # Returns the value for the element as position <pos> in the |
---|
188 | # list of all elements. Here, <pos> runs from 0 to size-1. |
---|
189 | # ---------------------------------------------------------------------- |
---|
190 | itcl::body Rappture::Sequence::value {pos} { |
---|
191 | set i [lindex [lindex $_indices $pos] 0] |
---|
192 | |
---|
193 | # FIXME: This is a bandaid on what appears to be a timing problem. |
---|
194 | # This "dataobjs" method is now called before any sequence frames |
---|
195 | # have been added. |
---|
196 | if { ![info exists _dataobjs($i)] } { |
---|
197 | return "" |
---|
198 | } |
---|
199 | |
---|
200 | return $_dataobjs($i) |
---|
201 | } |
---|
202 | |
---|
203 | # ---------------------------------------------------------------------- |
---|
204 | # USAGE: label <pos> |
---|
205 | # |
---|
206 | # Returns the label for the element as position <pos> in the |
---|
207 | # list of all elements. Here, <pos> runs from 0 to size-1. |
---|
208 | # ---------------------------------------------------------------------- |
---|
209 | itcl::body Rappture::Sequence::label {pos} { |
---|
210 | set i [lindex [lindex $_indices $pos] 0] |
---|
211 | |
---|
212 | # FIXME: This is a bandaid on what appears to be a timing problem. |
---|
213 | # This "label" method is now called before any sequence frames |
---|
214 | # have been added. |
---|
215 | if { ![info exists _labels($i)] } { |
---|
216 | return "" |
---|
217 | } |
---|
218 | |
---|
219 | return $_labels($i) |
---|
220 | } |
---|
221 | |
---|
222 | # ---------------------------------------------------------------------- |
---|
223 | # USAGE: index <pos> |
---|
224 | # |
---|
225 | # Returns information about the index value for the element at |
---|
226 | # position <pos> in the list of all elements. The return value is |
---|
227 | # a list of two elements: {string rawNumberValue}. Here, <pos> |
---|
228 | # runs from 0 to size-1. |
---|
229 | # ---------------------------------------------------------------------- |
---|
230 | itcl::body Rappture::Sequence::index {pos} { |
---|
231 | return [lindex $_indices $pos] |
---|
232 | } |
---|
233 | |
---|
234 | # ---------------------------------------------------------------------- |
---|
235 | # USAGE: size |
---|
236 | # |
---|
237 | # Returns the number of elements in this sequence. |
---|
238 | # ---------------------------------------------------------------------- |
---|
239 | itcl::body Rappture::Sequence::size {} { |
---|
240 | return [llength $_indices] |
---|
241 | } |
---|
242 | |
---|
243 | # ---------------------------------------------------------------------- |
---|
244 | # USAGE: hints ?<keyword>? |
---|
245 | # |
---|
246 | # Returns a list of key/value pairs for various hints about showing |
---|
247 | # this image. If a particular <keyword> is specified, then it returns |
---|
248 | # the hint for that <keyword>, if it exists. |
---|
249 | # ---------------------------------------------------------------------- |
---|
250 | itcl::body Rappture::Sequence::hints {{keyword ""}} { |
---|
251 | if {![info exists _hints]} { |
---|
252 | foreach {key path} { |
---|
253 | label about.label |
---|
254 | indexlabel index.label |
---|
255 | indexdesc index.description |
---|
256 | } { |
---|
257 | set str [$_xmlobj get $path] |
---|
258 | if {"" != $str} { |
---|
259 | set _hints($key) $str |
---|
260 | } |
---|
261 | } |
---|
262 | } |
---|
263 | |
---|
264 | if {$keyword != ""} { |
---|
265 | if {[info exists _hints($keyword)]} { |
---|
266 | return $_hints($keyword) |
---|
267 | } |
---|
268 | return "" |
---|
269 | } |
---|
270 | return [array get _hints] |
---|
271 | } |
---|