source: trunk/gui/scripts/field.tcl @ 13

Last change on this file since 13 was 13, checked in by mmc, 16 years ago

Many improvements, including a new energy level viewer
for Huckel-IV. Added support for a new <boolean> type.
Fixed the cloud/field stuff so that when a cloud is 1D,
it reverts to BLT vectors so it will plot correctly.
Fixed the install script to work better on Windows.

File size: 16.5 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: field - extracts data from an XML description of a field
3#
4#  This object represents one field in an XML description of a device.
5#  It simplifies the process of extracting data vectors that represent
6#  the field.
7# ======================================================================
8#  AUTHOR:  Michael McLennan, Purdue University
9#  Copyright (c) 2004-2005
10#  Purdue Research Foundation, West Lafayette, IN
11# ======================================================================
12package require Itcl
13package require BLT
14
15namespace eval Rappture { # forward declaration }
16
17itcl::class Rappture::Field {
18    constructor {xmlobj path} { # defined below }
19    destructor { # defined below }
20
21    public method components {args}
22    public method mesh {{what -overall}}
23    public method values {{what -overall}}
24    public method limits {axis}
25    public method controls {option args}
26    public method hints {{key ""}}
27
28    protected method _build {}
29    protected method _getValue {expr}
30
31    private variable _xmlobj ""  ;# ref to XML obj with device data
32
33    private variable _units ""   ;# system of units for this field
34    private variable _limits     ;# maps box name => {z0 z1} limits
35    private variable _zmax 0     ;# length of the device
36
37    private variable _field ""   ;# lib obj representing this field
38    private variable _comp2dims  ;# maps component name => dimensionality
39    private variable _comp2xy    ;# maps component name => x,y vectors
40    private variable _comp2vtk   ;# maps component name => vtkFloatArray
41    private variable _comp2cntls ;# maps component name => x,y control points
42
43    private common _counter 0    ;# counter for unique vector names
44}
45
46# ----------------------------------------------------------------------
47# CONSTRUCTOR
48# ----------------------------------------------------------------------
49itcl::body Rappture::Field::constructor {xmlobj path} {
50    if {![Rappture::library isvalid $xmlobj]} {
51        error "bad value \"$xmlobj\": should be Rappture::library"
52    }
53    set _xmlobj $xmlobj
54    set _field [$xmlobj element -as object $path]
55    set _units [$_field get units]
56
57    # determine the overall size of the device
58    set z0 [set z1 0]
59    foreach elem [$_xmlobj children components] {
60        switch -glob -- $elem {
61            box* {
62                if {![regexp {[0-9]$} $elem]} {
63                    set elem "${elem}0"
64                }
65                set z0 [$_xmlobj get components.$elem.corner0]
66                set z0 [Rappture::Units::convert $z0 \
67                    -context um -to um -units off]
68
69                set z1 [$_xmlobj get components.$elem.corner1]
70                set z1 [Rappture::Units::convert $z1 \
71                    -context um -to um -units off]
72
73                set _limits($elem) [list $z0 $z1]
74            }
75        }
76    }
77    set _zmax $z1
78
79    # build up vectors for various components of the field
80    _build
81}
82
83# ----------------------------------------------------------------------
84# DESTRUCTOR
85# ----------------------------------------------------------------------
86itcl::body Rappture::Field::destructor {} {
87    itcl::delete object $_field
88    # don't destroy the _xmlobj! we don't own it!
89
90    foreach name [array names _comp2xy] {
91        eval blt::vector destroy $_comp2xy($name)
92    }
93    foreach name [array names _comp2vtk] {
94        set cobj [lindex $_comp2vtk($name) 0]
95        Rappture::Cloud::release $cobj
96
97        set fobj [lindex $_comp2vtk($name) 1]
98        rename $fobj ""
99    }
100}
101
102# ----------------------------------------------------------------------
103# USAGE: components ?-name|-dimensions? ?<pattern>?
104#
105# Returns a list of names or types for the various components of
106# this field.  If the optional glob-style <pattern> is specified,
107# then it returns only the components with names matching the pattern.
108# ----------------------------------------------------------------------
109itcl::body Rappture::Field::components {args} {
110    Rappture::getopts args params {
111        flag what -name default
112        flag what -dimensions
113    }
114
115    set pattern *
116    if {[llength $args] > 0} {
117        set pattern [lindex $args 0]
118        set args [lrange $args 1 end]
119    }
120    if {[llength $args] > 0} {
121        error "wrong # args: should be \"components ?switches? ?pattern?\""
122    }
123
124    set rlist ""
125    foreach name [array names _comp2dims $pattern] {
126        switch -- $params(what) {
127            -name { lappend rlist $name }
128            -dimensions { lappend rlist $_comp2dims($name) }
129        }
130    }
131    return $rlist
132}
133
134# ----------------------------------------------------------------------
135# USAGE: mesh ?<name>?
136#
137# Returns a list {xvec yvec} for the specified field component <name>.
138# If the name is not specified, then it returns the vectors for the
139# overall field (sum of all components).
140# ----------------------------------------------------------------------
141itcl::body Rappture::Field::mesh {{what -overall}} {
142    if {$what == "component0"} {
143        set what "component"
144    }
145    if {[info exists _comp2xy($what)]} {
146        return [lindex $_comp2xy($what) 0]  ;# return xv
147    }
148    if {[info exists _comp2vtk($what)]} {
149        set cobj [lindex $_comp2vtk($what) 0]
150        return [$cobj points]
151    }
152    error "bad option \"$what\": should be [join [lsort [array names _comp2dims]] {, }]"
153}
154
155# ----------------------------------------------------------------------
156# USAGE: values ?<name>?
157#
158# Returns a list {xvec yvec} for the specified field component <name>.
159# If the name is not specified, then it returns the vectors for the
160# overall field (sum of all components).
161# ----------------------------------------------------------------------
162itcl::body Rappture::Field::values {{what -overall}} {
163    if {$what == "component0"} {
164        set what "component"
165    }
166    if {[info exists _comp2xy($what)]} {
167        return [lindex $_comp2xy($what) 1]  ;# return yv
168    }
169    if {[info exists _comp2vtk($what)]} {
170        return [lindex $_comp2vtk($what) 1]  ;# return vtkFloatArray
171    }
172    error "bad option \"$what\": should be [join [lsort [array names _comp2dims]] {, }]"
173}
174
175# ----------------------------------------------------------------------
176# USAGE: limits <axis>
177#
178# Returns a list {min max} representing the limits for the specified
179# axis.
180# ----------------------------------------------------------------------
181itcl::body Rappture::Field::limits {axis} {
182    foreach val {xmin xmax ymin ymax zmin zmax} {
183        set results($val) ""
184    }
185    foreach comp [array names _comp2dims] {
186        switch -- $_comp2dims($comp) {
187            1D {
188                foreach {xv yv} $_comp2xy($comp) break
189
190                $xv variable x
191                set lims(xmin) $x(min)
192                set lims(xmax) $x(max)
193
194                $yv variable y
195                set lims(ymin) $y(min)
196                set lims(ymax) $y(max)
197
198                set lims(zmin) 0
199                set lims(zmax) 0
200            }
201            2D - 3D {
202                foreach {xv yv} $_comp2vtk($comp) break
203
204                foreach {lims(xmin) lims(xmax)} [$xv limits x] break
205                foreach {lims(ymin) lims(ymax)} [$xv limits y] break
206                foreach {lims(zmin) lims(zmax)} [$yv GetRange] break
207            }
208        }
209        foreach val {xmin ymin zmin} {
210            if {"" == $results($val) || $lims($val) < $results($val)} {
211                set results($val) $lims($val)
212            }
213        }
214        foreach val {xmax ymax zmax} {
215            if {"" == $results($val) || $lims($val) > $results($val)} {
216                set results($val) $lims($val)
217            }
218        }
219    }
220    return [list $results(${axis}min) $results(${axis}max)]
221}
222
223# ----------------------------------------------------------------------
224# USAGE: controls get ?<name>?
225# USAGE: controls put <path> <value>
226#
227# Returns a list {path1 x1 y1 val1  path2 x2 y2 val2 ...} representing
228# control points for the specified field component <name>.
229# ----------------------------------------------------------------------
230itcl::body Rappture::Field::controls {option args} {
231    switch -- $option {
232        get {
233            set what [lindex $args 0]
234            if {[info exists _comp2cntls($what)]} {
235                return $_comp2cntls($what)
236            }
237            return ""
238        }
239        put {
240            set path [lindex $args 0]
241            set value [lindex $args 1]
242            $_xmlobj put $path.current $value
243            _build
244        }
245        default {
246            error "bad option \"$option\": should be get or put"
247        }
248    }
249}
250
251# ----------------------------------------------------------------------
252# USAGE: hints ?<keyword>?
253#
254# Returns a list of key/value pairs for various hints about plotting
255# this field.  If a particular <keyword> is specified, then it returns
256# the hint for that <keyword>, if it exists.
257# ----------------------------------------------------------------------
258itcl::body Rappture::Field::hints {{keyword ""}} {
259    foreach {key path} {
260        group   about.group
261        label   about.label
262        color   about.color
263        style   about.style
264        scale   about.scale
265        units   units
266    } {
267        set str [$_field get $path]
268        if {"" != $str} {
269            set hints($key) $str
270        }
271    }
272
273    if {[info exists hints(group)] && [info exists hints(label)]} {
274        # pop-up help for each curve
275        set hints(tooltip) $hints(label)
276    }
277
278    if {$keyword != ""} {
279        if {[info exists hints($keyword)]} {
280            return $hints($keyword)
281        }
282        return ""
283    }
284    return [array get hints]
285}
286
287# ----------------------------------------------------------------------
288# USAGE: _build
289#
290# Used internally to build up the vector representation for the
291# field when the object is first constructed, or whenever the field
292# data changes.  Discards any existing vectors and builds everything
293# from scratch.
294# ----------------------------------------------------------------------
295itcl::body Rappture::Field::_build {} {
296    # discard any existing data
297    foreach name [array names _comp2xy] {
298        eval blt::vector destroy $_comp2xy($name)
299    }
300    foreach name [array names _comp2vtk] {
301        set cobj [lindex $_comp2vtk($name) 0]
302        Rappture::Cloud::release $cobj
303
304        set fobj [lindex $_comp2vtk($name) 1]
305        rename $fobj ""
306    }
307    catch {unset _comp2xy}
308    catch {unset _comp2vtk}
309    catch {unset _comp2dims}
310
311    #
312    # Scan through the components of the field and create
313    # vectors for each part.
314    #
315    foreach cname [$_field children -type component] {
316        set type ""
317        if {( [$_field element $cname.constant] != ""
318                && [$_field element $cname.domain] != "" )
319              || [$_field element $cname.xy] != ""} {
320            set type "1D"
321        } elseif {[$_field element $cname.mesh] != ""
322                    && [$_field element $cname.values] != ""} {
323            set type "points-on-mesh"
324        }
325
326        if {$type == "1D"} {
327            #
328            # 1D data can be represented as 2 BLT vectors,
329            # one for x and the other for y.
330            #
331            set xv ""
332            set yv ""
333
334            set val [$_field get $cname.constant]
335            if {$val != ""} {
336                set domain [$_field get $cname.domain]
337                if {$domain == "" || ![info exists _limits($domain)]} {
338                    set z0 0
339                    set z1 $_zmax
340                } else {
341                    foreach {z0 z1} $_limits($domain) { break }
342                }
343                set xv [blt::vector create x$_counter]
344                $xv append $z0 $z1
345
346                foreach {val pcomp} [_getValue $val] break
347                set yv [blt::vector create y$_counter]
348                $yv append $val $val
349
350                if {$pcomp != ""} {
351                    set zm [expr {0.5*($z0+$z1)}]
352                    set _comp2cntls($cname) \
353                        [list $pcomp $zm $val "$val$_units"]
354                }
355            } else {
356                set xydata [$_field get $cname.xy]
357                if {"" != $xydata} {
358                    set xv [blt::vector create x$_counter]
359                    set yv [blt::vector create y$_counter]
360
361                    foreach line [split $xydata \n] {
362                        if {[scan $line {%g %g} xval yval] == 2} {
363                            $xv append $xval
364                            $yv append $yval
365                        }
366                    }
367                }
368            }
369
370            if {$xv != "" && $yv != ""} {
371                # sort x-coords in increasing order
372                $xv sort $yv
373
374                set _comp2dims($cname) "1D"
375                set _comp2xy($cname) [list $xv $yv]
376                incr _counter
377            }
378        } elseif {$type == "points-on-mesh"} {
379            #
380            # More complex 2D/3D data is represented by a mesh
381            # object and an associated vtkFloatArray for field
382            # values.
383            #
384            set path [$_field get $cname.mesh]
385            if {[$_xmlobj element $path] != ""} {
386                set cobj [Rappture::Cloud::fetch $_xmlobj $path]
387                if {[$cobj dimensions] > 1} {
388                    #
389                    # 2D/3D data
390                    # Store cloud/field as components
391                    #
392                    set values [$_field get $cname.values]
393                    set farray [vtkFloatArray ::vals$_counter]
394
395                    foreach v $values {
396                        if {"" != $_units} {
397                            set v [Rappture::Units::convert $v \
398                                -context $_units -to $_units -units off]
399                        }
400                        $farray InsertNextValue $v
401                    }
402
403                    set _comp2dims($cname) "[$cobj dimensions]D"
404                    set _comp2vtk($cname) [list $cobj $farray]
405                    incr _counter
406                } else {
407                    #
408                    # OOPS!  This is 1D data
409                    # Forget the cloud/field -- store BLT vectors
410                    #
411                    set xv [blt::vector create x$_counter]
412                    set yv [blt::vector create y$_counter]
413
414                    set vtkpts [$cobj points]
415                    set max [$vtkpts GetNumberOfPoints]
416                    for {set i 0} {$i < $max} {incr i} {
417                        set xval [lindex [$vtkpts GetPoint $i] 0]
418                        $xv append $xval
419                    }
420                    Rappture::Cloud::release $cobj
421
422                    set values [$_field get $cname.values]
423                    foreach yval $values {
424                        if {"" != $_units} {
425                            set yval [Rappture::Units::convert $yval \
426                                -context $_units -to $_units -units off]
427                        }
428                        $yv append $yval
429                    }
430
431                    # sort x-coords in increasing order
432                    $xv sort $yv
433
434                    set _comp2dims($cname) "1D"
435                    set _comp2xy($cname) [list $xv $yv]
436                    incr _counter
437                }
438            } else {
439                puts "WARNING: can't find mesh $path for field component"
440            }
441        }
442    }
443}
444
445# ----------------------------------------------------------------------
446# USAGE: _getValue <expr>
447#
448# Used internally to get the value for an expression <expr>.  Returns
449# a list of the form {val parameterPath}, where val is the numeric
450# value of the expression, and parameterPath is the XML path to the
451# parameter representing the value, or "" if the <expr> does not
452# depend on any parameters.
453# ----------------------------------------------------------------------
454itcl::body Rappture::Field::_getValue {expr} {
455    #
456    # First, look for the expression among the <parameter>'s
457    # associated with the device.
458    #
459    set found 0
460    foreach pcomp [$_xmlobj children parameters] {
461        set id [$_xmlobj element -as id parameters.$pcomp]
462        if {[string equal $id $expr]} {
463            set val [$_xmlobj get parameters.$pcomp.current]
464            if {"" == $val} {
465                set val [$_xmlobj get parameters.$pcomp.default]
466            }
467            if {"" != $val} {
468                set expr $val
469                set found 1
470                break
471            }
472        }
473    }
474    if {$found} {
475        set pcomp "parameters.$pcomp"
476    } else {
477        set pcomp ""
478    }
479
480    if {$_units != ""} {
481        set expr [Rappture::Units::convert $expr \
482            -context $_units -to $_units -units off]
483    }
484
485    return [list $expr $pcomp]
486}
Note: See TracBrowser for help on using the repository browser.