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