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

Last change on this file since 2035 was 1943, checked in by gah, 14 years ago

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