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

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