source: branches/blt4/gui/scripts/numberresult.tcl @ 2287

Last change on this file since 2287 was 2287, checked in by gah, 13 years ago

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