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

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

Added support for contour plots of 3D data sets.

File size: 16.7 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 vmin vmax} {
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                set lims(ymin) 0
195                set lims(ymax) 0
196                set lims(zmin) 0
197                set lims(zmax) 0
198
199                $yv variable v
200                set lims(vmin) $v(min)
201                set lims(vmax) $v(max)
202            }
203            2D - 3D {
204                foreach {xv yv} $_comp2vtk($comp) break
205
206                foreach {lims(xmin) lims(xmax)} [$xv limits x] break
207                foreach {lims(ymin) lims(ymax)} [$xv limits y] break
208                foreach {lims(zmin) lims(zmax)} [$xv limits z] break
209                foreach {lims(vmin) lims(vmax)} [$yv GetRange] break
210            }
211        }
212        foreach val {xmin ymin zmin vmin} {
213            if {"" == $results($val) || $lims($val) < $results($val)} {
214                set results($val) $lims($val)
215            }
216        }
217        foreach val {xmax ymax zmax vmax} {
218            if {"" == $results($val) || $lims($val) > $results($val)} {
219                set results($val) $lims($val)
220            }
221        }
222    }
223    return [list $results(${axis}min) $results(${axis}max)]
224}
225
226# ----------------------------------------------------------------------
227# USAGE: controls get ?<name>?
228# USAGE: controls put <path> <value>
229#
230# Returns a list {path1 x1 y1 val1  path2 x2 y2 val2 ...} representing
231# control points for the specified field component <name>.
232# ----------------------------------------------------------------------
233itcl::body Rappture::Field::controls {option args} {
234    switch -- $option {
235        get {
236            set what [lindex $args 0]
237            if {[info exists _comp2cntls($what)]} {
238                return $_comp2cntls($what)
239            }
240            return ""
241        }
242        put {
243            set path [lindex $args 0]
244            set value [lindex $args 1]
245            $_xmlobj put $path.current $value
246            _build
247        }
248        default {
249            error "bad option \"$option\": should be get or put"
250        }
251    }
252}
253
254# ----------------------------------------------------------------------
255# USAGE: hints ?<keyword>?
256#
257# Returns a list of key/value pairs for various hints about plotting
258# this field.  If a particular <keyword> is specified, then it returns
259# the hint for that <keyword>, if it exists.
260# ----------------------------------------------------------------------
261itcl::body Rappture::Field::hints {{keyword ""}} {
262    foreach {key path} {
263        group   about.group
264        label   about.label
265        color   about.color
266        style   about.style
267        scale   about.scale
268        units   units
269    } {
270        set str [$_field get $path]
271        if {"" != $str} {
272            set hints($key) $str
273        }
274    }
275
276    # to be compatible with curve objects
277    set hints(xlabel) "Position"
278
279    if {[info exists hints(group)] && [info exists hints(label)]} {
280        # pop-up help for each curve
281        set hints(tooltip) $hints(label)
282    }
283
284    if {$keyword != ""} {
285        if {[info exists hints($keyword)]} {
286            return $hints($keyword)
287        }
288        return ""
289    }
290    return [array get hints]
291}
292
293# ----------------------------------------------------------------------
294# USAGE: _build
295#
296# Used internally to build up the vector representation for the
297# field when the object is first constructed, or whenever the field
298# data changes.  Discards any existing vectors and builds everything
299# from scratch.
300# ----------------------------------------------------------------------
301itcl::body Rappture::Field::_build {} {
302    # discard any existing data
303    foreach name [array names _comp2xy] {
304        eval blt::vector destroy $_comp2xy($name)
305    }
306    foreach name [array names _comp2vtk] {
307        set cobj [lindex $_comp2vtk($name) 0]
308        Rappture::Cloud::release $cobj
309
310        set fobj [lindex $_comp2vtk($name) 1]
311        rename $fobj ""
312    }
313    catch {unset _comp2xy}
314    catch {unset _comp2vtk}
315    catch {unset _comp2dims}
316
317    #
318    # Scan through the components of the field and create
319    # vectors for each part.
320    #
321    foreach cname [$_field children -type component] {
322        set type ""
323        if {( [$_field element $cname.constant] != ""
324                && [$_field element $cname.domain] != "" )
325              || [$_field element $cname.xy] != ""} {
326            set type "1D"
327        } elseif {[$_field element $cname.mesh] != ""
328                    && [$_field element $cname.values] != ""} {
329            set type "points-on-mesh"
330        }
331
332        if {$type == "1D"} {
333            #
334            # 1D data can be represented as 2 BLT vectors,
335            # one for x and the other for y.
336            #
337            set xv ""
338            set yv ""
339
340            set val [$_field get $cname.constant]
341            if {$val != ""} {
342                set domain [$_field get $cname.domain]
343                if {$domain == "" || ![info exists _limits($domain)]} {
344                    set z0 0
345                    set z1 $_zmax
346                } else {
347                    foreach {z0 z1} $_limits($domain) { break }
348                }
349                set xv [blt::vector create x$_counter]
350                $xv append $z0 $z1
351
352                foreach {val pcomp} [_getValue $val] break
353                set yv [blt::vector create y$_counter]
354                $yv append $val $val
355
356                if {$pcomp != ""} {
357                    set zm [expr {0.5*($z0+$z1)}]
358                    set _comp2cntls($cname) \
359                        [list $pcomp $zm $val "$val$_units"]
360                }
361            } else {
362                set xydata [$_field get $cname.xy]
363                if {"" != $xydata} {
364                    set xv [blt::vector create x$_counter]
365                    set yv [blt::vector create y$_counter]
366
367                    foreach line [split $xydata \n] {
368                        if {[scan $line {%g %g} xval yval] == 2} {
369                            $xv append $xval
370                            $yv append $yval
371                        }
372                    }
373                }
374            }
375
376            if {$xv != "" && $yv != ""} {
377                # sort x-coords in increasing order
378                $xv sort $yv
379
380                set _comp2dims($cname) "1D"
381                set _comp2xy($cname) [list $xv $yv]
382                incr _counter
383            }
384        } elseif {$type == "points-on-mesh"} {
385            #
386            # More complex 2D/3D data is represented by a mesh
387            # object and an associated vtkFloatArray for field
388            # values.
389            #
390            set path [$_field get $cname.mesh]
391            if {[$_xmlobj element $path] != ""} {
392                set cobj [Rappture::Cloud::fetch $_xmlobj $path]
393                if {[$cobj dimensions] > 1} {
394                    #
395                    # 2D/3D data
396                    # Store cloud/field as components
397                    #
398                    set values [$_field get $cname.values]
399                    set farray [vtkFloatArray ::vals$_counter]
400
401                    foreach v $values {
402                        if {"" != $_units} {
403                            set v [Rappture::Units::convert $v \
404                                -context $_units -to $_units -units off]
405                        }
406                        $farray InsertNextValue $v
407                    }
408
409                    set _comp2dims($cname) "[$cobj dimensions]D"
410                    set _comp2vtk($cname) [list $cobj $farray]
411                    incr _counter
412                } else {
413                    #
414                    # OOPS!  This is 1D data
415                    # Forget the cloud/field -- store BLT vectors
416                    #
417                    set xv [blt::vector create x$_counter]
418                    set yv [blt::vector create y$_counter]
419
420                    set vtkpts [$cobj points]
421                    set max [$vtkpts GetNumberOfPoints]
422                    for {set i 0} {$i < $max} {incr i} {
423                        set xval [lindex [$vtkpts GetPoint $i] 0]
424                        $xv append $xval
425                    }
426                    Rappture::Cloud::release $cobj
427
428                    set values [$_field get $cname.values]
429                    foreach yval $values {
430                        if {"" != $_units} {
431                            set yval [Rappture::Units::convert $yval \
432                                -context $_units -to $_units -units off]
433                        }
434                        $yv append $yval
435                    }
436
437                    # sort x-coords in increasing order
438                    $xv sort $yv
439
440                    set _comp2dims($cname) "1D"
441                    set _comp2xy($cname) [list $xv $yv]
442                    incr _counter
443                }
444            } else {
445                puts "WARNING: can't find mesh $path for field component"
446            }
447        }
448    }
449}
450
451# ----------------------------------------------------------------------
452# USAGE: _getValue <expr>
453#
454# Used internally to get the value for an expression <expr>.  Returns
455# a list of the form {val parameterPath}, where val is the numeric
456# value of the expression, and parameterPath is the XML path to the
457# parameter representing the value, or "" if the <expr> does not
458# depend on any parameters.
459# ----------------------------------------------------------------------
460itcl::body Rappture::Field::_getValue {expr} {
461    #
462    # First, look for the expression among the <parameter>'s
463    # associated with the device.
464    #
465    set found 0
466    foreach pcomp [$_xmlobj children parameters] {
467        set id [$_xmlobj element -as id parameters.$pcomp]
468        if {[string equal $id $expr]} {
469            set val [$_xmlobj get parameters.$pcomp.current]
470            if {"" == $val} {
471                set val [$_xmlobj get parameters.$pcomp.default]
472            }
473            if {"" != $val} {
474                set expr $val
475                set found 1
476                break
477            }
478        }
479    }
480    if {$found} {
481        set pcomp "parameters.$pcomp"
482    } else {
483        set pcomp ""
484    }
485
486    if {$_units != ""} {
487        set expr [Rappture::Units::convert $expr \
488            -context $_units -to $_units -units off]
489    }
490
491    return [list $expr $pcomp]
492}
Note: See TracBrowser for help on using the repository browser.