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

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

Many improvements, including a new energy level viewer
for Huckel-IV. Added support for a new <boolean> type.
Fixed the cloud/field stuff so that when a cloud is 1D,
it reverts to BLT vectors so it will plot correctly.
Fixed the install script to work better on Windows.

File size: 15.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.hiliteColor black widgetDefault
19option add *XyResult.controlBackground gray widgetDefault
20option add *XyResult.font \
21    -*-helvetica-medium-r-normal-*-*-120-* widgetDefault
22
23blt::bitmap define ContourResult-reset {
24#define reset_width 12
25#define reset_height 12
26static unsigned char reset_bits[] = {
27   0x00, 0x00, 0x00, 0x00, 0xfc, 0x03, 0x04, 0x02, 0x04, 0x02, 0x04, 0x02,
28   0x04, 0x02, 0x04, 0x02, 0x04, 0x02, 0xfc, 0x03, 0x00, 0x00, 0x00, 0x00};
29}
30
31itcl::class Rappture::XyResult {
32    inherit itk::Widget
33
34    itk_option define -gridcolor gridColor GridColor ""
35    itk_option define -hilitecolor hiliteColor HiliteColor ""
36
37    constructor {args} { # defined below }
38    destructor { # defined below }
39
40    public method add {curve {settings ""}}
41    public method get {}
42    public method delete {args}
43    public method scale {args}
44
45    protected method _rebuild {}
46    protected method _fixLimits {}
47    protected method _zoom {option args}
48    protected method _hilite {state x y}
49
50    private variable _clist ""     ;# list of curve objects
51    private variable _curve2color  ;# maps curve => plotting color
52    private variable _curve2width  ;# maps curve => line width
53    private variable _curve2dashes ;# maps curve => BLT -dashes list
54    private variable _curve2raise  ;# maps curve => raise flag 0/1
55    private variable _elem2curve   ;# maps graph element => curve
56    private variable _xmin ""      ;# autoscale min for x-axis
57    private variable _xmax ""      ;# autoscale max for x-axis
58    private variable _ymin ""      ;# autoscale min for y-axis
59    private variable _ymax ""      ;# autoscale max for y-axis
60    private variable _hilite ""    ;# info from last _hilite operation
61}
62                                                                               
63itk::usual XyResult {
64    keep -background -foreground -cursor -font
65}
66
67# ----------------------------------------------------------------------
68# CONSTRUCTOR
69# ----------------------------------------------------------------------
70itcl::body Rappture::XyResult::constructor {args} {
71    option add hull.width hull.height
72    pack propagate $itk_component(hull) no
73
74    itk_component add controls {
75        frame $itk_interior.cntls
76    } {
77        usual
78        rename -background -controlbackground controlBackground Background
79    }
80    pack $itk_component(controls) -side right -fill y
81
82    itk_component add reset {
83        button $itk_component(controls).reset \
84            -borderwidth 1 -padx 1 -pady 1 \
85            -bitmap ContourResult-reset \
86            -command [itcl::code $this _zoom reset]
87    } {
88        usual
89        ignore -borderwidth
90        rename -highlightbackground -controlbackground controlBackground Background
91    }
92    pack $itk_component(reset) -padx 4 -pady 4
93    Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
94
95
96    itk_component add plot {
97        blt::graph $itk_interior.plot \
98            -highlightthickness 0 -plotpadx 0 -plotpady 0 \
99            -rightmargin 10
100    } {
101        keep -background -foreground -cursor -font
102    }
103    pack $itk_component(plot) -expand yes -fill both
104
105    # special pen for highlighting active traces
106    $itk_component(plot) element bind all <Enter> \
107        [itcl::code $this _hilite on %x %y]
108    $itk_component(plot) element bind all <Leave> \
109        [itcl::code $this _hilite off %x %y]
110
111    Blt_ZoomStack $itk_component(plot)
112    $itk_component(plot) legend configure -hide yes
113
114    eval itk_initialize $args
115}
116
117# ----------------------------------------------------------------------
118# DESTRUCTOR
119# ----------------------------------------------------------------------
120itcl::body Rappture::XyResult::destructor {} {
121}
122
123# ----------------------------------------------------------------------
124# USAGE: add <curve> ?<settings>?
125#
126# Clients use this to add a curve to the plot.  The optional <settings>
127# are used to configure the plot.  Allowed settings are -color,
128# -brightness, -width, -linestyle and -raise.
129# ----------------------------------------------------------------------
130itcl::body Rappture::XyResult::add {curve {settings ""}} {
131    array set params {
132        -color black
133        -brightness 0
134        -width 1
135        -raise 0
136        -linestyle solid
137    }
138    foreach {opt val} $settings {
139        if {![info exists params($opt)]} {
140            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
141        }
142        set params($opt) $val
143    }
144
145    # convert -linestyle to BLT -dashes
146    switch -- $params(-linestyle) {
147        dashed { set params(-linestyle) {4 4} }
148        dotted { set params(-linestyle) {2 4} }
149        default { set params(-linestyle) {} }
150    }
151
152    # if -brightness is set, then update the color
153    if {$params(-brightness) != 0} {
154        set params(-color) [Rappture::color::brightness \
155            $params(-color) $params(-brightness)]
156    }
157
158    set pos [lsearch -exact $curve $_clist]
159    if {$pos < 0} {
160        lappend _clist $curve
161        set _curve2color($curve) $params(-color)
162        set _curve2width($curve) $params(-width)
163        set _curve2dashes($curve) $params(-linestyle)
164        set _curve2raise($curve) $params(-raise)
165
166        after cancel [itcl::code $this _rebuild]
167        after idle [itcl::code $this _rebuild]
168    }
169}
170
171# ----------------------------------------------------------------------
172# USAGE: get
173#
174# Clients use this to query the list of objects being plotted, in
175# order from bottom to top of this result.
176# ----------------------------------------------------------------------
177itcl::body Rappture::XyResult::get {} {
178    # put the dataobj list in order according to -raise options
179    set clist $_clist
180    foreach obj $clist {
181        if {[info exists _curve2raise($obj)] && $_curve2raise($obj)} {
182            set i [lsearch -exact $clist $obj]
183            if {$i >= 0} {
184                set clist [lreplace $clist $i $i]
185                lappend clist $obj
186            }
187        }
188    }
189    return $clist
190}
191
192# ----------------------------------------------------------------------
193# USAGE: delete ?<curve1> <curve2> ...?
194#
195# Clients use this to delete a curve from the plot.  If no curves
196# are specified, then all curves are deleted.
197# ----------------------------------------------------------------------
198itcl::body Rappture::XyResult::delete {args} {
199    if {[llength $args] == 0} {
200        set args $_clist
201    }
202
203    # delete all specified curves
204    set changed 0
205    foreach curve $args {
206        set pos [lsearch -exact $_clist $curve]
207        if {$pos >= 0} {
208            set _clist [lreplace $_clist $pos $pos]
209            catch {unset _curve2color($curve)}
210            catch {unset _curve2width($curve)}
211            catch {unset _curve2dashes($curve)}
212            catch {unset _curve2raise($curve)}
213            foreach elem [array names _elem2curve] {
214                if {$_elem2curve($elem) == $curve} {
215                    unset _elem2curve($elem)
216                }
217            }
218            set changed 1
219        }
220    }
221
222    # if anything changed, then rebuild the plot
223    if {$changed} {
224        after cancel [itcl::code $this _rebuild]
225        after idle [itcl::code $this _rebuild]
226    }
227}
228
229# ----------------------------------------------------------------------
230# USAGE: scale ?<curve1> <curve2> ...?
231#
232# Sets the default limits for the overall plot according to the
233# limits of the data for all of the given <curve> objects.  This
234# accounts for all curves--even those not showing on the screen.
235# Because of this, the limits are appropriate for all curves as
236# the user scans through data in the ResultSet viewer.
237# ----------------------------------------------------------------------
238itcl::body Rappture::XyResult::scale {args} {
239    set _xmin ""
240    set _xmax ""
241    set _ymin ""
242    set _ymax ""
243    foreach obj $args {
244        foreach axis {x y} {
245            foreach {min max} [$obj limits $axis] break
246            if {"" != $min && "" != $max} {
247                if {"" == [set _${axis}min]} {
248                    set _${axis}min $min
249                    set _${axis}max $max
250                } else {
251                    if {$min < [set _${axis}min]} {
252                        set _${axis}min $min
253                    }
254                    if {$max > [set _${axis}max]} {
255                        set _${axis}max $max
256                    }
257                }
258            }
259        }
260    }
261    _fixLimits
262}
263
264# ----------------------------------------------------------------------
265# USAGE: _rebuild
266#
267# Called automatically whenever something changes that affects the
268# data in the widget.  Clears any existing data and rebuilds the
269# widget to display new data.
270# ----------------------------------------------------------------------
271itcl::body Rappture::XyResult::_rebuild {} {
272    set g $itk_component(plot)
273
274    # first clear out the widget
275    eval $g element delete [$g element names]
276    $g axis configure y -min "" -max ""
277
278    # extract axis information from the first curve
279    set clist [get]
280    set xydata [lindex $clist 0]
281    if {$xydata != ""} {
282        set legend [$xydata hints legend]
283        if {"" != $legend} {
284            if {$legend == "off"} {
285                $g legend configure -hide yes
286            } else {
287                $g legend configure -hide no \
288                    -position plotarea -anchor $legend -borderwidth 0
289            }
290        }
291
292        set xlabel [$xydata hints xlabel]
293        if {"" != $xlabel} {
294            $g xaxis configure -title $xlabel
295        }
296
297        set ylabel [$xydata hints ylabel]
298        if {"" != $ylabel} {
299            $g yaxis configure -title $ylabel
300        }
301    }
302
303    # plot all of the curves
304    set count 0
305    foreach xydata $clist {
306        foreach comp [$xydata components] {
307            set xv [$xydata mesh $comp]
308            set yv [$xydata values $comp]
309
310            if {[info exists _curve2color($xydata)]} {
311                set color $_curve2color($xydata)
312            } else {
313                set color [$xydata hints color]
314                if {"" == $color} {
315                    set color black
316                }
317            }
318
319            if {[info exists _curve2width($xydata)]} {
320                set lwidth $_curve2width($xydata)
321            } else {
322                set lwidth 2
323            }
324
325            if {[info exists _curve2dashes($xydata)]} {
326                set dashes $_curve2dashes($xydata)
327            } else {
328                set dashes ""
329            }
330
331            if {[$xv length] <= 1} {
332                set sym square
333            } else {
334                set sym ""
335            }
336
337            set elem "elem[incr count]"
338            set _elem2curve($elem) $xydata
339
340            set label [$xydata hints label]
341            $g element create $elem -x $xv -y $yv \
342                -symbol $sym -pixels 6 -linewidth $lwidth -label $label \
343                -color $color -dashes $dashes
344        }
345    }
346
347    _fixLimits
348}
349
350# ----------------------------------------------------------------------
351# USAGE: _fixLimits
352#
353# Used internally to apply automatic limits to the axes for the
354# current plot.
355# ----------------------------------------------------------------------
356itcl::body Rappture::XyResult::_fixLimits {} {
357    set g $itk_component(plot)
358
359    #
360    # HACK ALERT!
361    # Use this code to fix up the y-axis limits for the BLT graph.
362    # The auto-limits don't always work well.  We want them to be
363    # set to a "nice" number slightly above or below the min/max
364    # limits.
365    #
366    if {$_xmin != $_xmax} {
367        $g axis configure x -min $_xmin -max $_xmax
368    } else {
369        $g axis configure x -min "" -max ""
370    }
371
372    if {"" != $_ymin && "" != $_ymax} {
373        set min $_ymin
374        set max $_ymax
375        set log [$g axis cget y -logscale]
376        if {$log} {
377            if {$min == $max} {
378                set min [expr {0.9*$min}]
379                set max [expr {1.1*$max}]
380            }
381            set min [expr {pow(10.0,floor(log10($min)))}]
382            set max [expr {pow(10.0,ceil(log10($max)))}]
383        } else {
384            if {$min > 0} {
385                set min [expr {0.95*$min}]
386            } else {
387                set min [expr {1.05*$min}]
388            }
389            if {$max > 0} {
390                set max [expr {1.05*$max}]
391            } else {
392                set max [expr {0.95*$max}]
393            }
394        }
395        if {$min != $max} {
396            $g axis configure y -min $min -max $max
397        } else {
398            $g axis configure y -min "" -max ""
399        }
400    } else {
401        $g axis configure y -min "" -max ""
402    }
403}
404
405# ----------------------------------------------------------------------
406# USAGE: _zoom reset
407#
408# Called automatically when the user clicks on one of the zoom
409# controls for this widget.  Changes the zoom for the current view.
410# ----------------------------------------------------------------------
411itcl::body Rappture::XyResult::_zoom {option args} {
412    switch -- $option {
413        reset {
414            _fixLimits
415        }
416    }
417}
418
419# ----------------------------------------------------------------------
420# USAGE: _hilite <state> <x> <y>
421#
422# Called automatically when the user brushes one of the elements
423# on the plot.  Causes the element to highlight and a tooltip to
424# pop up with element info.
425# ----------------------------------------------------------------------
426itcl::body Rappture::XyResult::_hilite {state x y} {
427    set elem [$itk_component(plot) element get current]
428    if {$state} {
429        #
430        # Highlight ON:
431        # - fatten line
432        # - change color
433        # - pop up tooltip about data
434        #
435        set t [$itk_component(plot) element cget $elem -linewidth]
436        $itk_component(plot) element configure $elem -linewidth [expr {$t+2}]
437
438        set _hilite [$itk_component(plot) element cget $elem -color]
439        $itk_component(plot) element configure $elem \
440            -color $itk_option(-hilitecolor)
441
442        set tip ""
443        if {[info exists _elem2curve($elem)]} {
444            set curve $_elem2curve($elem)
445            set tip [$curve hints tooltip]
446        }
447        if {"" != $tip} {
448            set x [expr {$x+4}]  ;# move the tooltip over a bit
449            set y [expr {$y+4}]
450            Rappture::Tooltip::text $itk_component(plot) $tip
451            Rappture::Tooltip::tooltip show $itk_component(plot) +$x,$y
452        }
453    } else {
454        #
455        # Highlight OFF:
456        # - put line width back to normal
457        # - put color back to normal
458        # - take down tooltip
459        #
460        set t [$itk_component(plot) element cget $elem -linewidth]
461        $itk_component(plot) element configure $elem -linewidth [expr {$t-2}]
462
463        if {"" != $_hilite} {
464            $itk_component(plot) element configure $elem -color $_hilite
465        }
466        Rappture::Tooltip::tooltip cancel
467    }
468}
469
470# ----------------------------------------------------------------------
471# CONFIGURATION OPTION: -gridcolor
472# ----------------------------------------------------------------------
473itcl::configbody Rappture::XyResult::gridcolor {
474    if {"" == $itk_option(-gridcolor)} {
475        $itk_component(plot) grid off
476    } else {
477        $itk_component(plot) grid configure -color $itk_option(-gridcolor)
478        $itk_component(plot) grid on
479    }
480}
Note: See TracBrowser for help on using the repository browser.