source: trunk/gui/scripts/numberresult.tcl @ 1392

Last change on this file since 1392 was 1342, checked in by gah, 15 years ago

preliminary HQ output from molvisviewer; unexpand tabs; all jpeg generation at 100%

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