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

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

Fixed "copy/paste with desktop" to convert any \r's to \n's.
This was a problem when pasting from Windows or Mac environments,
when what looked like a clean text file would paste badly into
a text area.

Fixed the Rappture::exec to cleanly separate stdout/stderr
channels. We were getting an error in Spice when a stderr
statement appeared right in the middle of a stdout line of data.
The line was truncated, so the value at the end was interpreted
as a very different number, causing a spike on the graph.
(Example: Common Collector Amplifier, and ".print ac im(vs)")

Fixed Field objects to respect the length scale set by the
overall structure.

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