source: branches/r9/gui/scripts/curve.tcl @ 4919

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