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

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