source: trunk/gui/scripts/xyresult.tcl @ 12

Last change on this file since 12 was 12, checked in by mmc, 16 years ago

Fixed a new nits to so that the pntoy works
better. The <tool><control>auto</control></tool>
mode is now truly automatic, and the Simulate
button no longer appears in that mode.

File size: 10.7 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: xyresult - X/Y plot in a ResultSet
3#
4#  This widget is an X/Y plot, meant to view line graphs produced
5#  as output from the run of a Rappture tool.  Use the "add" and
6#  "delete" methods to control the curves showing on the plot.
7# ======================================================================
8#  AUTHOR:  Michael McLennan, Purdue University
9#  Copyright (c) 2004-2005
10#  Purdue Research Foundation, West Lafayette, IN
11# ======================================================================
12package require Itk
13package require BLT
14
15option add *XyResult.width 4i widgetDefault
16option add *XyResult.height 4i widgetDefault
17option add *XyResult.gridColor #d9d9d9 widgetDefault
18option add *XyResult.font \
19    -*-helvetica-medium-r-normal-*-*-120-* widgetDefault
20
21itcl::class Rappture::XyResult {
22    inherit itk::Widget
23
24    itk_option define -gridcolor gridColor GridColor ""
25
26    constructor {args} { # defined below }
27    destructor { # defined below }
28
29    public method add {curve {settings ""}}
30    public method delete {args}
31    public method scale {args}
32
33    protected method _rebuild {}
34    protected method _fixLimits {}
35
36    private variable _clist ""     ;# list of curve objects
37    private variable _curve2color  ;# maps curve => plotting color
38    private variable _curve2width  ;# maps curve => line width
39    private variable _curve2raise  ;# maps curve => raise flag 0/1
40    private variable _curve2elems  ;# maps curve => elements on graph
41    private variable _xmin ""      ;# autoscale min for x-axis
42    private variable _xmax ""      ;# autoscale max for x-axis
43    private variable _ymin ""      ;# autoscale min for y-axis
44    private variable _ymax ""      ;# autoscale max for y-axis
45}
46                                                                               
47itk::usual XyResult {
48    keep -background -foreground -cursor -font
49}
50
51# ----------------------------------------------------------------------
52# CONSTRUCTOR
53# ----------------------------------------------------------------------
54itcl::body Rappture::XyResult::constructor {args} {
55    option add hull.width hull.height
56    pack propagate $itk_component(hull) no
57
58    itk_component add plot {
59        blt::graph $itk_interior.plot \
60            -highlightthickness 0 -plotpadx 0 -plotpady 0 \
61            -rightmargin 10
62    } {
63        keep -background -foreground -cursor -font
64    }
65    pack $itk_component(plot) -expand yes -fill both
66
67    Blt_ZoomStack $itk_component(plot)
68    $itk_component(plot) legend configure -hide yes
69
70    eval itk_initialize $args
71}
72
73# ----------------------------------------------------------------------
74# DESTRUCTOR
75# ----------------------------------------------------------------------
76itcl::body Rappture::XyResult::destructor {} {
77}
78
79# ----------------------------------------------------------------------
80# USAGE: add <curve> ?<settings>?
81#
82# Clients use this to add a curve to the plot.  The optional <settings>
83# are used to configure the plot.  Allowed settings are -color, -width,
84# and -raise.
85# ----------------------------------------------------------------------
86itcl::body Rappture::XyResult::add {curve {settings ""}} {
87    array set params {
88        -color black
89        -width 1
90        -raise 0
91    }
92    foreach {opt val} $settings {
93        if {![info exists params($opt)]} {
94            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
95        }
96        set params($opt) $val
97    }
98
99    set pos [lsearch -exact $curve $_clist]
100    if {$pos < 0} {
101        lappend _clist $curve
102        set _curve2color($curve) $params(-color)
103        set _curve2width($curve) $params(-width)
104        set _curve2raise($curve) $params(-raise)
105
106        after cancel [itcl::code $this _rebuild]
107        after idle [itcl::code $this _rebuild]
108    }
109}
110
111# ----------------------------------------------------------------------
112# USAGE: delete ?<curve1> <curve2> ...?
113#
114# Clients use this to delete a curve from the plot.  If no curves
115# are specified, then all curves are deleted.
116# ----------------------------------------------------------------------
117itcl::body Rappture::XyResult::delete {args} {
118    if {[llength $args] == 0} {
119        set args $_clist
120    }
121
122    # delete all specified curves
123    set changed 0
124    foreach curve $args {
125        set pos [lsearch -exact $_clist $curve]
126        if {$pos >= 0} {
127            set _clist [lreplace $_clist $pos $pos]
128            catch {unset _curve2color($curve)}
129            catch {unset _curve2width($curve)}
130            catch {unset _curve2raise($curve)}
131            catch {unset _curve2elems($curve)}
132            set changed 1
133        }
134    }
135
136    # if anything changed, then rebuild the plot
137    if {$changed} {
138        after cancel [itcl::code $this _rebuild]
139        after idle [itcl::code $this _rebuild]
140    }
141}
142
143# ----------------------------------------------------------------------
144# USAGE: scale ?<curve1> <curve2> ...?
145#
146# Sets the default limits for the overall plot according to the
147# limits of the data for all of the given <curve> objects.  This
148# accounts for all curves--even those not showing on the screen.
149# Because of this, the limits are appropriate for all curves as
150# the user scans through data in the ResultSet viewer.
151# ----------------------------------------------------------------------
152itcl::body Rappture::XyResult::scale {args} {
153    set _xmin ""
154    set _xmax ""
155    set _ymin ""
156    set _ymax ""
157    foreach obj $args {
158        foreach axis {x y} {
159            foreach {min max} [$obj limits $axis] break
160            if {"" != $min && "" != $max} {
161                if {"" == [set _${axis}min]} {
162                    set _${axis}min $min
163                    set _${axis}max $max
164                } else {
165                    if {$min < [set _${axis}min]} {
166                        set _${axis}min $min
167                    }
168                    if {$max > [set _${axis}max]} {
169                        set _${axis}max $max
170                    }
171                }
172            }
173        }
174    }
175    _fixLimits
176}
177
178# ----------------------------------------------------------------------
179# USAGE: _rebuild
180#
181# Called automatically whenever something changes that affects the
182# data in the widget.  Clears any existing data and rebuilds the
183# widget to display new data.
184# ----------------------------------------------------------------------
185itcl::body Rappture::XyResult::_rebuild {} {
186    set g $itk_component(plot)
187
188    # first clear out the widget
189    eval $g element delete [$g element names]
190    $g axis configure y -min "" -max ""
191
192    # extract axis information from the first curve
193    set xydata [lindex $_clist 0]
194    if {$xydata != ""} {
195        set legend [$xydata hints legend]
196        if {"" != $legend} {
197            if {$legend == "off"} {
198                $g legend configure -hide yes
199            } else {
200                $g legend configure -hide no \
201                    -position plotarea -anchor $legend -borderwidth 0
202            }
203        }
204
205        set xlabel [$xydata hints xlabel]
206        if {"" != $xlabel} {
207            $g xaxis configure -title $xlabel
208        }
209
210        set ylabel [$xydata hints ylabel]
211        if {"" != $ylabel} {
212            $g yaxis configure -title $ylabel
213        }
214    }
215
216    # plot all of the curves
217    set count 0
218    foreach xydata $_clist {
219        set _curve2elems($xydata) ""
220
221        foreach comp [$xydata components] {
222            set xv [$xydata mesh $comp]
223            set yv [$xydata values $comp]
224
225            if {[info exists _curve2color($xydata)]} {
226                set color $_curve2color($xydata)
227            } else {
228                set color [$xydata hints color]
229                if {"" == $color} {
230                    set color black
231                }
232            }
233
234            if {[info exists _curve2width($xydata)]} {
235                set lwidth $_curve2width($xydata)
236            } else {
237                set lwidth 2
238            }
239
240            set elem "elem[incr count]"
241            lappend _curve2elems($xydata) $elem
242
243            set label [$xydata hints label]
244            $g element create $elem -x $xv -y $yv \
245                -symbol "" -linewidth $lwidth -label $label -color $color
246
247            set style [$xydata hints style]
248            if {$style != ""} {
249                eval $g element configure $elem $style
250            }
251        }
252    }
253
254    # raise those tagged to be on top
255    set dlist [$g element show]
256    foreach xydata $_clist {
257        if {[info exists _curve2raise($xydata)] && $_curve2raise($xydata)} {
258            foreach elem $_curve2elems($xydata) {
259                set i [lsearch -exact $dlist $elem]
260                if {$i >= 0} {
261                    # move element to end of display list
262                    set dlist [lreplace $dlist $i $i]
263                    lappend dlist $elem
264                }
265            }
266        }
267    }
268    $g element show $dlist
269
270    _fixLimits
271}
272
273# ----------------------------------------------------------------------
274# USAGE: _fixLimits
275#
276# Used internally to apply automatic limits to the axes for the
277# current plot.
278# ----------------------------------------------------------------------
279itcl::body Rappture::XyResult::_fixLimits {} {
280    set g $itk_component(plot)
281
282    #
283    # HACK ALERT!
284    # Use this code to fix up the y-axis limits for the BLT graph.
285    # The auto-limits don't always work well.  We want them to be
286    # set to a "nice" number slightly above or below the min/max
287    # limits.
288    #
289    $g axis configure x -min $_xmin -max $_xmax
290
291    if {"" != $_ymin && "" != $_ymax} {
292        set min $_ymin
293        set max $_ymax
294        set log [$g axis cget y -logscale]
295        if {$log} {
296            if {$min == $max} {
297                set min [expr {0.9*$min}]
298                set max [expr {1.1*$max}]
299            }
300            set min [expr {pow(10.0,floor(log10($min)))}]
301            set max [expr {pow(10.0,ceil(log10($max)))}]
302        } else {
303            if {$min > 0} {
304                set min [expr {0.95*$min}]
305            } else {
306                set min [expr {1.05*$min}]
307            }
308            if {$max > 0} {
309                set max [expr {1.05*$max}]
310            } else {
311                set max [expr {0.95*$max}]
312            }
313        }
314        $g axis configure y -min $min -max $max
315    } else {
316        $g axis configure y -min "" -max ""
317    }
318}
319
320# ----------------------------------------------------------------------
321# CONFIGURATION OPTION: -gridcolor
322# ----------------------------------------------------------------------
323itcl::configbody Rappture::XyResult::gridcolor {
324    if {"" == $itk_option(-gridcolor)} {
325        $itk_component(plot) grid off
326    } else {
327        $itk_component(plot) grid configure -color $itk_option(-gridcolor)
328        $itk_component(plot) grid on
329    }
330}
Note: See TracBrowser for help on using the repository browser.