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

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

Major reorganization of the entire package. The config.xml file
is now irrelevant. All the action is in the tool.xml file. The
main program now organizes all input into 1) side-by-side pages,
2) input/result (wizard-style) pages, or 3) a series of wizard-
style pages. The <input> can have <phase> parts representing
the various pages.

Added a new ContourResult? widget based on Swaroop's vtk plotting
code.

Also, added easymesh and showmesh to the "tools" directory.
We need these for Eric Polizzi's code.

File size: 14.6 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 {label scale color units} {
260        set str [$_field get $key]
261        if {"" != $str} {
262            set hints($key) $str
263        }
264    }
265
266    if {$keyword != ""} {
267        if {[info exists hints($keyword)]} {
268            return $hints($keyword)
269        }
270        return ""
271    }
272    return [array get hints]
273}
274
275# ----------------------------------------------------------------------
276# USAGE: _build
277#
278# Used internally to build up the vector representation for the
279# field when the object is first constructed, or whenever the field
280# data changes.  Discards any existing vectors and builds everything
281# from scratch.
282# ----------------------------------------------------------------------
283itcl::body Rappture::Field::_build {} {
284    # discard any existing data
285    foreach name [array names _comp2xy] {
286        eval blt::vector destroy $_comp2xy($name)
287    }
288    foreach name [array names _comp2vtk] {
289        set cobj [lindex $_comp2vtk($name) 0]
290        Rappture::Cloud::release $cobj
291
292        set fobj [lindex $_comp2vtk($name) 1]
293        rename $fobj ""
294    }
295    catch {unset _comp2xy}
296    catch {unset _comp2vtk}
297    catch {unset _comp2dims}
298
299    #
300    # Scan through the components of the field and create
301    # vectors for each part.
302    #
303    foreach cname [$_field children -type component] {
304        set type ""
305        if {( [$_field element $cname.constant] != ""
306                && [$_field element $cname.domain] != "" )
307              || [$_field element $cname.xy] != ""} {
308            set type "1D"
309        } elseif {[$_field element $cname.mesh] != ""
310                    && [$_field element $cname.values] != ""} {
311            set type "points-on-mesh"
312        }
313
314        if {$type == "1D"} {
315            #
316            # 1D data can be represented as 2 BLT vectors,
317            # one for x and the other for y.
318            #
319            set xv ""
320            set yv ""
321
322            set val [$_field get $cname.constant]
323            if {$val != ""} {
324                set domain [$_field get $cname.domain]
325                if {$domain == "" || ![info exists _limits($domain)]} {
326                    set z0 0
327                    set z1 $_zmax
328                } else {
329                    foreach {z0 z1} $_limits($domain) { break }
330                }
331                set xv [blt::vector create x$_counter]
332                $xv append $z0 $z1
333
334                foreach {val pcomp} [_getValue $val] break
335                set yv [blt::vector create y$_counter]
336                $yv append $val $val
337
338                if {$pcomp != ""} {
339                    set zm [expr {0.5*($z0+$z1)}]
340                    set _comp2cntls($cname) \
341                        [list $pcomp $zm $val "$val$_units"]
342                }
343            } else {
344                set xydata [$_field get $cname.xy]
345                if {"" != $xydata} {
346                    set xv [blt::vector create x$_counter]
347                    set yv [blt::vector create y$_counter]
348
349                    foreach line [split $xydata \n] {
350                        if {[scan $line {%g %g} xval yval] == 2} {
351                            $xv append $xval
352                            $yv append $yval
353                        }
354                    }
355                }
356            }
357
358            if {$xv != "" && $yv != ""} {
359                set _comp2dims($cname) "1D"
360                set _comp2xy($cname) [list $xv $yv]
361                incr _counter
362            }
363        } elseif {$type == "points-on-mesh"} {
364            #
365            # More complex 2D/3D data is represented by a mesh
366            # object and an associated vtkFloatArray for field
367            # values.
368            #
369            set path [$_field get $cname.mesh]
370            if {[$_xmlobj element $path] != ""} {
371                set cobj [Rappture::Cloud::fetch $_xmlobj $path]
372                set values [$_field get $cname.values]
373                set farray [vtkFloatArray ::vals$_counter]
374
375                foreach v $values {
376                    if {"" != $_units} {
377                        set v [Rappture::Units::convert $v \
378                            -context $_units -to $_units -units off]
379                    }
380                    $farray InsertNextValue $v
381                }
382
383                set _comp2dims($cname) "[$cobj dimensions]D"
384                set _comp2vtk($cname) [list $cobj $farray]
385                incr _counter
386            } else {
387                puts "WARNING: can't find mesh $path for field component"
388            }
389        }
390    }
391}
392
393# ----------------------------------------------------------------------
394# USAGE: _getValue <expr>
395#
396# Used internally to get the value for an expression <expr>.  Returns
397# a list of the form {val parameterPath}, where val is the numeric
398# value of the expression, and parameterPath is the XML path to the
399# parameter representing the value, or "" if the <expr> does not
400# depend on any parameters.
401# ----------------------------------------------------------------------
402itcl::body Rappture::Field::_getValue {expr} {
403    #
404    # First, look for the expression among the <parameter>'s
405    # associated with the device.
406    #
407    set found 0
408    foreach pcomp [$_xmlobj children parameters] {
409        set id [$_xmlobj element -as id parameters.$pcomp]
410        if {[string equal $id $expr]} {
411            set val [$_xmlobj get parameters.$pcomp.current]
412            if {"" == $val} {
413                set val [$_xmlobj get parameters.$pcomp.default]
414            }
415            if {"" != $val} {
416                set expr $val
417                set found 1
418                break
419            }
420        }
421    }
422    if {$found} {
423        set pcomp "parameters.$pcomp"
424    } else {
425        set pcomp ""
426    }
427
428    if {$_units != ""} {
429        set expr [Rappture::Units::convert $expr \
430            -context $_units -to $_units -units off]
431    }
432
433    return [list $expr $pcomp]
434}
Note: See TracBrowser for help on using the repository browser.