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

Last change on this file since 644 was 644, checked in by nkissebe, 14 years ago

sequence.tcl,sequenceresult.tcl: add support for molecule structure sequences

File size: 7.5 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                field {
66                    set obj [Rappture::Field ::#auto $xmlobj $path.$name.$cname]
67                }
68                image {
69                    set obj [Rappture::Image ::#auto $xmlobj $path.$name.$cname]
70                }
71                structure {
72                    # extract unique result set prefix
73                    scan $xmlobj "::libraryObj%d" rset
74
75                    # object rooted at x.sequence(y).element(z).structure
76                    set obj [$xmlobj element -as object $path.$name.$cname]
77
78                    # scene id (sequence id)
79                    set sceneid [$xmlobj element -as id $path]-$rset
80
81                    # sequence/element/frame number starting at 1
82                    set frameid [expr [$xmlobj element -as id $path.$name] + 1]
83
84                    # only supporting one molecule per structure at the moment
85                    # otherwise should go through all children that are molecules
86                    # and insert scene/frame data.
87                    $obj put "components.molecule.state" $frameid
88                    $obj put "components.molecule.model" $sceneid
89                }
90                default {
91                    error "don't know how to handle sequences of $type"
92                }
93            }
94            if {"" == $ctype} {
95                set ctype $type
96            }
97            if {$type == $ctype} {
98                lappend _dataobjs($index) $obj
99            } else {
100                itcl::delete object $obj
101            }
102        }
103    }
104
105    #
106    # Generate a list of sorted index values.
107    #
108    set units [$xmlobj get $path.index.units]
109    if {"" != $units} {
110        # build up a list:  {10m 10} {10cm 0.1} ...
111        set vals ""
112        foreach key [array names _dataobjs] {
113            lappend vals [list $key [Rappture::Units::convert $key \
114                -context $units -to $units -units off]]
115        }
116
117        # sort according to raw values; store both values
118        set _indices [lsort -real -index 1 $vals]
119
120    } else {
121        # are the indices integers, reals, or strings?
122        set how -integer
123        foreach key [array names _dataobjs] {
124            if {[regexp {^[0-9]+[eE][-+]?[0-9]+|([0-9]+)?\.[0-9]+([eE][-+]?[0-9]+)?$} $key]} {
125                set how -real
126                break
127            } elseif {![regexp {^[0-9]+$} $key]} {
128                set how -dictionary
129                break
130            }
131        }
132
133        # keep a list of indices sorted in order
134        set _indices ""
135        if {[string equal $how -dictionary]} {
136            set n 0
137            foreach val [lsort $how [array names _dataobjs]] {
138                lappend _indices [list $val $n]
139                incr n
140            }
141        } else {
142            foreach val [lsort $how [array names _dataobjs]] {
143                lappend _indices [list $val $val]
144            }
145        }
146    }
147}
148
149# ----------------------------------------------------------------------
150# DESTRUCTOR
151# ----------------------------------------------------------------------
152itcl::body Rappture::Sequence::destructor {} {
153    foreach key [array names _dataobjs] {
154        eval itcl::delete object $_dataobjs($key)
155    }
156    itcl::delete object $_xmlobj
157}
158
159# ----------------------------------------------------------------------
160# USAGE: value <pos>
161#
162# Returns the value for the element as position <pos> in the
163# list of all elements.  Here, <pos> runs from 0 to size-1.
164# ----------------------------------------------------------------------
165itcl::body Rappture::Sequence::value {pos} {
166    set i [lindex [lindex $_indices $pos] 0]
167    return $_dataobjs($i)
168}
169
170# ----------------------------------------------------------------------
171# USAGE: index <pos>
172#
173# Returns information about the index value for the element at
174# position <pos> in the list of all elements.  The return value is
175# a list of two elements:  {string rawNumberValue}.  Here, <pos>
176# runs from 0 to size-1.
177# ----------------------------------------------------------------------
178itcl::body Rappture::Sequence::index {pos} {
179    return [lindex $_indices $pos]
180}
181
182# ----------------------------------------------------------------------
183# USAGE: size
184#
185# Returns the number of elements in this sequence.
186# ----------------------------------------------------------------------
187itcl::body Rappture::Sequence::size {} {
188    return [llength $_indices]
189}
190
191# ----------------------------------------------------------------------
192# USAGE: hints ?<keyword>?
193#
194# Returns a list of key/value pairs for various hints about showing
195# this image.  If a particular <keyword> is specified, then it returns
196# the hint for that <keyword>, if it exists.
197# ----------------------------------------------------------------------
198itcl::body Rappture::Sequence::hints {{keyword ""}} {
199    if {![info exists _hints]} {
200        foreach {key path} {
201            label        about.label
202            indexlabel   index.label
203            indexdesc    index.description
204        } {
205            set str [$_xmlobj get $path]
206            if {"" != $str} {
207                set _hints($key) $str
208            }
209        }
210    }
211
212    if {$keyword != ""} {
213        if {[info exists _hints($keyword)]} {
214            return $_hints($keyword)
215        }
216        return ""
217    }
218    return [array get _hints]
219}
Note: See TracBrowser for help on using the repository browser.