source: branches/blt4_geovis/gui/scripts/xyresult.tcl @ 6044

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