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

Last change on this file since 111 was 69, checked in by mmc, 19 years ago

Fixed the size of various widgets to request a smaller size,
so applications don't need to take up so much screen real estate.

Fixed the <string> entries to set their <default> value properly.

Added a new <separator> entry, which adds separation between
input controls.

Added a "zoo" of examples, showing little snippets of XML code.
File size: 43.0 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 3i widgetDefault
16option add *XyResult.height 3i widgetDefault
17option add *XyResult.gridColor #d9d9d9 widgetDefault
18option add *XyResult.activeColor blue widgetDefault
19option add *XyResult.dimColor gray widgetDefault
20option add *XyResult.controlBackground gray widgetDefault
21option add *XyResult.font \
22    -*-helvetica-medium-r-normal-*-*-120-* widgetDefault
23
24option add *XyResult.autoColors {
25    #0000ff #ff0000 #00cc00
26    #cc00cc #ff9900 #cccc00
27    #000080 #800000 #006600
28    #660066 #996600 #666600
29} widgetDefault
30
31option add *XyResult*Balloon*Entry.background white widgetDefault
32
33blt::bitmap define XyResult-reset {
34#define reset_width 12
35#define reset_height 12
36static unsigned char reset_bits[] = {
37   0x00, 0x00, 0x00, 0x00, 0xfc, 0x03, 0x04, 0x02, 0x04, 0x02, 0x04, 0x02,
38   0x04, 0x02, 0x04, 0x02, 0x04, 0x02, 0xfc, 0x03, 0x00, 0x00, 0x00, 0x00};
39}
40
41blt::bitmap define XyResult-dismiss {
42#define dismiss_width 10
43#define dismiss_height 8
44static unsigned char dismiss_bits[] = {
45   0x87, 0x03, 0xce, 0x01, 0xfc, 0x00, 0x78, 0x00, 0x78, 0x00, 0xfc, 0x00,
46   0xce, 0x01, 0x87, 0x03};
47}
48
49
50itcl::class Rappture::XyResult {
51    inherit itk::Widget
52
53    itk_option define -gridcolor gridColor GridColor ""
54    itk_option define -activecolor activeColor ActiveColor ""
55    itk_option define -dimcolor dimColor DimColor ""
56    itk_option define -autocolors autoColors AutoColors ""
57
58    constructor {args} { # defined below }
59    destructor { # defined below }
60
61    public method add {curve {settings ""}}
62    public method get {}
63    public method delete {args}
64    public method scale {args}
65    public method download {}
66
67    protected method _rebuild {}
68    protected method _resetLimits {}
69    protected method _zoom {option args}
70    protected method _hilite {state x y}
71    protected method _axis {option args}
72    protected method _getAxes {xydata}
73
74    private variable _dispatcher "" ;# dispatcher for !events
75
76    private variable _clist ""     ;# list of curve objects
77    private variable _curve2color  ;# maps curve => plotting color
78    private variable _curve2width  ;# maps curve => line width
79    private variable _curve2dashes ;# maps curve => BLT -dashes list
80    private variable _curve2raise  ;# maps curve => raise flag 0/1
81    private variable _elem2curve   ;# maps graph element => curve
82    private variable _label2axis   ;# maps axis label => axis ID
83    private variable _limits       ;# axis limits:  x-min, x-max, etc.
84    private variable _autoColorI 0 ;# index for next "-color auto"
85
86    private variable _hilite       ;# info for element currently highlighted
87    private variable _axis         ;# info for axis manipulations
88    private variable _axisPopup    ;# info for axis being edited in popup
89}
90                                                                               
91itk::usual XyResult {
92    keep -background -foreground -cursor -font
93}
94
95# ----------------------------------------------------------------------
96# CONSTRUCTOR
97# ----------------------------------------------------------------------
98itcl::body Rappture::XyResult::constructor {args} {
99    Rappture::dispatcher _dispatcher
100    $_dispatcher register !rebuild
101    $_dispatcher dispatch $this !rebuild "[itcl::code $this _rebuild]; list"
102
103    option add hull.width hull.height
104    pack propagate $itk_component(hull) no
105
106    itk_component add controls {
107        frame $itk_interior.cntls
108    } {
109        usual
110        rename -background -controlbackground controlBackground Background
111    }
112    pack $itk_component(controls) -side right -fill y
113
114    itk_component add reset {
115        button $itk_component(controls).reset \
116            -borderwidth 1 -padx 1 -pady 1 \
117            -bitmap XyResult-reset \
118            -command [itcl::code $this _zoom reset]
119    } {
120        usual
121        ignore -borderwidth
122        rename -highlightbackground -controlbackground controlBackground Background
123    }
124    pack $itk_component(reset) -padx 4 -pady 4
125    Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
126
127
128    itk_component add plot {
129        blt::graph $itk_interior.plot \
130            -highlightthickness 0 -plotpadx 0 -plotpady 0 \
131            -rightmargin 10
132    } {
133        keep -background -foreground -cursor -font
134    }
135    pack $itk_component(plot) -expand yes -fill both
136    $itk_component(plot) pen configure activeLine \
137        -symbol square -pixels 3 -linewidth 2 -color black
138
139    #
140    # Add bindings so you can mouse over points to see values:
141    #
142    bind $itk_component(plot) <Motion> \
143        [itcl::code $this _hilite at %x %y]
144    bind $itk_component(plot) <Leave> \
145        [itcl::code $this _hilite off %x %y]
146
147    #
148    # Add support for editing axes:
149    #
150    Rappture::Balloon $itk_component(hull).axes
151    set inner [$itk_component(hull).axes component inner]
152    set inner [frame $inner.bd -borderwidth 4 -relief flat]
153    pack $inner -expand yes -fill both
154
155    button $inner.dismiss -bitmap XyResult-dismiss \
156        -relief flat -overrelief raised -command "
157          Rappture::Tooltip::cue hide
158          [list $itk_component(hull).axes deactivate]
159        "
160    grid $inner.dismiss -row 0 -column 1 -sticky e
161
162    label $inner.labell -text "Label:"
163    entry $inner.label -width 15 -highlightbackground $itk_option(-background)
164    grid $inner.labell -row 1 -column 0 -sticky e
165    grid $inner.label -row 1 -column 1 -sticky ew -pady 4
166
167    label $inner.minl -text "Minimum:"
168    entry $inner.min -width 15 -highlightbackground $itk_option(-background)
169    grid $inner.minl -row 2 -column 0 -sticky e
170    grid $inner.min -row 2 -column 1 -sticky ew -pady 4
171
172    label $inner.maxl -text "Maximum:"
173    entry $inner.max -width 15 -highlightbackground $itk_option(-background)
174    grid $inner.maxl -row 3 -column 0 -sticky e
175    grid $inner.max -row 3 -column 1 -sticky ew -pady 4
176
177    label $inner.formatl -text "Format:"
178    Rappture::Combobox $inner.format -width 15 -editable no
179    $inner.format choices insert end \
180        "%.3g"  "Auto"         \
181        "%.1f"  "X.X"          \
182        "%.2f"  "X.XX"         \
183        "%.3f"  "X.XXX"        \
184        "%.6f"  "X.XXXXXX"     \
185        "%.1e"  "X.Xe+XX"      \
186        "%.2e"  "X.XXe+XX"     \
187        "%.3e"  "X.XXXe+XX"    \
188        "%.6e"  "X.XXXXXXe+XX"
189    grid $inner.formatl -row 4 -column 0 -sticky e
190    grid $inner.format -row 4 -column 1 -sticky ew -pady 4
191
192    label $inner.scalel -text "Scale:"
193    frame $inner.scales
194    radiobutton $inner.scales.linear -text "Linear" \
195        -variable [itcl::scope _axisPopup(scale)] -value "linear"
196    pack $inner.scales.linear -side left
197    radiobutton $inner.scales.log -text "Logarithmic" \
198        -variable [itcl::scope _axisPopup(scale)] -value "log"
199    pack $inner.scales.log -side left
200    grid $inner.scalel -row 5 -column 0 -sticky e
201    grid $inner.scales -row 5 -column 1 -sticky ew -pady 4
202
203    foreach axis {x y} {
204        set _axisPopup(format-$axis) "%.3g"
205    }
206    _axis scale x linear
207    _axis scale y linear
208
209    # quick-and-dirty zoom functionality, for now...
210    Blt_ZoomStack $itk_component(plot)
211    $itk_component(plot) legend configure -hide yes
212
213    eval itk_initialize $args
214
215    set _hilite(elem) ""
216}
217
218# ----------------------------------------------------------------------
219# DESTRUCTOR
220# ----------------------------------------------------------------------
221itcl::body Rappture::XyResult::destructor {} {
222}
223
224# ----------------------------------------------------------------------
225# USAGE: add <curve> ?<settings>?
226#
227# Clients use this to add a curve to the plot.  The optional <settings>
228# are used to configure the plot.  Allowed settings are -color,
229# -brightness, -width, -linestyle and -raise.
230# ----------------------------------------------------------------------
231itcl::body Rappture::XyResult::add {curve {settings ""}} {
232    array set params {
233        -color auto
234        -brightness 0
235        -width 1
236        -raise 0
237        -linestyle solid
238    }
239    foreach {opt val} $settings {
240        if {![info exists params($opt)]} {
241            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
242        }
243        set params($opt) $val
244    }
245
246    # if the color is "auto", then select a color from -autocolors
247    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
248        if {$params(-color) == "autoreset"} {
249            set _autoColorI 0
250        }
251        set color [lindex $itk_option(-autocolors) $_autoColorI]
252        if {"" == $color} { set color black }
253        set params(-color) $color
254
255        # set up for next auto color
256        if {[incr _autoColorI] >= [llength $itk_option(-autocolors)]} {
257            set _autoColorI 0
258        }
259    }
260
261    # convert -linestyle to BLT -dashes
262    switch -- $params(-linestyle) {
263        dashed { set params(-linestyle) {4 4} }
264        dotted { set params(-linestyle) {2 4} }
265        default { set params(-linestyle) {} }
266    }
267
268    # if -brightness is set, then update the color
269    if {$params(-brightness) != 0} {
270        set params(-color) [Rappture::color::brightness \
271            $params(-color) $params(-brightness)]
272
273        set bg [$itk_component(plot) cget -plotbackground]
274        foreach {h s v} [Rappture::color::RGBtoHSV $bg] break
275        if {$v > 0.5} {
276            set params(-color) [Rappture::color::brightness_max \
277                $params(-color) 0.8]
278        } else {
279            set params(-color) [Rappture::color::brightness_min \
280                $params(-color) 0.2]
281        }
282    }
283
284    set pos [lsearch -exact $curve $_clist]
285    if {$pos < 0} {
286        lappend _clist $curve
287        set _curve2color($curve) $params(-color)
288        set _curve2width($curve) $params(-width)
289        set _curve2dashes($curve) $params(-linestyle)
290        set _curve2raise($curve) $params(-raise)
291
292        $_dispatcher event -idle !rebuild
293    }
294}
295
296# ----------------------------------------------------------------------
297# USAGE: get
298#
299# Clients use this to query the list of objects being plotted, in
300# order from bottom to top of this result.
301# ----------------------------------------------------------------------
302itcl::body Rappture::XyResult::get {} {
303    # put the dataobj list in order according to -raise options
304    set clist $_clist
305    foreach obj $clist {
306        if {[info exists _curve2raise($obj)] && $_curve2raise($obj)} {
307            set i [lsearch -exact $clist $obj]
308            if {$i >= 0} {
309                set clist [lreplace $clist $i $i]
310                lappend clist $obj
311            }
312        }
313    }
314    return $clist
315}
316
317# ----------------------------------------------------------------------
318# USAGE: delete ?<curve1> <curve2> ...?
319#
320# Clients use this to delete a curve from the plot.  If no curves
321# are specified, then all curves are deleted.
322# ----------------------------------------------------------------------
323itcl::body Rappture::XyResult::delete {args} {
324    if {[llength $args] == 0} {
325        set args $_clist
326    }
327
328    # delete all specified curves
329    set changed 0
330    foreach curve $args {
331        set pos [lsearch -exact $_clist $curve]
332        if {$pos >= 0} {
333            set _clist [lreplace $_clist $pos $pos]
334            catch {unset _curve2color($curve)}
335            catch {unset _curve2width($curve)}
336            catch {unset _curve2dashes($curve)}
337            catch {unset _curve2raise($curve)}
338            foreach elem [array names _elem2curve] {
339                if {$_elem2curve($elem) == $curve} {
340                    unset _elem2curve($elem)
341                }
342            }
343            set changed 1
344        }
345    }
346
347    # if anything changed, then rebuild the plot
348    if {$changed} {
349        $_dispatcher event -idle !rebuild
350    }
351
352    # nothing left? then start over with auto colors
353    if {[llength $_clist] == 0} {
354        set _autoColorI 0
355    }
356}
357
358# ----------------------------------------------------------------------
359# USAGE: scale ?<curve1> <curve2> ...?
360#
361# Sets the default limits for the overall plot according to the
362# limits of the data for all of the given <curve> objects.  This
363# accounts for all curves--even those not showing on the screen.
364# Because of this, the limits are appropriate for all curves as
365# the user scans through data in the ResultSet viewer.
366# ----------------------------------------------------------------------
367itcl::body Rappture::XyResult::scale {args} {
368    set allx [$itk_component(plot) x2axis use]
369    lappend allx x  ;# fix main x-axis too
370    foreach axis $allx {
371        _axis scale $axis linear
372    }
373
374    set ally [$itk_component(plot) y2axis use]
375    lappend ally y  ;# fix main y-axis too
376    foreach axis $ally {
377        _axis scale $axis linear
378    }
379
380    catch {unset _limits}
381    foreach xydata $args {
382        # find the axes for this curve (e.g., {x y2})
383        foreach {map(x) map(y)} [_getAxes $xydata] break
384
385        foreach axis {x y} {
386            # get defaults for both linear and log scales
387            foreach type {lin log} {
388                # store results -- ex: _limits(x2log-min)
389                set id $map($axis)$type
390                foreach {min max} [$xydata limits $axis$type] break
391                if {"" != $min && "" != $max} {
392                    if {![info exists _limits($id-min)]} {
393                        set _limits($id-min) $min
394                        set _limits($id-max) $max
395                    } else {
396                        if {$min < $_limits($id-min)} {
397                            set _limits($id-min) $min
398                        }
399                        if {$max > $_limits($id-max)} {
400                            set _limits($id-max) $max
401                        }
402                    }
403                }
404            }
405
406            if {[$xydata hints ${axis}scale] == "log"} {
407                _axis scale $map($axis) log
408            }
409        }
410    }
411    _resetLimits
412}
413
414# ----------------------------------------------------------------------
415# USAGE: download
416#
417# Clients use this method to create a downloadable representation
418# of the plot.  Returns a list of the form {ext string}, where
419# "ext" is the file extension (indicating the type of data) and
420# "string" is the data itself.
421# ----------------------------------------------------------------------
422itcl::body Rappture::XyResult::download {} {
423    set psdata [$itk_component(plot) postscript output -maxpect 1]
424
425    set cmds {
426        set fout "xy[pid].pdf"
427        exec ps2pdf - $fout << $psdata
428
429        set fid [open $fout r]
430        fconfigure $fid -translation binary -encoding binary
431        set pdfdata [read $fid]
432        close $fid
433
434        file delete -force $fout
435    }
436    if {[catch $cmds result] == 0} {
437        return [list .pdf $pdfdata]
438    }
439    return [list .ps $psdata]
440}
441
442# ----------------------------------------------------------------------
443# USAGE: _rebuild
444#
445# Called automatically whenever something changes that affects the
446# data in the widget.  Clears any existing data and rebuilds the
447# widget to display new data.
448# ----------------------------------------------------------------------
449itcl::body Rappture::XyResult::_rebuild {} {
450    set g $itk_component(plot)
451
452    # first clear out the widget
453    eval $g element delete [$g element names]
454    foreach axis [$g axis names] {
455        $g axis configure $axis -hide yes
456    }
457    catch {unset _label2axis}
458
459    #
460    # Scan through all objects and create a list of all axes.
461    # The first x-axis gets mapped to "x".  The second, to "x2".
462    # Beyond that, we must create new axes "x3", "x4", etc.
463    # We do the same for y.
464    #
465    set anum(x) 0
466    set anum(y) 0
467    foreach xydata [get] {
468        foreach ax {x y} {
469            set label [$xydata hints ${ax}label]
470            if {"" != $label} {
471                if {![info exists _label2axis($ax-$label)]} {
472                    switch [incr anum($ax)] {
473                        1 { set axis $ax }
474                        2 { set axis ${ax}2 }
475                        default {
476                            set axis $ax$anum($ax)
477                            catch {$g axis create $axis}
478                        }
479                    }
480                    $g axis configure $axis -title $label -hide no
481                    set _label2axis($ax-$label) $axis
482                }
483            }
484        }
485    }
486
487    #
488    # All of the extra axes get mapped to the x2/y2 (top/right)
489    # position.
490    #
491    set all ""
492    foreach ax {x y} {
493        lappend all $ax
494
495        set extra ""
496        for {set i 2} {$i <= $anum($ax)} {incr i} {
497            lappend extra ${ax}$i
498        }
499        eval lappend all $extra
500        $g ${ax}2axis use $extra
501        if {$ax == "y"} {
502            $g configure -rightmargin [expr {($extra == "") ? 10 : 0}]
503        }
504    }
505
506    foreach axis $all {
507        set _axisPopup(format-$axis) "%.3g"
508
509        $g axis bind $axis <Enter> \
510            [itcl::code $this _axis hilite $axis on]
511        $g axis bind $axis <Leave> \
512            [itcl::code $this _axis hilite $axis off]
513        $g axis bind $axis <ButtonPress> \
514            [itcl::code $this _axis click $axis %x %y]
515        $g axis bind $axis <B1-Motion> \
516            [itcl::code $this _axis drag $axis %x %y]
517        $g axis bind $axis <ButtonRelease> \
518            [itcl::code $this _axis release $axis %x %y]
519    }
520
521    #
522    # Plot all of the curves.
523    #
524    set count 0
525    foreach xydata $_clist {
526        set label [$xydata hints label]
527        foreach {mapx mapy} [_getAxes $xydata] break
528
529        foreach comp [$xydata components] {
530            set xv [$xydata mesh $comp]
531            set yv [$xydata values $comp]
532
533            if {[info exists _curve2color($xydata)]} {
534                set color $_curve2color($xydata)
535            } else {
536                set color [$xydata hints color]
537                if {"" == $color} {
538                    set color black
539                }
540            }
541
542            if {[info exists _curve2width($xydata)]} {
543                set lwidth $_curve2width($xydata)
544            } else {
545                set lwidth 2
546            }
547
548            if {[info exists _curve2dashes($xydata)]} {
549                set dashes $_curve2dashes($xydata)
550            } else {
551                set dashes ""
552            }
553
554            if {[$xv length] <= 1} {
555                set sym square
556            } else {
557                set sym ""
558            }
559
560            set elem "elem[incr count]"
561            set _elem2curve($elem) $xydata
562
563            $g element create $elem -x $xv -y $yv \
564                -symbol $sym -pixels 6 -linewidth $lwidth -label $label \
565                -color $color -dashes $dashes \
566                -mapx $mapx -mapy $mapy
567        }
568    }
569}
570
571# ----------------------------------------------------------------------
572# USAGE: _resetLimits
573#
574# Used internally to apply automatic limits to the axes for the
575# current plot.
576# ----------------------------------------------------------------------
577itcl::body Rappture::XyResult::_resetLimits {} {
578    set g $itk_component(plot)
579
580    #
581    # HACK ALERT!
582    # Use this code to fix up the y-axis limits for the BLT graph.
583    # The auto-limits don't always work well.  We want them to be
584    # set to a "nice" number slightly above or below the min/max
585    # limits.
586    #
587    foreach axis [$g axis names] {
588        if {[info exists _limits(${axis}lin-min)]} {
589            set log [$g axis cget $axis -logscale]
590            if {$log} {
591                set min $_limits(${axis}log-min)
592                set max $_limits(${axis}log-max)
593                if {$min == $max} {
594                    set logmin [expr {floor(log10(abs(0.9*$min)))}]
595                    set logmax [expr {ceil(log10(abs(1.1*$max)))}]
596                } else {
597                    set logmin [expr {floor(log10(abs($min)))}]
598                    set logmax [expr {ceil(log10(abs($max)))}]
599                    if {[string match y* $axis]} {
600                        # add a little padding
601                        set delta [expr {$logmax-$logmin}]
602                        set logmin [expr {$logmin-0.05*$delta}]
603                        set logmax [expr {$logmax+0.05*$delta}]
604                    }
605                }
606                if {$logmin < -300} {
607                    set min 1e-300
608                } elseif {$logmin > 300} {
609                    set min 1e+300
610                } else {
611                    set min [expr {pow(10.0,$logmin)}]
612                }
613
614                if {$logmax < -300} {
615                    set max 1e-300
616                } elseif {$logmax > 300} {
617                    set max 1e+300
618                } else {
619                    set max [expr {pow(10.0,$logmax)}]
620                }
621            } else {
622                set min $_limits(${axis}lin-min)
623                set max $_limits(${axis}lin-max)
624
625                if {[string match y* $axis]} {
626                    # add a little padding
627                    set delta [expr {$max-$min}]
628                    set min [expr {$min-0.05*$delta}]
629                    set max [expr {$max+0.05*$delta}]
630                }
631            }
632            if {$min != $max} {
633                $g axis configure $axis -min $min -max $max
634            } else {
635                $g axis configure $axis -min "" -max ""
636            }
637        } else {
638            $g axis configure $axis -min "" -max ""
639        }
640    }
641}
642
643# ----------------------------------------------------------------------
644# USAGE: _zoom reset
645#
646# Called automatically when the user clicks on one of the zoom
647# controls for this widget.  Changes the zoom for the current view.
648# ----------------------------------------------------------------------
649itcl::body Rappture::XyResult::_zoom {option args} {
650    switch -- $option {
651        reset {
652            _resetLimits
653        }
654    }
655}
656
657# ----------------------------------------------------------------------
658# USAGE: _hilite <state> <x> <y>
659#
660# Called automatically when the user brushes one of the elements
661# on the plot.  Causes the element to highlight and a tooltip to
662# pop up with element info.
663# ----------------------------------------------------------------------
664itcl::body Rappture::XyResult::_hilite {state x y} {
665    set g $itk_component(plot)
666    set elem ""
667    if {$state == "at"} {
668        if {[$g element closest $x $y info -interpolate yes]} {
669            set elem $info(name)
670            foreach {mapx mapy} [_getAxes $_elem2curve($elem)] break
671
672            # search again for an exact point -- this time don't interpolate
673            set tip ""
674            if {[$g element closest $x $y info -interpolate no]
675                  && $info(name) == $elem} {
676                set x [$g axis transform $mapx $info(x)]
677                set y [$g axis transform $mapy $info(y)]
678
679                if {[info exists _elem2curve($elem)]} {
680                    set curve $_elem2curve($elem)
681                    set tip [$curve hints tooltip]
682                    if {[info exists info(y)]} {
683                        set val [_axis format y dummy $info(y)]
684                        set units [$curve hints yunits]
685                        append tip "\n$val$units"
686
687                        if {[info exists info(x)]} {
688                            set val [_axis format x dummy $info(x)]
689                            set units [$curve hints xunits]
690                            append tip " @ $val$units"
691                        }
692                    }
693                    set tip [string trim $tip]
694                }
695            }
696            set state 1
697        } else {
698            set state 0
699        }
700    }
701
702    if {$state} {
703        #
704        # Highlight ON:
705        # - activate trace
706        # - multiple axes? dim other axes
707        # - pop up tooltip about data
708        #
709        if {$_hilite(elem) != "" && $_hilite(elem) != $elem} {
710            $g element deactivate $_hilite(elem)
711            $g crosshairs configure -hide yes
712            Rappture::Tooltip::tooltip cancel
713        }
714        $g element activate $elem
715        set _hilite(elem) $elem
716
717        set dlist [$g element show]
718        set i [lsearch -exact $dlist $elem]
719        if {$i >= 0} {
720            set dlist [lreplace $dlist $i $i]
721            lappend dlist $elem
722            $g element show $dlist
723        }
724
725        foreach {mapx mapy} [_getAxes $_elem2curve($elem)] break
726
727        set allx [$g x2axis use]
728        if {[llength $allx] > 0} {
729            lappend allx x  ;# fix main x-axis too
730            foreach axis $allx {
731                if {$axis == $mapx} {
732                    $g axis configure $axis -color $itk_option(-foreground) \
733                        -titlecolor $itk_option(-foreground)
734                } else {
735                    $g axis configure $axis -color $itk_option(-dimcolor) \
736                        -titlecolor $itk_option(-dimcolor)
737                }
738            }
739        }
740        set ally [$g y2axis use]
741        if {[llength $ally] > 0} {
742            lappend ally y  ;# fix main y-axis too
743            foreach axis $ally {
744                if {$axis == $mapy} {
745                    $g axis configure $axis -color $itk_option(-foreground) \
746                        -titlecolor $itk_option(-foreground)
747                } else {
748                    $g axis configure $axis -color $itk_option(-dimcolor) \
749                        -titlecolor $itk_option(-dimcolor)
750                }
751            }
752        }
753
754        if {"" != $tip} {
755            $g crosshairs configure -hide no -position @$x,$y
756
757            if {$x > 0.5*[winfo width $g]} {
758                if {$x < 4} {
759                    set x "-0"
760                } else {
761                    set x "-[expr {$x-4}]"  ;# move tooltip to the left
762                }
763            } else {
764                if {$x < -4} {
765                    set x "+0"
766                } else {
767                    set x "+[expr {$x+4}]"  ;# move tooltip to the right
768                }
769            }
770            if {$y > 0.5*[winfo height $g]} {
771                if {$y < 4} {
772                    set y "-0"
773                } else {
774                    set y "-[expr {$y-4}]"  ;# move tooltip to the top
775                }
776            } else {
777                if {$y < -4} {
778                    set y "+0"
779                } else {
780                    set y "+[expr {$y+4}]"  ;# move tooltip to the bottom
781                }
782            }
783            Rappture::Tooltip::text $g $tip
784            Rappture::Tooltip::tooltip show $g $x,$y
785        }
786    } else {
787        #
788        # Highlight OFF:
789        # - deactivate (color back to normal)
790        # - put all axes back to normal color
791        # - take down tooltip
792        #
793        if {"" != $_hilite(elem)} {
794            $g element deactivate $_hilite(elem)
795
796            set allx [$g x2axis use]
797            if {[llength $allx] > 0} {
798                lappend allx x  ;# fix main x-axis too
799                foreach axis $allx {
800                    $g axis configure $axis -color $itk_option(-foreground) \
801                        -titlecolor $itk_option(-foreground)
802                }
803            }
804
805            set ally [$g y2axis use]
806            if {[llength $ally] > 0} {
807                lappend ally y  ;# fix main y-axis too
808                foreach axis $ally {
809                    $g axis configure $axis -color $itk_option(-foreground) \
810                        -titlecolor $itk_option(-foreground)
811                }
812            }
813        }
814
815        $g crosshairs configure -hide yes
816        Rappture::Tooltip::tooltip cancel
817
818        # there is no currently highlighted element
819        set _hilite(elem) ""
820    }
821}
822
823# ----------------------------------------------------------------------
824# USAGE: _axis hilite <axis> <state>
825#
826# USAGE: _axis click <axis> <x> <y>
827# USAGE: _axis drag <axis> <x> <y>
828# USAGE: _axis release <axis> <x> <y>
829#
830# USAGE: _axis edit <axis>
831# USAGE: _axis changed <axis> <what>
832# USAGE: _axis format <axis> <widget> <value>
833# USAGE: _axis scale <axis> linear|log
834#
835# Used internally to handle editing of the x/y axes.  The hilite
836# operation causes the axis to light up.  The edit operation pops
837# up a panel with editing options.  The changed operation applies
838# changes from the panel.
839# ----------------------------------------------------------------------
840itcl::body Rappture::XyResult::_axis {option args} {
841    set inner [$itk_component(hull).axes component inner].bd
842
843    switch -- $option {
844        hilite {
845            if {[llength $args] != 2} {
846                error "wrong # args: should be \"_axis hilite axis state\""
847            }
848            set axis [lindex $args 0]
849            set state [lindex $args 1]
850
851            if {$state} {
852                $itk_component(plot) axis configure $axis \
853                    -color $itk_option(-activecolor) \
854                    -titlecolor $itk_option(-activecolor)
855            } else {
856                $itk_component(plot) axis configure $axis \
857                    -color $itk_option(-foreground) \
858                    -titlecolor $itk_option(-foreground)
859            }
860        }
861        click {
862            if {[llength $args] != 3} {
863                error "wrong # args: should be \"_axis click axis x y\""
864            }
865            set axis [lindex $args 0]
866            set x [lindex $args 1]
867            set y [lindex $args 2]
868            set g $itk_component(plot)
869
870            set _axis(moved) 0
871            set _axis(click-x) $x
872            set _axis(click-y) $y
873            foreach {min max} [$g axis limits $axis] break
874            set _axis(min0) $min
875            set _axis(max0) $max
876        }
877        drag {
878            if {[llength $args] != 3} {
879                error "wrong # args: should be \"_axis drag axis x y\""
880            }
881            set axis [lindex $args 0]
882            set x [lindex $args 1]
883            set y [lindex $args 2]
884            set g $itk_component(plot)
885
886            if {[info exists _axis(click-x)] && [info exists _axis(click-y)]} {
887                foreach {x0 y0 pw ph} [$g extents plotarea] break
888                switch -glob $axis {
889                  x* {
890                    set pix $x
891                    set pix0 $_axis(click-x)
892                    set pixmin $x0
893                    set pixmax [expr {$x0+$pw}]
894                  }
895                  y* {
896                    set pix $y
897                    set pix0 $_axis(click-y)
898                    set pixmin [expr {$y0+$ph}]
899                    set pixmax $y0
900                  }
901                }
902                set log [$g axis cget $axis -logscale]
903                set min $_axis(min0)
904                set max $_axis(max0)
905                set dpix [expr {abs($pix-$pix0)}]
906                set v0 [$g axis invtransform $axis $pixmin]
907                set v1 [$g axis invtransform $axis [expr {$pixmin+$dpix}]]
908                if {$log} {
909                    set v0 [expr {log10($v0)}]
910                    set v1 [expr {log10($v1)}]
911                    set min [expr {log10($min)}]
912                    set max [expr {log10($max)}]
913                }
914
915                if {$pix > $pix0} {
916                    set delta [expr {$v1-$v0}]
917                } else {
918                    set delta [expr {$v0-$v1}]
919                }
920                set min [expr {$min-$delta}]
921                set max [expr {$max-$delta}]
922                if {$log} {
923                    set min [expr {pow(10.0,$min)}]
924                    set max [expr {pow(10.0,$max)}]
925                }
926                $g axis configure $axis -min $min -max $max
927
928                # move axis, don't edit on release
929                set _axis(move) 1
930            }
931        }
932        release {
933            if {[llength $args] != 3} {
934                error "wrong # args: should be \"_axis release axis x y\""
935            }
936            set axis [lindex $args 0]
937            set x [lindex $args 1]
938            set y [lindex $args 2]
939
940            if {![info exists _axis(moved)] || !$_axis(moved)} {
941                # small movement? then treat as click -- pop up axis editor
942                set dx [expr {abs($x-$_axis(click-x))}]
943                set dy [expr {abs($y-$_axis(click-y))}]
944                if {$dx < 2 && $dy < 2} {
945                    _axis edit $axis
946                }
947            } else {
948                # one last movement
949                _axis drag $axis $x $y
950            }
951            catch {unset _axis}
952        }
953        edit {
954            if {[llength $args] != 1} {
955                error "wrong # args: should be \"_axis edit axis\""
956            }
957            set axis [lindex $args 0]
958            set _axisPopup(current) $axis
959
960            # apply last value when deactivating
961            $itk_component(hull).axes configure -deactivatecommand \
962                [itcl::code $this _axis changed $axis focus]
963
964            # fix axis label controls...
965            set label [$itk_component(plot) axis cget $axis -title]
966            $inner.label delete 0 end
967            $inner.label insert end $label
968            bind $inner.label <KeyPress-Return> \
969                [itcl::code $this _axis changed $axis label]
970            bind $inner.label <FocusOut> \
971                [itcl::code $this _axis changed $axis label]
972
973            # fix min/max controls...
974            foreach {min max} [$itk_component(plot) axis limits $axis] break
975            $inner.min delete 0 end
976            $inner.min insert end $min
977            bind $inner.min <KeyPress-Return> \
978                [itcl::code $this _axis changed $axis min]
979            bind $inner.min <FocusOut> \
980                [itcl::code $this _axis changed $axis min]
981
982            $inner.max delete 0 end
983            $inner.max insert end $max
984            bind $inner.max <KeyPress-Return> \
985                [itcl::code $this _axis changed $axis max]
986            bind $inner.max <FocusOut> \
987                [itcl::code $this _axis changed $axis max]
988
989            # fix format control...
990            set fmts [$inner.format choices get -value]
991            set i [lsearch -exact $fmts $_axisPopup(format-$axis)]
992            if {$i < 0} { set i 0 }  ;# use Auto choice
993            $inner.format value [$inner.format choices get -label $i]
994
995            bind $inner.format <<Value>> \
996                [itcl::code $this _axis changed $axis format]
997
998            # fix scale control...
999            if {[$itk_component(plot) axis cget $axis -logscale]} {
1000                set _axisPopup(scale) "log"
1001                $inner.format configure -state disabled
1002            } else {
1003                set _axisPopup(scale) "linear"
1004                $inner.format configure -state normal
1005            }
1006            $inner.scales.linear configure \
1007                -command [itcl::code $this _axis changed $axis scale]
1008            $inner.scales.log configure \
1009                -command [itcl::code $this _axis changed $axis scale]
1010
1011            #
1012            # Figure out where the window should pop up.
1013            #
1014            set x [winfo rootx $itk_component(plot)]
1015            set y [winfo rooty $itk_component(plot)]
1016            set w [winfo width $itk_component(plot)]
1017            set h [winfo height $itk_component(plot)]
1018            foreach {x0 y0 pw ph} [$itk_component(plot) extents plotarea] break
1019            switch -glob -- $axis {
1020                x {
1021                    set x [expr {round($x + $x0+0.5*$pw)}]
1022                    set y [expr {round($y + $y0+$ph + 0.5*($h-$y0-$ph))}]
1023                    set dir "above"
1024                }
1025                x* {
1026                    set x [expr {round($x + $x0+0.5*$pw)}]
1027                    set dir "below"
1028                    set allx [$itk_component(plot) x2axis use]
1029                    set max [llength $allx]
1030                    set i [lsearch -exact $allx $axis]
1031                    set y [expr {round($y + ($i+0.5)*$y0/double($max))}]
1032                }
1033                y {
1034                    set x [expr {round($x + 0.5*$x0)}]
1035                    set y [expr {round($y + $y0+0.5*$ph)}]
1036                    set dir "right"
1037                }
1038                y* {
1039                    set y [expr {round($y + $y0+0.5*$ph)}]
1040                    set dir "left"
1041                    set ally [$itk_component(plot) y2axis use]
1042                    set max [llength $ally]
1043                    set i [lsearch -exact $ally $axis]
1044                    set y [expr {round($y + ($i+0.5)*$y0/double($max))}]
1045                    set x [expr {round($x+$x0+$pw + ($i+0.5)*($w-$x0-$pw)/double($max))}]
1046                }
1047            }
1048            $itk_component(hull).axes activate @$x,$y $dir
1049        }
1050        changed {
1051            if {[llength $args] != 2} {
1052                error "wrong # args: should be \"_axis changed axis what\""
1053            }
1054            set axis [lindex $args 0]
1055            set what [lindex $args 1]
1056            if {$what == "focus"} {
1057                set what [focus]
1058                if {[winfo exists $what]} {
1059                    set what [winfo name $what]
1060                }
1061            }
1062
1063            switch -- $what {
1064                label {
1065                    set val [$inner.label get]
1066                    $itk_component(plot) axis configure $axis -title $val
1067                }
1068                min {
1069                    set val [$inner.min get]
1070                    if {![string is double -strict $val]} {
1071                        Rappture::Tooltip::cue $inner.min "Must be a number"
1072                        bell
1073                        return
1074                    }
1075
1076                    set max [lindex [$itk_component(plot) axis limits $axis] 1]
1077                    if {$val >= $max} {
1078                        Rappture::Tooltip::cue $inner.min "Must be <= max ($max)"
1079                        bell
1080                        return
1081                    }
1082                    catch {
1083                        # can fail in log mode
1084                        $itk_component(plot) axis configure $axis -min $val
1085                    }
1086                    foreach {min max} [$itk_component(plot) axis limits $axis] break
1087                    $inner.min delete 0 end
1088                    $inner.min insert end $min
1089                }
1090                max {
1091                    set val [$inner.max get]
1092                    if {![string is double -strict $val]} {
1093                        Rappture::Tooltip::cue $inner.max "Should be a number"
1094                        bell
1095                        return
1096                    }
1097
1098                    set min [lindex [$itk_component(plot) axis limits $axis] 0]
1099                    if {$val <= $min} {
1100                        Rappture::Tooltip::cue $inner.max "Must be >= min ($min)"
1101                        bell
1102                        return
1103                    }
1104                    catch {
1105                        # can fail in log mode
1106                        $itk_component(plot) axis configure $axis -max $val
1107                    }
1108                    foreach {min max} [$itk_component(plot) axis limits $axis] break
1109                    $inner.max delete 0 end
1110                    $inner.max insert end $max
1111                }
1112                format {
1113                    set fmt [$inner.format translate [$inner.format value]]
1114                    set _axisPopup(format-$axis) $fmt
1115
1116                    # force a refresh
1117                    $itk_component(plot) axis configure $axis -min \
1118                        [$itk_component(plot) axis cget $axis -min]
1119                }
1120                scale {
1121                    _axis scale $axis $_axisPopup(scale)
1122
1123                    if {$_axisPopup(scale) == "log"} {
1124                        $inner.format configure -state disabled
1125                    } else {
1126                        $inner.format configure -state normal
1127                    }
1128
1129                    foreach {min max} [$itk_component(plot) axis limits $axis] break
1130                    $inner.min delete 0 end
1131                    $inner.min insert end $min
1132                    $inner.max delete 0 end
1133                    $inner.max insert end $max
1134                }
1135                default {
1136                    # be lenient so we can handle the "focus" case
1137                }
1138            }
1139        }
1140        format {
1141            if {[llength $args] != 3} {
1142                error "wrong # args: should be \"_axis format axis widget value\""
1143            }
1144            set axis [lindex $args 0]
1145            set value [lindex $args 2]
1146
1147            if {[$itk_component(plot) axis cget $axis -logscale]} {
1148                set fmt "%.3g"
1149            } else {
1150                set fmt $_axisPopup(format-$axis)
1151            }
1152            return [format $fmt $value]
1153        }
1154        scale {
1155            if {[llength $args] != 2} {
1156                error "wrong # args: should be \"_axis scale axis type\""
1157            }
1158            set axis [lindex $args 0]
1159            set type [lindex $args 1]
1160
1161            if {$type == "log"} {
1162                catch {$itk_component(plot) axis configure $axis -logscale 1}
1163                # leave format alone in log mode
1164                $itk_component(plot) axis configure $axis -command ""
1165            } else {
1166                catch {$itk_component(plot) axis configure $axis -logscale 0}
1167                # use special formatting for linear mode
1168                $itk_component(plot) axis configure $axis -command \
1169                    [itcl::code $this _axis format $axis]
1170            }
1171        }
1172        default {
1173            error "bad option \"$option\": should be changed, edit, hilite, or format"
1174        }
1175    }
1176}
1177
1178# ----------------------------------------------------------------------
1179# USAGE: _getAxes <curveObj>
1180#
1181# Used internally to figure out the axes used to plot the given
1182# <curveObj>.  Returns a list of the form {x y}, where x is the
1183# x-axis name (x, x2, x3, etc.), and y is the y-axis name.
1184# ----------------------------------------------------------------------
1185itcl::body Rappture::XyResult::_getAxes {xydata} {
1186    # rebuild if needed, so we know about the axes
1187    if {[$_dispatcher ispending !rebuild]} {
1188        $_dispatcher cancel !rebuild
1189        $_dispatcher event -now !rebuild
1190    }
1191
1192    # what is the x axis?  x? x2? x3? ...
1193    set xlabel [$xydata hints xlabel]
1194    if {[info exists _label2axis(x-$xlabel)]} {
1195        set mapx $_label2axis(x-$xlabel)
1196    } else {
1197        set mapx "x"
1198    }
1199
1200    # what is the y axis?  y? y2? y3? ...
1201    set ylabel [$xydata hints ylabel]
1202    if {[info exists _label2axis(y-$ylabel)]} {
1203        set mapy $_label2axis(y-$ylabel)
1204    } else {
1205        set mapy "y"
1206    }
1207
1208    return [list $mapx $mapy]
1209}
1210
1211# ----------------------------------------------------------------------
1212# CONFIGURATION OPTION: -gridcolor
1213# ----------------------------------------------------------------------
1214itcl::configbody Rappture::XyResult::gridcolor {
1215    if {"" == $itk_option(-gridcolor)} {
1216        $itk_component(plot) grid off
1217    } else {
1218        $itk_component(plot) grid configure -color $itk_option(-gridcolor)
1219        $itk_component(plot) grid on
1220    }
1221}
1222
1223# ----------------------------------------------------------------------
1224# CONFIGURATION OPTION: -autocolors
1225# ----------------------------------------------------------------------
1226itcl::configbody Rappture::XyResult::autocolors {
1227    foreach c $itk_option(-autocolors) {
1228        if {[catch {winfo rgb $itk_component(hull) $c}]} {
1229            error "bad color \"$c\""
1230        }
1231    }
1232    if {$_autoColorI >= [llength $itk_option(-autocolors)]} {
1233        set _autoColorI 0
1234    }
1235}
Note: See TracBrowser for help on using the repository browser.