source: branches/blt4/gui/scripts/xyresult.tcl @ 1695

Last change on this file since 1695 was 1683, checked in by gah, 15 years ago
File size: 56.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  Purdue Research Foundation
10#
11#  See the file "license.terms" for information on usage and
12#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13# ======================================================================
14package require Itk
15package require BLT
16
17option add *XyResult.width 3i widgetDefault
18option add *XyResult.height 3i widgetDefault
19option add *XyResult.gridColor #d9d9d9 widgetDefault
20option add *XyResult.activeColor blue widgetDefault
21option add *XyResult.dimColor gray widgetDefault
22option add *XyResult.controlBackground gray widgetDefault
23option add *XyResult.font \
24    -*-helvetica-medium-r-normal-*-12-* widgetDefault
25
26set autocolors {
27    #0000ff #ff0000 #00cc00
28    #cc00cc #ff9900 #cccc00
29    #000080 #800000 #006600
30    #660066 #996600 #666600
31}
32set autocolors {
33#0000cd
34#cd0000
35#00cd00
36#3a5fcd
37#cdcd00
38#cd1076
39#009acd
40#00c5cd
41#a2b5cd
42#7ac5cd
43#66cdaa
44#a2cd5a
45#cd9b9b
46#cdba96
47#cd3333
48#cd6600
49#cd8c95
50#cd00cd
51#9a32cd
52#6ca6cd
53#9ac0cd
54#9bcd9b
55#00cd66
56#cdc673
57#cdad00
58#cd5555
59#cd853f
60#cd7054
61#cd5b45
62#cd6889
63#cd69c9
64#551a8b
65}
66
67option add *XyResult.autoColors $autocolors widgetDefault
68option add *XyResult*Balloon*Entry.background white widgetDefault
69
70itcl::class Rappture::XyResult {
71    inherit itk::Widget
72
73    itk_option define -gridcolor gridColor GridColor ""
74    itk_option define -activecolor activeColor ActiveColor ""
75    itk_option define -dimcolor dimColor DimColor ""
76    itk_option define -autocolors autoColors AutoColors ""
77
78    constructor {args} { # defined below }
79    destructor { # defined below }
80
81    public method add {curve {settings ""}}
82    public method get {}
83    public method delete {args}
84    public method scale {args}
85    public method parameters {title args} { # do nothing }
86    public method download {option args}
87
88    protected method _rebuild {}
89    protected method _resetLimits {}
90    protected method _zoom {option args}
91    protected method _hilite {state x y}
92    protected method _axis {option args}
93    protected method _getAxes {curve}
94    protected method _getLineMarkerOptions { style }
95    protected method _getTextMarkerOptions { style }
96    protected method _enterMarker { g name x y text }
97    protected method _leaveMarker { g name }
98
99    private variable _dispatcher "" ;# dispatcher for !events
100    private variable _clist ""     ;# list of curve objects
101    private variable _curve2color  ;# maps curve => plotting color
102    private variable _curve2width  ;# maps curve => line width
103    private variable _curve2dashes ;# maps curve => BLT -dashes list
104    private variable _curve2raise  ;# maps curve => raise flag 0/1
105    private variable _curve2desc   ;# maps curve => description of data
106    private variable _elem2curve   ;# maps graph element => curve
107    private variable _label2axis   ;# maps axis label => axis ID
108    private variable _limits       ;# axis limits:  x-min, x-max, etc.
109    private variable _autoColorI 0 ;# index for next "-color auto"
110
111    private variable _hilite       ;# info for element currently highlighted
112    private variable _axis         ;# info for axis manipulations
113    private variable _axisPopup    ;# info for axis being edited in popup
114    common _downloadPopup          ;# download options from popup
115    private variable _markers
116    private variable cur_ ""
117    private variable initialized_ 0
118}
119                                                                               
120itk::usual XyResult {
121    keep -background -foreground -cursor -font
122}
123
124itk::usual Panedwindow {
125    keep -background -cursor
126}
127
128# ----------------------------------------------------------------------
129# CONSTRUCTOR
130# ----------------------------------------------------------------------
131itcl::body Rappture::XyResult::constructor {args} {
132    Rappture::dispatcher _dispatcher
133    $_dispatcher register !rebuild
134    $_dispatcher dispatch $this !rebuild "[itcl::code $this _rebuild]; list"
135
136    array set _downloadPopup {
137        format csv
138    }
139
140    option add hull.width hull.height
141    pack propagate $itk_component(hull) no
142
143    itk_component add main {
144        Rappture::SidebarFrame $itk_interior.main
145    }
146    pack $itk_component(main) -expand yes -fill both
147    set f [$itk_component(main) component controls]
148
149    itk_component add reset {
150        button $f.reset -borderwidth 1 -padx 1 -pady 1 \
151            -highlightthickness 0 \
152            -image [Rappture::icon reset-view] \
153            -command [itcl::code $this _zoom reset]
154    } {
155        usual
156        ignore -borderwidth -highlightthickness
157    }
158    pack $itk_component(reset) -padx 4 -pady 2 -anchor e
159    Rappture::Tooltip::for $itk_component(reset) \
160        "Reset the view to the default zoom level"
161
162    set f [$itk_component(main) component frame]
163    itk_component add plot {
164        blt::graph $f.plot \
165            -highlightthickness 0 -plotpadx 0 -plotpady 4 \
166            -rightmargin 10
167    } {
168        keep -foreground -cursor -font
169    }
170    pack $itk_component(plot) -expand yes -fill both
171
172    $itk_component(plot) pen configure activeLine \
173        -symbol square -pixels 3 -linewidth 2 \
174        -outline black -fill red -color black
175
176    #
177    # Add bindings so you can mouse over points to see values:
178    #
179    bind $itk_component(plot) <Motion> \
180        [itcl::code $this _hilite at %x %y]
181    bind $itk_component(plot) <Leave> \
182        [itcl::code $this _hilite off %x %y]
183
184    #
185    # Add support for editing axes:
186    #
187    Rappture::Balloon $itk_component(hull).axes -title "Axis Options"
188    set inner [$itk_component(hull).axes component inner]
189
190    label $inner.labell -text "Label:"
191    entry $inner.label -width 15 -highlightbackground $itk_option(-background)
192    grid $inner.labell -row 1 -column 0 -sticky e
193    grid $inner.label -row 1 -column 1 -sticky ew -pady 4
194
195    label $inner.minl -text "Minimum:"
196    entry $inner.min -width 15 -highlightbackground $itk_option(-background)
197    grid $inner.minl -row 2 -column 0 -sticky e
198    grid $inner.min -row 2 -column 1 -sticky ew -pady 4
199
200    label $inner.maxl -text "Maximum:"
201    entry $inner.max -width 15 -highlightbackground $itk_option(-background)
202    grid $inner.maxl -row 3 -column 0 -sticky e
203    grid $inner.max -row 3 -column 1 -sticky ew -pady 4
204
205    label $inner.formatl -text "Format:"
206    Rappture::Combobox $inner.format -width 15 -editable no
207    $inner.format choices insert end \
208        "%.6g"  "Auto"         \
209        "%.0f"  "X"          \
210        "%.1f"  "X.X"          \
211        "%.2f"  "X.XX"         \
212        "%.3f"  "X.XXX"        \
213        "%.6f"  "X.XXXXXX"     \
214        "%.1e"  "X.Xe+XX"      \
215        "%.2e"  "X.XXe+XX"     \
216        "%.3e"  "X.XXXe+XX"    \
217        "%.6e"  "X.XXXXXXe+XX"
218    grid $inner.formatl -row 4 -column 0 -sticky e
219    grid $inner.format -row 4 -column 1 -sticky ew -pady 4
220
221    label $inner.scalel -text "Scale:"
222    frame $inner.scales
223    radiobutton $inner.scales.linear -text "Linear" \
224        -variable [itcl::scope _axisPopup(scale)] -value "linear"
225    pack $inner.scales.linear -side left
226    radiobutton $inner.scales.log -text "Logarithmic" \
227        -variable [itcl::scope _axisPopup(scale)] -value "log"
228    pack $inner.scales.log -side left
229    grid $inner.scalel -row 5 -column 0 -sticky e
230    grid $inner.scales -row 5 -column 1 -sticky ew -pady 4
231
232    foreach axis {x y} {
233        set _axisPopup(format-$axis) "%.6g"
234    }
235    _axis scale x linear
236    _axis scale y linear
237
238    $itk_component(plot) legend configure -hide yes
239
240    #
241    # Add legend for editing hidden/elements:
242    #
243    set inner [$itk_component(main) insert end \
244        -title "Legend" \
245        -icon [Rappture::icon wrench]]
246    $inner configure -borderwidth 4
247
248    itk_component add legend {
249        Rappture::XyLegend $inner.legend $itk_component(plot)
250    }
251    pack $itk_component(legend) -expand yes -fill both
252    after idle [subst {
253        update idletasks
254        $itk_component(legend) reset
255    }]
256
257    # quick-and-dirty zoom functionality, for now...
258    Blt_ZoomStack $itk_component(plot)
259    eval itk_initialize $args
260
261    set _hilite(elem) ""
262}
263
264# ----------------------------------------------------------------------
265# DESTRUCTOR
266# ----------------------------------------------------------------------
267itcl::body Rappture::XyResult::destructor {} {
268}
269
270# ----------------------------------------------------------------------
271# USAGE: add <curve> ?<settings>?
272#
273# Clients use this to add a curve to the plot.  The optional <settings>
274# are used to configure the plot.  Allowed settings are -color,
275# -brightness, -width, -linestyle and -raise.
276# ----------------------------------------------------------------------
277itcl::body Rappture::XyResult::add {curve {settings ""}} {
278    array set params {
279        -color auto
280        -brightness 0
281        -width 1
282        -type "line"
283        -raise 0
284        -linestyle solid
285        -description ""
286        -param ""
287    }
288    foreach {opt val} $settings {
289        if {![info exists params($opt)]} {
290            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
291        }
292        set params($opt) $val
293    }
294
295    # if type is set to "scatter", then override the width
296    if {"scatter" == $params(-type)} {
297        set params(-width) 0
298    }
299
300    # if the color is "auto", then select a color from -autocolors
301    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
302        if {$params(-color) == "autoreset"} {
303            set _autoColorI 0
304        }
305        set color [lindex $itk_option(-autocolors) $_autoColorI]
306        if {"" == $color} { set color black }
307        set params(-color) $color
308
309        # set up for next auto color
310        if {[incr _autoColorI] >= [llength $itk_option(-autocolors)]} {
311            set _autoColorI 0
312        }
313    }
314
315    # convert -linestyle to BLT -dashes
316    switch -- $params(-linestyle) {
317        dashed { set params(-linestyle) {4 4} }
318        dotted { set params(-linestyle) {2 4} }
319        default { set params(-linestyle) {} }
320    }
321
322    # if -brightness is set, then update the color
323    if {$params(-brightness) != 0} {
324        set params(-color) [Rappture::color::brightness \
325            $params(-color) $params(-brightness)]
326
327        set bg [$itk_component(plot) cget -plotbackground]
328        foreach {h s v} [Rappture::color::RGBtoHSV $bg] break
329        if {$v > 0.5} {
330            set params(-color) [Rappture::color::brightness_max \
331                $params(-color) 0.8]
332        } else {
333            set params(-color) [Rappture::color::brightness_min \
334                $params(-color) 0.2]
335        }
336    }
337
338    set pos [lsearch -exact $curve $_clist]
339    if {$pos < 0} {
340        lappend _clist $curve
341        set _curve2color($curve) $params(-color)
342        set _curve2width($curve) $params(-width)
343        set _curve2dashes($curve) $params(-linestyle)
344        set _curve2raise($curve) $params(-raise)
345        set _curve2desc($curve) $params(-description)
346
347        $_dispatcher event -idle !rebuild
348    }
349}
350
351# ----------------------------------------------------------------------
352# USAGE: get
353#
354# Clients use this to query the list of objects being plotted, in
355# order from bottom to top of this result.
356# ----------------------------------------------------------------------
357itcl::body Rappture::XyResult::get {} {
358    # put the dataobj list in order according to -raise options
359    set clist $_clist
360    foreach obj $clist {
361        if {[info exists _curve2raise($obj)] && $_curve2raise($obj)} {
362            set i [lsearch -exact $clist $obj]
363            if {$i >= 0} {
364                set clist [lreplace $clist $i $i]
365                lappend clist $obj
366            }
367        }
368    }
369    return $clist
370}
371
372# ----------------------------------------------------------------------
373# USAGE: delete ?<curve1> <curve2> ...?
374#
375# Clients use this to delete a curve from the plot.  If no curves
376# are specified, then all curves are deleted.
377# ----------------------------------------------------------------------
378itcl::body Rappture::XyResult::delete {args} {
379    if {[llength $args] == 0} {
380        set args $_clist
381    }
382
383    # delete all specified curves
384    set changed 0
385    foreach curve $args {
386        set pos [lsearch -exact $_clist $curve]
387        if {$pos >= 0} {
388            set _clist [lreplace $_clist $pos $pos]
389            catch {unset _curve2color($curve)}
390            catch {unset _curve2width($curve)}
391            catch {unset _curve2dashes($curve)}
392            catch {unset _curve2raise($curve)}
393            foreach elem [array names _elem2curve] {
394                if {$_elem2curve($elem) == $curve} {
395                    unset _elem2curve($elem)
396                }
397            }
398            set changed 1
399        }
400    }
401
402    # If anything changed, then rebuild the plot
403    if {$changed} {
404        $_dispatcher event -idle !rebuild
405    }
406
407    # Nothing left? then start over with auto colors
408    if {[llength $_clist] == 0} {
409        set _autoColorI 0
410    }
411}
412
413# ----------------------------------------------------------------------
414# USAGE: scale ?<curve1> <curve2> ...?
415#
416# Sets the default limits for the overall plot according to the
417# limits of the data for all of the given <curve> objects.  This
418# accounts for all curves--even those not showing on the screen.
419# Because of this, the limits are appropriate for all curves as
420# the user scans through data in the ResultSet viewer.
421# ----------------------------------------------------------------------
422itcl::body Rappture::XyResult::scale {args} {
423    set allx [$itk_component(plot) x2axis use]
424    lappend allx x  ;# fix main x-axis too
425    foreach axis $allx {
426        _axis scale $axis linear
427    }
428
429    set ally [$itk_component(plot) y2axis use]
430    lappend ally y  ;# fix main y-axis too
431    foreach axis $ally {
432        _axis scale $axis linear
433    }
434
435    catch {unset _limits}
436    foreach curve $args {
437        # find the axes for this curve (e.g., {x y2})
438        foreach {map(x) map(y)} [_getAxes $curve] break
439
440        foreach axis {x y} {
441            # get defaults for both linear and log scales
442            foreach type {lin log} {
443                # store results -- ex: _limits(x2log-min)
444                set id $map($axis)$type
445                foreach {min max} [$curve limits $axis$type] break
446                if {"" != $min && "" != $max} {
447                    if {![info exists _limits($id-min)]} {
448                        set _limits($id-min) $min
449                        set _limits($id-max) $max
450                    } else {
451                        if {$min < $_limits($id-min)} {
452                            set _limits($id-min) $min
453                        }
454                        if {$max > $_limits($id-max)} {
455                            set _limits($id-max) $max
456                        }
457                    }
458                }
459            }
460
461            if {[$curve hints ${axis}scale] == "log"} {
462                _axis scale $map($axis) log
463            }
464        }
465    }
466    _resetLimits
467}
468
469# ----------------------------------------------------------------------
470# USAGE: download coming
471# USAGE: download controls <downloadCommand>
472# USAGE: download now
473#
474# Clients use this method to create a downloadable representation
475# of the plot.  Returns a list of the form {ext string}, where
476# "ext" is the file extension (indicating the type of data) and
477# "string" is the data itself.
478# ----------------------------------------------------------------------
479itcl::body Rappture::XyResult::download {option args} {
480    switch $option {
481        coming {
482            # nothing to do
483        }
484        controls {
485            set popup .xyresultdownload
486            if {![winfo exists .xyresultdownload]} {
487                # if we haven't created the popup yet, do it now
488                Rappture::Balloon $popup \
489                    -title "[Rappture::filexfer::label downloadWord] as..."
490                set inner [$popup component inner]
491                label $inner.summary -text "" -anchor w
492                pack $inner.summary -side top
493                radiobutton $inner.csv -text "Data as Comma-Separated Values" \
494                    -variable Rappture::XyResult::_downloadPopup(format) \
495                    -value csv
496                pack $inner.csv -anchor w
497                radiobutton $inner.image -text "Image (PS/PDF/PNG/JPEG)" \
498                    -variable Rappture::XyResult::_downloadPopup(format) \
499                    -value image
500                pack $inner.image -anchor w
501                button $inner.go -text [Rappture::filexfer::label download] \
502                    -command [lindex $args 0]
503                pack $inner.go -pady 4
504            } else {
505                set inner [$popup component inner]
506            }
507            set num [llength [get]]
508            set num [expr {($num == 1) ? "1 result" : "$num results"}]
509            $inner.summary configure -text "[Rappture::filexfer::label downloadWord] $num in the following format:"
510            update idletasks ;# fix initial sizes
511            return $popup
512        }
513        now {
514            set popup .xyresultdownload
515            if {[winfo exists .xyresultdownload]} {
516                $popup deactivate
517            }
518            switch -- $_downloadPopup(format) {
519                csv {
520                    # reverse the objects so the selected data appears on top
521                    set dlist ""
522                    foreach dataobj [get] {
523                        set dlist [linsert $dlist 0 $dataobj]
524                    }
525
526                    # generate the comma-separated value data for these objects
527                    set csvdata ""
528                    foreach dataobj $dlist {
529                        append csvdata "[string repeat - 60]\n"
530                        append csvdata " [$dataobj hints label]\n"
531                        if {[info exists _curve2desc($dataobj)]
532                            && [llength [split $_curve2desc($dataobj) \n]] > 1} {
533                            set indent "for:"
534                            foreach line [split $_curve2desc($dataobj) \n] {
535                                append csvdata " $indent $line\n"
536                                set indent "    "
537                            }
538                        }
539                        append csvdata "[string repeat - 60]\n"
540
541                        append csvdata "[$dataobj hints xlabel], [$dataobj hints ylabel]\n"
542                        set first 1
543                        foreach comp [$dataobj components] {
544                            if {!$first} {
545                                # blank line between components
546                                append csvdata "\n"
547                            }
548                            set xv [$dataobj mesh $comp]
549                            set yv [$dataobj values $comp]
550                            foreach x [$xv range 0 end] y [$yv range 0 end] {
551                                append csvdata [format "%20.15g, %20.15g\n" $x $y]
552                            }
553                            set first 0
554                        }
555                        append csvdata "\n"
556                    }
557                    return [list .txt $csvdata]
558                }
559                image {
560                    set popup .xyprintdownload
561                    if { ![winfo exists $popup] } {
562                        # Create a popup for the print dialog
563                        Rappture::Balloon $popup -title "Save as image..."
564                        set inner [$popup component inner]
565                        # Create the print dialog widget and add it to the
566                        # the balloon popup.
567                        Rappture::XyPrint $inner.print
568                        $popup configure \
569                            -deactivatecommand [list $inner.print reset]
570                        blt::table $inner 0,0 $inner.print -fill both
571                    }
572                    update
573                    # Activate the popup and call for the output.
574                    foreach { widget toolName plotName } $args break
575                    $popup activate $widget left
576                    set inner [$popup component inner]
577                    set output [$inner.print print $itk_component(plot) \
578                                    $toolName $plotName]
579                    $popup deactivate
580                    return $output
581                }
582            }
583        }
584        default {
585            error "bad option \"$option\": should be coming, controls, now"
586        }
587    }
588}
589
590# ----------------------------------------------------------------------
591# USAGE: _rebuild
592#
593# Called automatically whenever something changes that affects the
594# data in the widget.  Clears any existing data and rebuilds the
595# widget to display new data.
596# ----------------------------------------------------------------------
597itcl::body Rappture::XyResult::_rebuild {} {
598    set g $itk_component(plot)
599
600    # first clear out the widget
601    eval $g element delete [$g element names]
602    foreach axis [$g axis names] {
603        $g axis configure $axis -hide yes -checklimits no \
604            -activeforeground blue
605    }
606    # Presumably you want at least an X-axis and Y-axis displayed.
607    $g xaxis configure -hide no
608    $g yaxis configure -hide no
609    catch {unset _label2axis}
610
611    #
612    # Scan through all objects and create a list of all axes.
613    # The first x-axis gets mapped to "x".  The second, to "x2".
614    # Beyond that, we must create new axes "x3", "x4", etc.
615    # We do the same for y.
616    #
617    set anum(x) 0
618    set anum(y) 0
619    foreach curve [get] {
620        foreach ax {x y} {
621            set label [$curve hints ${ax}label]
622            if {"" != $label} {
623                if {![info exists _label2axis($ax-$label)]} {
624                    switch [incr anum($ax)] {
625                        1 { set axis $ax }
626                        2 { set axis ${ax}2 }
627                        default {
628                            set axis $ax$anum($ax)
629                            catch {$g axis create $axis}
630                        }
631                    }
632                    $g axis configure $axis -title $label -hide no \
633                        -checklimits no
634                    set _label2axis($ax-$label) $axis
635
636                    # if this axis has a description, add it as a tooltip
637                    set desc [string trim [$curve hints ${ax}desc]]
638                    Rappture::Tooltip::text $g-$axis $desc
639                }
640            }
641        }
642    }
643
644    #
645    # All of the extra axes get mapped to the x2/y2 (top/right)
646    # position.
647    #
648    set all ""
649    foreach ax {x y} {
650        lappend all $ax
651
652        set extra ""
653        for {set i 2} {$i <= $anum($ax)} {incr i} {
654            lappend extra ${ax}$i
655        }
656        eval lappend all $extra
657        $g ${ax}2axis use $extra
658        if {$ax == "y"} {
659            $g configure -rightmargin [expr {($extra == "") ? 10 : 0}]
660        }
661    }
662
663    foreach axis $all {
664        set _axisPopup(format-$axis) "%.6g"
665
666        $g axis bind $axis <Enter> \
667            [itcl::code $this _axis hilite $axis on]
668        $g axis bind $axis <Leave> \
669            [itcl::code $this _axis hilite $axis off]
670        $g axis bind $axis <ButtonPress-1> \
671            [itcl::code $this _axis click $axis %x %y]
672        $g axis bind $axis <B1-Motion> \
673            [itcl::code $this _axis drag $axis %x %y]
674        $g axis bind $axis <ButtonRelease-1> \
675            [itcl::code $this _axis release $axis %x %y]
676        $g axis bind $axis <KeyPress> \
677            [list ::Rappture::Tooltip::tooltip cancel]
678    }
679
680    #
681    # Plot all of the curves.
682    #
683    set count 0
684    foreach curve $_clist {
685        set label [$curve hints label]
686        foreach {mapx mapy} [_getAxes $curve] break
687
688        foreach comp [$curve components] {
689            set xv [$curve mesh $comp]
690            set yv [$curve values $comp]
691
692            if {[info exists _curve2color($curve)]} {
693                set color $_curve2color($curve)
694            } else {
695                set color [$curve hints color]
696                if {"" == $color} {
697                    set color black
698                }
699            }
700
701            if {[info exists _curve2width($curve)]} {
702                set lwidth $_curve2width($curve)
703            } else {
704                set lwidth 2
705            }
706
707            if {[info exists _curve2dashes($curve)]} {
708                set dashes $_curve2dashes($curve)
709            } else {
710                set dashes ""
711            }
712
713            if {([$xv length] <= 1) || ($lwidth == 0)} {
714                set sym square
715                set pixels 2
716            } else {
717                set sym ""
718                set pixels 6
719            }
720
721            set elem "elem[incr count]"
722            set _elem2curve($elem) $curve
723            lappend label2elem($label) $elem
724            $g element create $elem -x $xv -y $yv \
725                -symbol $sym -pixels $pixels -linewidth $lwidth \
726                -label $label \
727                -color $color -dashes $dashes \
728                -mapx $mapx -mapy $mapy
729        }
730    }
731
732    # Fix duplicate labels by appending the simulation number
733    foreach label [array names label2elem] {
734        if { [llength $label2elem($label)] == 1 } {
735            continue
736        }
737        foreach elem $label2elem($label) {
738            set curve $_elem2curve($elem)
739            scan [$curve hints xmlobj] "::libraryObj%d" suffix
740            incr suffix
741            set elabel [format "%s \#%d" $label $suffix]
742            $g element configure $elem -label $elabel
743        }
744    }       
745
746    foreach curve $_clist {
747        set xmin -Inf
748        set ymin -Inf
749        set xmax Inf
750        set ymax Inf
751        #
752        # Create text/line markers for each *axis.marker specified.
753        #
754        foreach m [$curve xmarkers] {
755            foreach {at label style} $m break
756            set id [$g marker create line -coords [list $at $ymin $at $ymax]]
757            $g marker bind $id <Enter> \
758                [itcl::code $this _enterMarker $g x-$label $at $ymin $at]
759            $g marker bind $id <Leave> \
760                [itcl::code $this _leaveMarker $g x-$label]
761            set options [_getLineMarkerOptions $style]
762            if { $options != "" } {
763                eval $g marker configure $id $options
764            }
765            if { $label != "" } {
766                set id [$g marker create text -anchor nw \
767                            -text $label -coords [list $at $ymax]]
768                set options [_getTextMarkerOptions $style]
769                if { $options != "" } {
770                    eval $g marker configure $id $options
771                }
772            }
773        }
774        foreach m [$curve ymarkers] {
775            foreach {at label style} $m break
776            set id [$g marker create line -coords [list $xmin $at $xmax $at]]
777            $g marker bind $id <Enter> \
778                [itcl::code $this _enterMarker $g y-$label $at $xmin $at]
779            $g marker bind $id <Leave> \
780                [itcl::code $this _leaveMarker $g y-$label]
781            set options [_getLineMarkerOptions $style]
782            if { $options != "" } {
783                eval $g marker configure $id $options
784            }
785            if { $label != "" } {
786                set id [$g marker create text -anchor se \
787                        -text $label -coords [list $xmax $at]]
788                set options [_getTextMarkerOptions $style]
789                if { $options != "" } {
790                    eval $g marker configure $id $options
791                }
792            }
793        }
794    }
795    $itk_component(legend) reset
796}
797
798# ----------------------------------------------------------------------
799# USAGE: _resetLimits
800#
801# Used internally to apply automatic limits to the axes for the
802# current plot.
803# ----------------------------------------------------------------------
804itcl::body Rappture::XyResult::_resetLimits {} {
805    set g $itk_component(plot)
806
807    #
808    # HACK ALERT!
809    # Use this code to fix up the y-axis limits for the BLT graph.
810    # The auto-limits don't always work well.  We want them to be
811    # set to a "nice" number slightly above or below the min/max
812    # limits.
813    #
814    foreach axis [$g axis names] {
815        if {[info exists _limits(${axis}lin-min)]} {
816            set log [$g axis cget $axis -logscale]
817            if {$log} {
818                set min $_limits(${axis}log-min)
819                if {$min == 0} { set min 1 }
820                set max $_limits(${axis}log-max)
821                if {$max == 0} { set max 1 }
822
823                if {$min == $max} {
824                    set logmin [expr {floor(log10(abs(0.9*$min)))}]
825                    set logmax [expr {ceil(log10(abs(1.1*$max)))}]
826                } else {
827                    set logmin [expr {floor(log10(abs($min)))}]
828                    set logmax [expr {ceil(log10(abs($max)))}]
829                    if 0 {
830                    if {[string match y* $axis]} {
831                        # add a little padding
832                        set delta [expr {$logmax-$logmin}]
833                        if {$delta == 0} { set delta 1 }
834                        set logmin [expr {$logmin-0.05*$delta}]
835                        set logmax [expr {$logmax+0.05*$delta}]
836                    }
837                    }
838                }
839                if {$logmin < -300} {
840                    set min 1e-300
841                } elseif {$logmin > 300} {
842                    set min 1e+300
843                } else {
844                    set min [expr {pow(10.0,$logmin)}]
845                }
846
847                if {$logmax < -300} {
848                    set max 1e-300
849                } elseif {$logmax > 300} {
850                    set max 1e+300
851                } else {
852                    set max [expr {pow(10.0,$logmax)}]
853                }
854            } else {
855                set min $_limits(${axis}lin-min)
856                set max $_limits(${axis}lin-max)
857
858                if 0 {
859                if {[string match y* $axis]} {
860                    # add a little padding
861                    set delta [expr {$max-$min}]
862                    set min [expr {$min-0.05*$delta}]
863                    set max [expr {$max+0.05*$delta}]
864                }
865                }
866            }
867            if {$min < $max} {
868                $g axis configure $axis -min $min -max $max
869            } else {
870                $g axis configure $axis -min "" -max ""
871            }
872        } else {
873            $g axis configure $axis -min "" -max ""
874        }
875    }
876}
877
878# ----------------------------------------------------------------------
879# USAGE: _zoom reset
880#
881# Called automatically when the user clicks on one of the zoom
882# controls for this widget.  Changes the zoom for the current view.
883# ----------------------------------------------------------------------
884itcl::body Rappture::XyResult::_zoom {option args} {
885    switch -- $option {
886        reset {
887            _resetLimits
888        }
889    }
890}
891
892# ----------------------------------------------------------------------
893# USAGE: _hilite <state> <x> <y>
894#
895# Called automatically when the user brushes one of the elements
896# on the plot.  Causes the element to highlight and a tooltip to
897# pop up with element info.
898# ----------------------------------------------------------------------
899itcl::body Rappture::XyResult::_hilite {state x y} {
900    set g $itk_component(plot)
901    set elem ""
902 
903    # Peek inside of Blt_ZoomStack package to see if we're currently in the
904    # middle of a zoom selection.
905    if {[info exists ::zoomInfo($g,corner)] && $::zoomInfo($g,corner) == "B" } {
906        return;
907    }
908    set tip ""
909    if {$state == "at"} {
910        set results [$g element closest $x $y -interpolate yes]
911        if { $results != "" } {
912            array set info $results
913            # for dealing with xy line plots
914            set elem $info(name)
915
916            # Some elements are generated dynamically and therefore will
917            # not have a curve object associated with them.
918            set mapx [$g element cget $elem -mapx]
919            set mapy [$g element cget $elem -mapy]
920            if {[info exists _elem2curve($elem)]} {
921                foreach {mapx mapy} [_getAxes $_elem2curve($elem)] break
922            }
923
924            # search again for an exact point -- this time don't interpolate
925            set tip ""
926            array unset info
927            set results [$g element closest $x $y -interpolate no]
928            array set info $results
929            if { [info exists info(name)] && $info(name) == $elem } {
930
931                set x [$g axis transform $mapx $info(x)]
932                set y [$g axis transform $mapy $info(y)]
933               
934                if {[info exists _elem2curve($elem)]} {
935                    set curve $_elem2curve($elem)
936                    set yunits [$curve hints yunits]
937                    set xunits [$curve hints xunits]
938                } else {
939                    set xunits ""
940                    set yunits ""
941                }
942                set tip [$g element cget $elem -label]
943                set yval [_axis format y dummy $info(y)]
944                append tip "\n$yval$yunits"
945                set xval [_axis format x dummy $info(x)]
946                append tip " @ $xval$xunits"
947                set tip [string trim $tip]
948            }
949            set state 1
950        } else {
951            set results [$g element closest $x $y -interpolate no]
952            if { $results != ""  } {
953                array unset info
954                array set info $results
955                # for dealing with xy scatter plot
956                set elem $info(name)
957               
958                # Some elements are generated dynamically and therefore will
959                # not have a curve object associated with them.
960                set mapx [$g element cget $elem -mapx]
961                set mapy [$g element cget $elem -mapy]
962                if {[info exists _elem2curve($elem)]} {
963                    foreach {mapx mapy} [_getAxes $_elem2curve($elem)] break
964                }
965               
966                set tip ""
967                set x [$g axis transform $mapx $info(x)]
968                set y [$g axis transform $mapy $info(y)]
969               
970                if {[info exists _elem2curve($elem)]} {
971                    set curve $_elem2curve($elem)
972                    set yunits [$curve hints yunits]
973                    set xunits [$curve hints xunits]
974                } else {
975                    set xunits ""
976                    set yunits ""
977                }
978                set tip [$g element cget $elem -label]
979                set yval [_axis format y dummy $info(y)]
980                append tip "\n$yval$yunits"
981                set xval [_axis format x dummy $info(x)]
982                append tip " @ $xval$xunits"
983                set tip [string trim $tip]
984                set state 1
985            } else {
986                set state 0
987            }
988        }
989    }
990
991    if {$state} {
992        #
993        # Highlight ON:
994        # - activate trace
995        # - multiple axes? dim other axes
996        # - pop up tooltip about data
997        #
998        if { [$g element exists $_hilite(elem)] && $_hilite(elem) != $elem } {
999            $g element deactivate $_hilite(elem)
1000            $g crosshairs configure -hide yes
1001            Rappture::Tooltip::tooltip cancel
1002        }
1003        $g element activate $elem
1004        set _hilite(elem) $elem
1005
1006        set mapx [$g element cget $elem -mapx]
1007        set mapy [$g element cget $elem -mapy]
1008        if {[info exists _elem2curve($elem)]} {
1009            foreach {mapx mapy} [_getAxes $_elem2curve($elem)] break
1010        }
1011        set allx [$g x2axis use]
1012        if {[llength $allx] > 0} {
1013            lappend allx x  ;# fix main x-axis too
1014            foreach axis $allx {
1015                if {$axis == $mapx} {
1016                    $g axis configure $axis -color $itk_option(-foreground) \
1017                        -titlecolor $itk_option(-foreground)
1018                } else {
1019                    $g axis configure $axis -color $itk_option(-dimcolor) \
1020                        -titlecolor $itk_option(-dimcolor)
1021                }
1022            }
1023        }
1024        set ally [$g y2axis use]
1025        if {[llength $ally] > 0} {
1026            lappend ally y  ;# fix main y-axis too
1027            foreach axis $ally {
1028                if {$axis == $mapy} {
1029                    $g axis configure $axis -color $itk_option(-foreground) \
1030                        -titlecolor $itk_option(-foreground)
1031                } else {
1032                    $g axis configure $axis -color $itk_option(-dimcolor) \
1033                        -titlecolor $itk_option(-dimcolor)
1034                }
1035            }
1036        }
1037
1038        if {"" != $tip} {
1039            $g crosshairs configure -hide no -position @$x,$y
1040
1041            if {$x > 0.5*[winfo width $g]} {
1042                if {$x < 4} {
1043                    set tipx "-0"
1044                } else {
1045                    set tipx "-[expr {$x-4}]"  ;# move tooltip to the left
1046                }
1047            } else {
1048                if {$x < -4} {
1049                    set tipx "+0"
1050                } else {
1051                    set tipx "+[expr {$x+4}]"  ;# move tooltip to the right
1052                }
1053            }
1054            if {$y > 0.5*[winfo height $g]} {
1055                if {$y < 4} {
1056                    set tipy "-0"
1057                } else {
1058                    set tipy "-[expr {$y-4}]"  ;# move tooltip to the top
1059                }
1060            } else {
1061                if {$y < -4} {
1062                    set tipy "+0"
1063                } else {
1064                    set tipy "+[expr {$y+4}]"  ;# move tooltip to the bottom
1065                }
1066            }
1067            Rappture::Tooltip::text $g $tip
1068            Rappture::Tooltip::tooltip show $g $tipx,$tipy
1069        }
1070    } else {
1071        #
1072        # Highlight OFF:
1073        # - deactivate (color back to normal)
1074        # - put all axes back to normal color
1075        # - take down tooltip
1076        #
1077        if { [$g element exists $_hilite(elem)] } {
1078            $g element deactivate $_hilite(elem)
1079        }
1080        set allx [$g x2axis use]
1081        if {[llength $allx] > 0} {
1082            lappend allx x  ;# fix main x-axis too
1083            foreach axis $allx {
1084                $g axis configure $axis -color $itk_option(-foreground) \
1085                    -titlecolor $itk_option(-foreground)
1086            }
1087        }
1088       
1089        set ally [$g y2axis use]
1090        if {[llength $ally] > 0} {
1091            lappend ally y  ;# fix main y-axis too
1092            foreach axis $ally {
1093                $g axis configure $axis -color $itk_option(-foreground) \
1094                    -titlecolor $itk_option(-foreground)
1095            }
1096        }
1097
1098        $g crosshairs configure -hide yes
1099
1100        # only cancel in plotting area or we'll mess up axes
1101        if {[$g inside $x $y]} {
1102            Rappture::Tooltip::tooltip cancel
1103        }
1104
1105        # There is no currently highlighted element
1106        set _hilite(elem) ""
1107    }
1108}
1109
1110# ----------------------------------------------------------------------
1111# USAGE: _axis hilite <axis> <state>
1112#
1113# USAGE: _axis click <axis> <x> <y>
1114# USAGE: _axis drag <axis> <x> <y>
1115# USAGE: _axis release <axis> <x> <y>
1116#
1117# USAGE: _axis edit <axis>
1118# USAGE: _axis changed <axis> <what>
1119# USAGE: _axis format <axis> <widget> <value>
1120# USAGE: _axis scale <axis> linear|log
1121#
1122# Used internally to handle editing of the x/y axes.  The hilite
1123# operation causes the axis to light up.  The edit operation pops
1124# up a panel with editing options.  The changed operation applies
1125# changes from the panel.
1126# ----------------------------------------------------------------------
1127itcl::body Rappture::XyResult::_axis {option args} {
1128    set inner [$itk_component(hull).axes component inner]
1129    switch -- $option {
1130        hilite {
1131            if {[llength $args] != 2} {
1132                error "wrong # args: should be \"_axis hilite axis state\""
1133            }
1134            set g $itk_component(plot)
1135            set axis [lindex $args 0]
1136            set state [lindex $args 1]
1137
1138            if {$state} {
1139                $g axis activate $axis
1140                update
1141                set x [expr {[winfo pointerx $g]+4}]
1142                set y [expr {[winfo pointery $g]+4}]
1143                Rappture::Tooltip::tooltip pending $g-$axis @$x,$y
1144            } else {
1145                $g axis deactivate $axis
1146                update
1147                Rappture::Tooltip::tooltip cancel
1148            }
1149        }
1150        click {
1151            if {[llength $args] != 3} {
1152                error "wrong # args: should be \"_axis click axis x y\""
1153            }
1154            set axis [lindex $args 0]
1155            set x [lindex $args 1]
1156            set y [lindex $args 2]
1157            set g $itk_component(plot)
1158
1159            set _axis(moved) 0
1160            set _axis(click-x) $x
1161            set _axis(click-y) $y
1162            foreach {min max} [$g axis limits $axis] break
1163            set _axis(min0) $min
1164            set _axis(max0) $max
1165            Rappture::Tooltip::tooltip cancel
1166        }
1167        drag {
1168            if {[llength $args] != 3} {
1169                error "wrong # args: should be \"_axis drag axis x y\""
1170            }
1171            if {![info exists _axis(moved)]} {
1172                return  ;# must have skipped click event -- ignore
1173            }
1174            set axis [lindex $args 0]
1175            set x [lindex $args 1]
1176            set y [lindex $args 2]
1177            set g $itk_component(plot)
1178
1179            if {[info exists _axis(click-x)] && [info exists _axis(click-y)]} {
1180                foreach {x0 y0 pw ph} [$g extents plotarea] break
1181                switch -glob $axis {
1182                  x* {
1183                    set pix $x
1184                    set pix0 $_axis(click-x)
1185                    set pixmin $x0
1186                    set pixmax [expr {$x0+$pw}]
1187                  }
1188                  y* {
1189                    set pix $y
1190                    set pix0 $_axis(click-y)
1191                    set pixmin [expr {$y0+$ph}]
1192                    set pixmax $y0
1193                  }
1194                }
1195                set log [$g axis cget $axis -logscale]
1196                set min $_axis(min0)
1197                set max $_axis(max0)
1198                set dpix [expr {abs($pix-$pix0)}]
1199                set v0 [$g axis invtransform $axis $pixmin]
1200                set v1 [$g axis invtransform $axis [expr {$pixmin+$dpix}]]
1201                if {$log} {
1202                    set v0 [expr {log10($v0)}]
1203                    set v1 [expr {log10($v1)}]
1204                    set min [expr {log10($min)}]
1205                    set max [expr {log10($max)}]
1206                }
1207
1208                if {$pix > $pix0} {
1209                    set delta [expr {$v1-$v0}]
1210                } else {
1211                    set delta [expr {$v0-$v1}]
1212                }
1213                set min [expr {$min-$delta}]
1214                set max [expr {$max-$delta}]
1215                if {$log} {
1216                    set min [expr {pow(10.0,$min)}]
1217                    set max [expr {pow(10.0,$max)}]
1218                }
1219                $g axis configure $axis -min $min -max $max
1220
1221                # move axis, don't edit on release
1222                set _axis(move) 1
1223            }
1224        }
1225        release {
1226            if {[llength $args] != 3} {
1227                error "wrong # args: should be \"_axis release axis x y\""
1228            }
1229            if {![info exists _axis(moved)]} {
1230                return  ;# must have skipped click event -- ignore
1231            }
1232            set axis [lindex $args 0]
1233            set x [lindex $args 1]
1234            set y [lindex $args 2]
1235
1236            if {!$_axis(moved)} {
1237                # small movement? then treat as click -- pop up axis editor
1238                set dx [expr {abs($x-$_axis(click-x))}]
1239                set dy [expr {abs($y-$_axis(click-y))}]
1240                if {$dx < 2 && $dy < 2} {
1241                    _axis edit $axis
1242                }
1243            } else {
1244                # one last movement
1245                _axis drag $axis $x $y
1246            }
1247            catch {unset _axis}
1248        }
1249        edit {
1250            if {[llength $args] != 1} {
1251                error "wrong # args: should be \"_axis edit axis\""
1252            }
1253            set axis [lindex $args 0]
1254            set _axisPopup(current) $axis
1255
1256            # apply last value when deactivating
1257            $itk_component(hull).axes configure -deactivatecommand \
1258                [itcl::code $this _axis changed $axis focus]
1259
1260            # fix axis label controls...
1261            set label [$itk_component(plot) axis cget $axis -title]
1262            $inner.label delete 0 end
1263            $inner.label insert end $label
1264            bind $inner.label <KeyPress-Return> \
1265                [itcl::code $this _axis changed $axis label]
1266            bind $inner.label <FocusOut> \
1267                [itcl::code $this _axis changed $axis label]
1268
1269            # fix min/max controls...
1270            foreach {min max} [$itk_component(plot) axis limits $axis] break
1271            $inner.min delete 0 end
1272            $inner.min insert end $min
1273            bind $inner.min <KeyPress-Return> \
1274                [itcl::code $this _axis changed $axis min]
1275            bind $inner.min <FocusOut> \
1276                [itcl::code $this _axis changed $axis min]
1277
1278            $inner.max delete 0 end
1279            $inner.max insert end $max
1280            bind $inner.max <KeyPress-Return> \
1281                [itcl::code $this _axis changed $axis max]
1282            bind $inner.max <FocusOut> \
1283                [itcl::code $this _axis changed $axis max]
1284
1285            # fix format control...
1286            set fmts [$inner.format choices get -value]
1287            set i [lsearch -exact $fmts $_axisPopup(format-$axis)]
1288            if {$i < 0} { set i 0 }  ;# use Auto choice
1289            $inner.format value [$inner.format choices get -label $i]
1290
1291            bind $inner.format <<Value>> \
1292                [itcl::code $this _axis changed $axis format]
1293
1294            # fix scale control...
1295            if {[$itk_component(plot) axis cget $axis -logscale]} {
1296                set _axisPopup(scale) "log"
1297                $inner.format configure -state disabled
1298            } else {
1299                set _axisPopup(scale) "linear"
1300                $inner.format configure -state normal
1301            }
1302            $inner.scales.linear configure \
1303                -command [itcl::code $this _axis changed $axis scale]
1304            $inner.scales.log configure \
1305                -command [itcl::code $this _axis changed $axis scale]
1306
1307            #
1308            # Figure out where the window should pop up.
1309            #
1310            set x [winfo rootx $itk_component(plot)]
1311            set y [winfo rooty $itk_component(plot)]
1312            set w [winfo width $itk_component(plot)]
1313            set h [winfo height $itk_component(plot)]
1314            foreach {x0 y0 pw ph} [$itk_component(plot) extents plotarea] break
1315            switch -glob -- $axis {
1316                x {
1317                    set x [expr {round($x + $x0+0.5*$pw)}]
1318                    set y [expr {round($y + $y0+$ph + 0.5*($h-$y0-$ph))}]
1319                    set dir "above"
1320                }
1321                x* {
1322                    set x [expr {round($x + $x0+0.5*$pw)}]
1323                    set dir "below"
1324                    set allx [$itk_component(plot) x2axis use]
1325                    set max [llength $allx]
1326                    set i [lsearch -exact $allx $axis]
1327                    set y [expr {round($y + ($i+0.5)*$y0/double($max))}]
1328                }
1329                y {
1330                    set x [expr {round($x + 0.5*$x0)}]
1331                    set y [expr {round($y + $y0+0.5*$ph)}]
1332                    set dir "right"
1333                }
1334                y* {
1335                    set y [expr {round($y + $y0+0.5*$ph)}]
1336                    set dir "left"
1337                    set ally [$itk_component(plot) y2axis use]
1338                    set max [llength $ally]
1339                    set i [lsearch -exact $ally $axis]
1340                    set y [expr {round($y + ($i+0.5)*$y0/double($max))}]
1341                    set x [expr {round($x+$x0+$pw + ($i+0.5)*($w-$x0-$pw)/double($max))}]
1342                }
1343            }
1344            $itk_component(hull).axes activate @$x,$y $dir
1345        }
1346        changed {
1347            if {[llength $args] != 2} {
1348                error "wrong # args: should be \"_axis changed axis what\""
1349            }
1350            set axis [lindex $args 0]
1351            set what [lindex $args 1]
1352            if {$what == "focus"} {
1353                set what [focus]
1354                if {[winfo exists $what]} {
1355                    set what [winfo name $what]
1356                }
1357            }
1358
1359            switch -- $what {
1360                label {
1361                    set val [$inner.label get]
1362                    $itk_component(plot) axis configure $axis -title $val
1363                }
1364                min {
1365                    set val [$inner.min get]
1366                    if {![string is double -strict $val]} {
1367                        Rappture::Tooltip::cue $inner.min "Must be a number"
1368                        bell
1369                        return
1370                    }
1371
1372                    set max [lindex [$itk_component(plot) axis limits $axis] 1]
1373                    if {$val >= $max} {
1374                        Rappture::Tooltip::cue $inner.min "Must be <= max ($max)"
1375                        bell
1376                        return
1377                    }
1378                    catch {
1379                        # can fail in log mode
1380                        $itk_component(plot) axis configure $axis -min $val
1381                    }
1382                    foreach {min max} [$itk_component(plot) axis limits $axis] break
1383                    $inner.min delete 0 end
1384                    $inner.min insert end $min
1385                }
1386                max {
1387                    set val [$inner.max get]
1388                    if {![string is double -strict $val]} {
1389                        Rappture::Tooltip::cue $inner.max "Should be a number"
1390                        bell
1391                        return
1392                    }
1393
1394                    set min [lindex [$itk_component(plot) axis limits $axis] 0]
1395                    if {$val <= $min} {
1396                        Rappture::Tooltip::cue $inner.max "Must be >= min ($min)"
1397                        bell
1398                        return
1399                    }
1400                    catch {
1401                        # can fail in log mode
1402                        $itk_component(plot) axis configure $axis -max $val
1403                    }
1404                    foreach {min max} [$itk_component(plot) axis limits $axis] break
1405                    $inner.max delete 0 end
1406                    $inner.max insert end $max
1407                }
1408                format {
1409                    set fmt [$inner.format translate [$inner.format value]]
1410                    set _axisPopup(format-$axis) $fmt
1411
1412                    # force a refresh
1413                    $itk_component(plot) axis configure $axis -min \
1414                        [$itk_component(plot) axis cget $axis -min]
1415                }
1416                scale {
1417                    _axis scale $axis $_axisPopup(scale)
1418
1419                    if {$_axisPopup(scale) == "log"} {
1420                        $inner.format configure -state disabled
1421                    } else {
1422                        $inner.format configure -state normal
1423                    }
1424
1425                    foreach {min max} [$itk_component(plot) axis limits $axis] break
1426                    $inner.min delete 0 end
1427                    $inner.min insert end $min
1428                    $inner.max delete 0 end
1429                    $inner.max insert end $max
1430                }
1431                default {
1432                    # be lenient so we can handle the "focus" case
1433                }
1434            }
1435        }
1436        format {
1437            if {[llength $args] != 3} {
1438                error "wrong # args: should be \"_axis format axis widget value\""
1439            }
1440            set axis [lindex $args 0]
1441            set value [lindex $args 2]
1442
1443            if {[$itk_component(plot) axis cget $axis -logscale]} {
1444                set fmt "%.6g"
1445            } else {
1446                set fmt $_axisPopup(format-$axis)
1447            }
1448            return [format $fmt $value]
1449        }
1450        scale {
1451            if {[llength $args] != 2} {
1452                error "wrong # args: should be \"_axis scale axis type\""
1453            }
1454            set axis [lindex $args 0]
1455            set type [lindex $args 1]
1456
1457            if {$type == "log"} {
1458                catch {$itk_component(plot) axis configure $axis -logscale 1}
1459                # leave format alone in log mode
1460                $itk_component(plot) axis configure $axis -command ""
1461            } else {
1462                catch {$itk_component(plot) axis configure $axis -logscale 0}
1463                # use special formatting for linear mode
1464                $itk_component(plot) axis configure $axis -command \
1465                    [itcl::code $this _axis format $axis]
1466            }
1467        }
1468        default {
1469            error "bad option \"$option\": should be changed, edit, hilite, or format"
1470        }
1471    }
1472}
1473
1474
1475# ----------------------------------------------------------------------
1476# USAGE: _getLineMarkerOptions <style>
1477#
1478# Used internally to create a list of configuration options specific to the
1479# axis line marker.  The input is a list of name value pairs.  Options that
1480# are not recognized are ignored.
1481# ----------------------------------------------------------------------
1482itcl::body Rappture::XyResult::_getLineMarkerOptions {style} {
1483    array set lineOptions {
1484        "-color"  "-outline"
1485        "-dashes" "-dashes"
1486        "-linecolor" "-outline"
1487        "-linewidth" "-linewidth"
1488    }
1489    set options {}
1490    foreach {name value} $style {
1491        if { [info exists lineOptions($name)] } {
1492            lappend options $lineOptions($name) $value
1493        }
1494    }
1495    return $options
1496}
1497
1498# ----------------------------------------------------------------------
1499# USAGE: _getTextMarkerOptions <style>
1500#
1501# Used internally to create a list of configuration options specific to the
1502# axis text marker.  The input is a list of name value pairs.  Options that
1503# are not recognized are ignored.
1504# ----------------------------------------------------------------------
1505itcl::body Rappture::XyResult::_getTextMarkerOptions {style} {
1506    array set textOptions {
1507        "-color"  "-outline"
1508        "-textcolor"  "-outline"
1509        "-font"   "-font"
1510        "-xoffset" "-xoffset"
1511        "-yoffset" "-yoffset"
1512        "-anchor" "-anchor"
1513    }
1514    set options {}
1515    foreach {name value} $style {
1516        if { [info exists textOptions($name)] } {
1517            lappend options $textOptions($name) $value
1518        }
1519    }
1520    return $options
1521}
1522
1523# ----------------------------------------------------------------------
1524# USAGE: _getAxes <curveObj>
1525#
1526# Used internally to figure out the axes used to plot the given
1527# <curveObj>.  Returns a list of the form {x y}, where x is the
1528# x-axis name (x, x2, x3, etc.), and y is the y-axis name.
1529# ----------------------------------------------------------------------
1530itcl::body Rappture::XyResult::_getAxes {curve} {
1531    # rebuild if needed, so we know about the axes
1532    if {[$_dispatcher ispending !rebuild]} {
1533        $_dispatcher cancel !rebuild
1534        $_dispatcher event -now !rebuild
1535    }
1536
1537    # what is the x axis?  x? x2? x3? ...
1538    set xlabel [$curve hints xlabel]
1539    if {[info exists _label2axis(x-$xlabel)]} {
1540        set mapx $_label2axis(x-$xlabel)
1541    } else {
1542        set mapx "x"
1543    }
1544
1545    # what is the y axis?  y? y2? y3? ...
1546    set ylabel [$curve hints ylabel]
1547    if {[info exists _label2axis(y-$ylabel)]} {
1548        set mapy $_label2axis(y-$ylabel)
1549    } else {
1550        set mapy "y"
1551    }
1552
1553    return [list $mapx $mapy]
1554}
1555
1556# ----------------------------------------------------------------------
1557# CONFIGURATION OPTION: -gridcolor
1558# ----------------------------------------------------------------------
1559itcl::configbody Rappture::XyResult::gridcolor {
1560    if { "" == $itk_option(-gridcolor) } {
1561        foreach axis [$itk_component(plot) axis names] {
1562            $itk_component(plot) axis configure $axis -grid off
1563        }
1564    } else {
1565        foreach axis [$itk_component(plot) axis names] {
1566            $itk_component(plot) axis configure $axis \
1567                -gridcolor $itk_option(-gridcolor) -grid on
1568        }
1569    }
1570}
1571
1572# ----------------------------------------------------------------------
1573# CONFIGURATION OPTION: -autocolors
1574# ----------------------------------------------------------------------
1575itcl::configbody Rappture::XyResult::autocolors {
1576    foreach c $itk_option(-autocolors) {
1577        if {[catch {winfo rgb $itk_component(hull) $c}]} {
1578            error "bad color \"$c\""
1579        }
1580    }
1581    if {$_autoColorI >= [llength $itk_option(-autocolors)]} {
1582        set _autoColorI 0
1583    }
1584}
1585
1586itcl::body Rappture::XyResult::_enterMarker { g name x y text } {
1587    _leaveMarker $g $name
1588    set id [$g marker create text \
1589                -coords [list $x $y] \
1590                -yoffset -1 \
1591                -anchor s \
1592                -text $text]
1593    set _markers($name) $id
1594}
1595
1596itcl::body Rappture::XyResult::_leaveMarker { g name } {
1597    if { [info exists _markers($name)] } {
1598        set id $_markers($name)
1599        $g marker delete $id
1600        unset _markers($name)
1601    }
1602}
Note: See TracBrowser for help on using the repository browser.