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

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