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

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

Updated all copyright notices.

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