source: trunk/gui/scripts/sequence.tcl @ 822

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