source: trunk/gui/scripts/curve.tcl @ 6480

Last change on this file since 6480 was 5659, checked in by ldelgass, 9 years ago

whitespace

File size: 12.9 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: curve - extracts data from an XML description of a field
4#
5#  This object represents a curve of data in an XML description of
6#  simulator output.  A curve is similar to a field, but a field is
7#  a quantity versus position in device.  A curve is any quantity
8#  versus any other quantity.  This class simplifies the process of
9#  extracting data vectors that represent the curve.
10# ======================================================================
11#  AUTHOR:  Michael McLennan, Purdue University
12#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
13#
14#  See the file "license.terms" for information on usage and
15#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
16# ======================================================================
17package require Itcl
18package require BLT
19
20namespace eval Rappture {
21    # forward declaration
22}
23
24itcl::class Rappture::Curve {
25    constructor {xmlobj path} {
26        # defined below
27    }
28    destructor {
29        # defined below
30    }
31
32    public method components {{pattern *}}
33    public method mesh {cname }
34    public method values { cname }
35    public method limits {which}
36    public method hints {{key ""}}
37    public method xmarkers {}
38    public method ymarkers {}
39    public method xErrorValues { cname }
40    public method yErrorValues { cname }
41
42    protected method _build {}
43
44    private variable _xmlobj ""  ;      # ref to lib obj with curve data
45    private variable _curve ""   ;      # lib obj representing this curve
46    private variable _comp2xy    ;      # maps component name => x,y vectors
47    private variable _hints      ;      # cache of hints stored in XML
48
49    private variable _xmarkers "";      # list of {x,label,options} triplets.
50    private variable _ymarkers "";      # list of {y,label,options} triplets.
51    private common _counter 0    ;      # counter for unique vector names
52}
53
54# ----------------------------------------------------------------------
55# CONSTRUCTOR
56# ----------------------------------------------------------------------
57itcl::body Rappture::Curve::constructor {xmlobj path} {
58    if {![Rappture::library isvalid $xmlobj]} {
59        error "bad value \"$xmlobj\": should be LibraryObj"
60    }
61    set _xmlobj $xmlobj
62    set _curve [$xmlobj element -as object $path]
63    # build up vectors for various components of the curve
64    _build
65}
66
67# ----------------------------------------------------------------------
68# DESTRUCTOR
69# ----------------------------------------------------------------------
70itcl::body Rappture::Curve::destructor {} {
71    itcl::delete object $_curve
72    # don't destroy the _xmlobj! we don't own it!
73
74    foreach name [array names _comp2xy] {
75        eval blt::vector destroy $_comp2xy($name)
76    }
77}
78
79# ----------------------------------------------------------------------
80# USAGE: components ?<pattern>?
81#
82# Returns a list of names for the various components of this curve.
83# If the optional glob-style <pattern> is specified, then it returns
84# only the component names matching the pattern.
85# ----------------------------------------------------------------------
86itcl::body Rappture::Curve::components {{pattern *}} {
87    set rlist ""
88    foreach name [array names _comp2xy] {
89        if {[string match $pattern $name]} {
90            lappend rlist $name
91        }
92    }
93    return $rlist
94}
95
96# ----------------------------------------------------------------------
97# USAGE: mesh ?<name>?
98#
99# Returns the xvec for the specified curve component <name>.
100# If the name is not specified, then it returns the vectors for the
101# overall curve (sum of all components).
102# ----------------------------------------------------------------------
103itcl::body Rappture::Curve::mesh {cname} {
104    if {[info exists _comp2xy($cname)]} {
105        return [lindex $_comp2xy($cname) 0]  ;# return xv
106    }
107    error "bad component \"$cname\": should be one of [join [lsort [array names _comp2xy]] {, }]"
108}
109
110# ----------------------------------------------------------------------
111# USAGE: values ?<name>?
112#
113# Returns the yvec for the specified curve component <name>.
114# If the name is not specified, then it returns the vectors for the
115# overall curve (sum of all components).
116# ----------------------------------------------------------------------
117itcl::body Rappture::Curve::values {cname} {
118    if {[info exists _comp2xy($cname)]} {
119        return [lindex $_comp2xy($cname) 1]  ;# return yv
120    }
121    error "bad component \"$cname\": should be one of [join [lsort [array names _comp2xy]] {, }]"
122}
123
124# ----------------------------------------------------------------------
125# USAGE: xErrorValues <name>
126#
127# Returns the xvec for the specified curve component <name>.
128# If the name is not specified, then it returns the vectors for the
129# overall curve (sum of all components).
130# ----------------------------------------------------------------------
131itcl::body Rappture::Curve::xErrorValues { cname } {
132    if {[info exists _comp2xy($cname)]} {
133        return [lindex $_comp2xy($cname) 2]  ;# return xev
134    }
135    error "unknown component \"$cname\": should be one of [join [lsort [array names _comp2xy]] {, }]"
136}
137
138# ----------------------------------------------------------------------
139# USAGE: yErrorValues <name>
140#
141# Returns the xvec for the specified curve component <name>.
142# If the name is not specified, then it returns the vectors for the
143# overall curve (sum of all components).
144# ----------------------------------------------------------------------
145itcl::body Rappture::Curve::yErrorValues { cname } {
146    if {[info exists _comp2xy($cname)]} {
147        return [lindex $_comp2xy($cname) 3]  ;# return yev
148    }
149    error "unknown component \"$cname\": should be one of [join [lsort [array names _comp2xy]] {, }]"
150}
151
152# ----------------------------------------------------------------------
153# USAGE: limits x|xlin|xlog|y|ylin|ylog
154#
155# Returns the {min max} limits for the specified axis.
156# ----------------------------------------------------------------------
157itcl::body Rappture::Curve::limits {which} {
158    set min ""
159    set max ""
160    switch -- $which {
161        x - xlin { set pos 0; set log 0; set axis xaxis }
162        xlog { set pos 0; set log 1; set axis xaxis }
163        y - ylin - v - vlin { set pos 1; set log 0; set axis yaxis }
164        ylog - vlog { set pos 1; set log 1; set axis yaxis }
165        default {
166            error "bad option \"$which\": should be x, xlin, xlog, y, ylin, ylog, v, vlin, vlog"
167        }
168    }
169
170    blt::vector tmp zero
171    foreach comp [array names _comp2xy] {
172        set vname [lindex $_comp2xy($comp) $pos]
173        $vname variable vec
174
175        if {$log} {
176            # on a log scale, use abs value and ignore 0's
177            $vname dup tmp
178            $vname dup zero
179            zero expr {tmp == 0}            ;# find the 0's
180            tmp expr {abs(tmp)}             ;# get the abs value
181            tmp expr {tmp + zero*max(tmp)}  ;# replace 0's with abs max
182            set vmin [blt::vector expr min(tmp)]
183            set vmax [blt::vector expr max(tmp)]
184        } else {
185            set vmin $vec(min)
186            set vmax $vec(max)
187        }
188
189        if {"" == $min} {
190            set min $vmin
191        } elseif {$vmin < $min} {
192            set min $vmin
193        }
194        if {"" == $max} {
195            set max $vmax
196        } elseif {$vmax > $max} {
197            set max $vmax
198        }
199    }
200    blt::vector destroy tmp zero
201
202    set val [$_curve get $axis.min]
203    if {"" != $val && "" != $min} {
204        if {$val > $min} {
205            # tool specified this min -- don't go any lower
206            set min $val
207        }
208    }
209
210    set val [$_curve get $axis.max]
211    if {"" != $val && "" != $max} {
212        if {$val < $max} {
213            # tool specified this max -- don't go any higher
214            set max $val
215        }
216    }
217
218    return [list $min $max]
219}
220
221# ----------------------------------------------------------------------
222# USAGE: hints ?<keyword>?
223#
224# Returns a list of key/value pairs for various hints about plotting
225# this curve.  If a particular <keyword> is specified, then it returns
226# the hint for that <keyword>, if it exists.
227# ----------------------------------------------------------------------
228itcl::body Rappture::Curve::hints {{keyword ""}} {
229    if {![info exists _hints]} {
230        foreach {key path} {
231            color   about.color
232            group   about.group
233            label   about.label
234            style   about.style
235            type    about.type
236            xdesc   xaxis.description
237            xlabel  xaxis.label
238            xmax    xaxis.max
239            xmin    xaxis.min
240            xscale  xaxis.scale
241            xticks  xaxis.ticklabels
242            xunits  xaxis.units
243            ydesc   yaxis.description
244            ylabel  yaxis.label
245            ymax    yaxis.max
246            ymin    yaxis.min
247            yscale  yaxis.scale
248            yticks  yaxis.ticklabels
249            yunits  yaxis.units
250        } {
251            set str [$_curve get $path]
252            if {"" != $str} {
253                set _hints($key) $str
254            }
255        }
256        if {[info exists _hints(xlabel)] && "" != $_hints(xlabel)
257              && [info exists _hints(xunits)] && "" != $_hints(xunits)} {
258            set _hints(xlabel) "$_hints(xlabel) ($_hints(xunits))"
259        }
260        if {[info exists _hints(ylabel)] && "" != $_hints(ylabel)
261              && [info exists _hints(yunits)] && "" != $_hints(yunits)} {
262            set _hints(ylabel) "$_hints(ylabel) ($_hints(yunits))"
263        }
264
265        if {[info exists _hints(group)] && [info exists _hints(label)]} {
266            # pop-up help for each curve
267            set _hints(tooltip) $_hints(label)
268        }
269        set _hints(xmlobj) $_xmlobj
270    }
271    if {$keyword != ""} {
272        if {[info exists _hints($keyword)]} {
273            return $_hints($keyword)
274        }
275        return ""
276    }
277    return [array get _hints]
278}
279
280# ----------------------------------------------------------------------
281# USAGE: _build
282#
283# Used internally to build up the vector representation for the
284# curve when the object is first constructed, or whenever the curve
285# data changes.  Discards any existing vectors and builds everything
286# from scratch.
287# ----------------------------------------------------------------------
288itcl::body Rappture::Curve::_build {} {
289    # discard any existing data
290    foreach name [array names _comp2xy] {
291        eval blt::vector destroy $_comp2xy($name)
292    }
293    catch {unset _comp2xy}
294
295    #
296    # Scan through the components of the curve and create
297    # vectors for each part.
298    #
299    foreach cname [$_curve children -type component] {
300        set xv [blt::vector create \#auto]
301        set yv [blt::vector create \#auto]
302        set xev [blt::vector create \#auto]
303        set yev [blt::vector create \#auto]
304
305        set xydata [$_curve get $cname.xy]
306        if { "" != $xydata} {
307            set tmp [blt::vector create \#auto]
308            $tmp set $xydata
309            $tmp split $xv $yv
310            blt::vector destroy $tmp
311        } else {
312            $xv set [$_curve get $cname.xvector]
313            $yv set [$_curve get $cname.yvector]
314        }
315        if { (([$xv length] == 0) && ([$yv length] == 0)) ||
316             ([$xv length] != [$yv length]) } {
317            # FIXME: need to show an error about improper data.
318            blt::vector destroy $xv $yv
319            set xv ""; set yv ""
320            continue;
321        }
322        $xev set [$_curve get "$cname.xerrorbars"]
323        $yev set [$_curve get "$cname.yerrorbars"]
324        set _comp2xy($cname) [list $xv $yv $xev $yev]
325        incr _counter
326    }
327
328    # Creates lists of x and y marker data.
329    set _xmarkers {}
330    set _ymarkers {}
331    foreach cname [$_curve children -type "marker" xaxis] {
332        set at     [$_curve get "xaxis.$cname.at"]
333        set label  [$_curve get "xaxis.$cname.label"]
334        set styles [$_curve get "xaxis.$cname.style"]
335        set data [list $at $label $styles]
336        lappend _xmarkers $data
337    }
338    foreach cname [$_curve children -type "marker" yaxis] {
339        set at     [$_curve get "yaxis.$cname.at"]
340        set label  [$_curve get "yaxis.$cname.label"]
341        set styles [$_curve get "yaxis.$cname.style"]
342        set data [list $at $label $styles]
343        lappend _ymarkers $data
344    }
345}
346
347# ----------------------------------------------------------------------
348# USAGE: xmarkers
349#
350# Returns the list of settings for each marker on the x-axis.
351# If no markers have been specified the empty string is returned.
352# ----------------------------------------------------------------------
353itcl::body Rappture::Curve::xmarkers {} {
354    return $_xmarkers;
355}
356
357# ----------------------------------------------------------------------
358# USAGE: ymarkers
359#
360# Returns the list of settings for each marker on the y-axis.
361# If no markers have been specified the empty string is returned.
362# ----------------------------------------------------------------------
363itcl::body Rappture::Curve::ymarkers {} {
364    return $_ymarkers;
365}
366
Note: See TracBrowser for help on using the repository browser.