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

Last change on this file since 3515 was 3330, checked in by gah, 12 years ago

merge (by hand) with Rappture1.2 branch

File size: 11.4 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 {{what -overall}}
35    public method values {{what -overall}}
36    public method limits {which}
37    public method hints {{key ""}}
38    public method xmarkers {}
39    public method ymarkers {}
40
41    protected method _build {}
42
43    private variable _xmlobj ""  ;# ref to lib obj with curve data
44    private variable _curve ""   ;# lib obj representing this curve
45    private variable _comp2xy    ;# maps component name => x,y vectors
46    private variable _hints      ;# cache of hints stored in XML
47
48    private variable _xmarkers "";# list of {x,label,options} triplets.
49    private variable _ymarkers "";# list of {y,label,options} triplets.
50    private common _counter 0    ;# counter for unique vector names
51}
52
53# ----------------------------------------------------------------------
54# CONSTRUCTOR
55# ----------------------------------------------------------------------
56itcl::body Rappture::Curve::constructor {xmlobj path} {
57    if {![Rappture::library isvalid $xmlobj]} {
58        error "bad value \"$xmlobj\": should be LibraryObj"
59    }
60    set _xmlobj $xmlobj
61    set _curve [$xmlobj element -as object $path]
62
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 {{what -overall}} {
104    if {[info exists _comp2xy($what)]} {
105        return [lindex $_comp2xy($what) 0]  ;# return xv
106    }
107    error "bad option \"$what\": should be [join [lsort [array names _comp2xy]] {, }]"
108}
109
110# ----------------------------------------------------------------------
111# USAGE: values ?<name>?
112#
113# Returns the xvec 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 {{what -overall}} {
118    if {[info exists _comp2xy($what)]} {
119        return [lindex $_comp2xy($what) 1]  ;# return yv
120    }
121    error "bad option \"$what\": should be [join [lsort [array names _comp2xy]] {, }]"
122}
123
124# ----------------------------------------------------------------------
125# USAGE: limits x|xlin|xlog|y|ylin|ylog
126#
127# Returns the {min max} limits for the specified axis.
128# ----------------------------------------------------------------------
129itcl::body Rappture::Curve::limits {which} {
130    set min ""
131    set max ""
132    switch -- $which {
133        x - xlin { set pos 0; set log 0; set axis xaxis }
134        xlog { set pos 0; set log 1; set axis xaxis }
135        y - ylin - v - vlin { set pos 1; set log 0; set axis yaxis }
136        ylog - vlog { set pos 1; set log 1; set axis yaxis }
137        default {
138            error "bad option \"$which\": should be x, xlin, xlog, y, ylin, ylog, v, vlin, vlog"
139        }
140    }
141
142    blt::vector tmp zero
143    foreach comp [array names _comp2xy] {
144        set vname [lindex $_comp2xy($comp) $pos]
145        $vname variable vec
146
147        if {$log} {
148            # on a log scale, use abs value and ignore 0's
149            $vname dup tmp
150            $vname dup zero
151            zero expr {tmp == 0}            ;# find the 0's
152            tmp expr {abs(tmp)}             ;# get the abs value
153            tmp expr {tmp + zero*max(tmp)}  ;# replace 0's with abs max
154            set vmin [blt::vector expr min(tmp)]
155            set vmax [blt::vector expr max(tmp)]
156        } else {
157            set vmin $vec(min)
158            set vmax $vec(max)
159        }
160
161        if {"" == $min} {
162            set min $vmin
163        } elseif {$vmin < $min} {
164            set min $vmin
165        }
166        if {"" == $max} {
167            set max $vmax
168        } elseif {$vmax > $max} {
169            set max $vmax
170        }
171    }
172    blt::vector destroy tmp zero
173
174    set val [$_curve get $axis.min]
175    if {"" != $val && "" != $min} {
176        if {$val > $min} {
177            # tool specified this min -- don't go any lower
178            set min $val
179        }
180    }
181
182    set val [$_curve get $axis.max]
183    if {"" != $val && "" != $max} {
184        if {$val < $max} {
185            # tool specified this max -- don't go any higher
186            set max $val
187        }
188    }
189
190    return [list $min $max]
191}
192
193# ----------------------------------------------------------------------
194# USAGE: hints ?<keyword>?
195#
196# Returns a list of key/value pairs for various hints about plotting
197# this curve.  If a particular <keyword> is specified, then it returns
198# the hint for that <keyword>, if it exists.
199# ----------------------------------------------------------------------
200itcl::body Rappture::Curve::hints {{keyword ""}} {
201    if {![info exists _hints]} {
202        foreach {key path} {
203            color   about.color
204            group   about.group
205            label   about.label
206            style   about.style
207            type    about.type
208            xdesc   xaxis.description
209            xlabel  xaxis.label
210            xmax    xaxis.max
211            xmin    xaxis.min
212            xscale  xaxis.scale
213            xticks  xaxis.ticklabels
214            xunits  xaxis.units
215            ydesc   yaxis.description
216            ylabel  yaxis.label
217            ymax    yaxis.max
218            ymin    yaxis.min
219            yscale  yaxis.scale
220            yticks  yaxis.ticklabels
221            yunits  yaxis.units
222        } {
223            set str [$_curve get $path]
224            if {"" != $str} {
225                set _hints($key) $str
226            }
227        }
228        if {[info exists _hints(xlabel)] && "" != $_hints(xlabel)
229              && [info exists _hints(xunits)] && "" != $_hints(xunits)} {
230            set _hints(xlabel) "$_hints(xlabel) ($_hints(xunits))"
231        }
232        if {[info exists _hints(ylabel)] && "" != $_hints(ylabel)
233              && [info exists _hints(yunits)] && "" != $_hints(yunits)} {
234            set _hints(ylabel) "$_hints(ylabel) ($_hints(yunits))"
235        }
236
237        if {[info exists _hints(group)] && [info exists _hints(label)]} {
238            # pop-up help for each curve
239            set _hints(tooltip) $_hints(label)
240        }
241        set _hints(xmlobj) $_xmlobj
242    }
243    if {$keyword != ""} {
244        if {[info exists _hints($keyword)]} {
245            return $_hints($keyword)
246        }
247        return ""
248    }
249    return [array get _hints]
250}
251
252# ----------------------------------------------------------------------
253# USAGE: _build
254#
255# Used internally to build up the vector representation for the
256# curve when the object is first constructed, or whenever the curve
257# data changes.  Discards any existing vectors and builds everything
258# from scratch.
259# ----------------------------------------------------------------------
260itcl::body Rappture::Curve::_build {} {
261    # discard any existing data
262    foreach name [array names _comp2xy] {
263        eval blt::vector destroy $_comp2xy($name)
264    }
265    catch {unset _comp2xy}
266
267    #
268    # Scan through the components of the curve and create
269    # vectors for each part.
270    #
271    foreach cname [$_curve children -type component] {
272        set xv [blt::vector create \#auto]
273        set yv [blt::vector create \#auto]
274
275        set xydata [$_curve get $cname.xy]
276        if { "" != $xydata} {
277            set tmp [blt::vector create \#auto]
278            $tmp set $xydata
279            $tmp split $xv $yv
280            blt::vector destroy $tmp
281        } else {
282            $xv set [$_curve get $cname.xvector]
283            $yv set [$_curve get $cname.yvector]
284        }
285        if { (([$xv length] == 0) && ([$yv length] == 0))
286            || ([$xv length] != [$yv length]) } {
287            # FIXME: need to show an error about improper data.
288            blt::vector destroy $xv $yv
289            set xv ""; set yv ""
290        } else {
291            set _comp2xy($cname) [list $xv $yv]
292            incr _counter
293        }
294    }
295    # Creates lists of x and y marker data.
296    set _xmarkers {}
297    set _ymarkers {}
298    foreach cname [$_curve children -type "marker" xaxis] {
299        set at     [$_curve get "xaxis.$cname.at"]
300        set label  [$_curve get "xaxis.$cname.label"]
301        set styles [$_curve get "xaxis.$cname.style"]
302        set data [list $at $label $styles]
303        lappend _xmarkers $data
304    }
305    foreach cname [$_curve children -type "marker" yaxis] {
306        set at     [$_curve get "yaxis.$cname.at"]
307        set label  [$_curve get "yaxis.$cname.label"]
308        set styles [$_curve get "yaxis.$cname.style"]
309        set data [list $at $label $styles]
310        lappend _ymarkers $data
311    }
312}
313
314# ----------------------------------------------------------------------
315# USAGE: xmarkers
316#
317# Returns the list of settings for each marker on the x-axis.
318# If no markers have been specified the empty string is returned.
319# ----------------------------------------------------------------------
320itcl::body Rappture::Curve::xmarkers {} {
321    return $_xmarkers;
322}
323
324# ----------------------------------------------------------------------
325# USAGE: ymarkers
326#
327# Returns the list of settings for each marker on the y-axis.
328# If no markers have been specified the empty string is returned.
329# ----------------------------------------------------------------------
330itcl::body Rappture::Curve::ymarkers {} {
331    return $_ymarkers;
332}
333
Note: See TracBrowser for help on using the repository browser.