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

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

add unit cell to molvisviewer
File size: 54.3 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    if {$state == "at"} {
885        if {[$g element closest $x $y info -interpolate yes]} {
886            # for dealing with xy line plots
887            set elem $info(name)
888            # Some elements are generated dynamically and therefore will
889            # not have a data object associated with them.
890            set mapx [$g element cget $elem -mapx]
891            set mapy [$g element cget $elem -mapy]
892            if {[info exists _elem2dataobj($elem)]} {
893                foreach {mapx mapy} [GetAxes $_elem2dataobj($elem)] break
894            }
895
896            # search again for an exact point -- this time don't interpolate
897            set tip ""
898            if {[$g element closest $x $y info -interpolate no]
899                  && $info(name) == $elem} {
900                set x [$g axis transform $mapx $info(x)]
901                set y [$g axis transform $mapy $info(y)]
902
903                if {[info exists _elem2dataobj($elem)]} {
904                    set dataobj $_elem2dataobj($elem)
905                    set tip [GetInfo about.label $dataobj y]
906                    if {[info exists info(y)]} {
907                        set val [Axis format y dummy $info(y)]
908                        set units [GetInfo units $dataobj y]
909                        append tip "\n$val$units"
910
911                        if {[info exists _dataobj2param($dataobj)]} {
912                            set val [lindex $_dataobj2param($dataobj) 0]
913                            append tip " @ $val"
914                        }
915                    }
916                    set tip [string trim $tip]
917                }
918            }
919            set state 1
920        } elseif {[$g element closest $x $y info -interpolate no]} {
921            # for dealing with xy scatter plot
922            set elem $info(name)
923            foreach {mapx mapy} [GetAxes $_elem2dataobj($elem)] break
924
925            # search again for an exact point -- this time don't interpolate
926            set tip ""
927            if {$info(name) == $elem} {
928                set x [$g axis transform $mapx $info(x)]
929                set y [$g axis transform $mapy $info(y)]
930
931                if {[info exists _elem2dataobj($elem)]} {
932                    set dataobj $_elem2dataobj($elem)
933                    set tip [GetInfo about.label $dataobj y]
934                    if {[info exists info(y)]} {
935                        set val [Axis format y dummy $info(y)]
936                        set units [GetInfo units $dataobj y]
937                        append tip "\n$val$units"
938
939                        if {[info exists _dataobj2param($dataobj)]} {
940                            set val [lindex $_dataobj2param($dataobj) 0]
941                            append tip " @ $val"
942                        }
943                    }
944                    set tip [string trim $tip]
945                }
946            }
947            set state 1
948        } else {
949            set state 0
950        }
951    }
952
953    if {$state} {
954        #
955        # Highlight ON:
956        # - activate trace
957        # - multiple axes? dim other axes
958        # - pop up tooltip about data
959        #
960        if {$_hilite(elem) != "" && $_hilite(elem) != $elem} {
961            $g element deactivate $_hilite(elem)
962            $g crosshairs configure -hide yes
963            Rappture::Tooltip::tooltip cancel
964        }
965        $g element activate $elem
966        set _hilite(elem) $elem
967
968        set dlist [$g element show]
969        set i [lsearch -exact $dlist $elem]
970        if {$i >= 0} {
971            set dlist [lreplace $dlist $i $i]
972            lappend dlist $elem
973            $g element show $dlist
974        }
975
976        foreach {mapx mapy} [GetAxes $_elem2dataobj($elem)] break
977
978        set allx [$g x2axis use]
979        if {[llength $allx] > 0} {
980            lappend allx x  ;# fix main x-axis too
981            foreach axis $allx {
982                if {$axis == $mapx} {
983                    $g axis configure $axis -color $itk_option(-foreground) \
984                        -titlecolor $itk_option(-foreground)
985                } else {
986                    $g axis configure $axis -color $itk_option(-dimcolor) \
987                        -titlecolor $itk_option(-dimcolor)
988                }
989            }
990        }
991        set ally [$g y2axis use]
992        if {[llength $ally] > 0} {
993            lappend ally y  ;# fix main y-axis too
994            foreach axis $ally {
995                if {$axis == $mapy} {
996                    $g axis configure $axis -color $itk_option(-foreground) \
997                        -titlecolor $itk_option(-foreground)
998                } else {
999                    $g axis configure $axis -color $itk_option(-dimcolor) \
1000                        -titlecolor $itk_option(-dimcolor)
1001                }
1002            }
1003        }
1004
1005        if {"" != $tip} {
1006            $g crosshairs configure -hide no -position @$x,$y
1007
1008            if {$x > 0.5*[winfo width $g]} {
1009                if {$x < 4} {
1010                    set tipx "-0"
1011                } else {
1012                    set tipx "-[expr {$x-4}]"  ;# move tooltip to the left
1013                }
1014            } else {
1015                if {$x < -4} {
1016                    set tipx "+0"
1017                } else {
1018                    set tipx "+[expr {$x+4}]"  ;# move tooltip to the right
1019                }
1020            }
1021            if {$y > 0.5*[winfo height $g]} {
1022                if {$y < 4} {
1023                    set tipy "-0"
1024                } else {
1025                    set tipy "-[expr {$y-4}]"  ;# move tooltip to the top
1026                }
1027            } else {
1028                if {$y < -4} {
1029                    set tipy "+0"
1030                } else {
1031                    set tipy "+[expr {$y+4}]"  ;# move tooltip to the bottom
1032                }
1033            }
1034            Rappture::Tooltip::text $g $tip
1035            Rappture::Tooltip::tooltip show $g $tipx,$tipy
1036        }
1037    } else {
1038        #
1039        # Highlight OFF:
1040        # - deactivate (color back to normal)
1041        # - put all axes back to normal color
1042        # - take down tooltip
1043        #
1044        if {"" != $_hilite(elem)} {
1045            $g element deactivate $_hilite(elem)
1046
1047            set allx [$g x2axis use]
1048            if {[llength $allx] > 0} {
1049                lappend allx x  ;# fix main x-axis too
1050                foreach axis $allx {
1051                    $g axis configure $axis -color $itk_option(-foreground) \
1052                        -titlecolor $itk_option(-foreground)
1053                }
1054            }
1055
1056            set ally [$g y2axis use]
1057            if {[llength $ally] > 0} {
1058                lappend ally y  ;# fix main y-axis too
1059                foreach axis $ally {
1060                    $g axis configure $axis -color $itk_option(-foreground) \
1061                        -titlecolor $itk_option(-foreground)
1062                }
1063            }
1064        }
1065
1066        $g crosshairs configure -hide yes
1067
1068        # only cancel in plotting area or we'll mess up axes
1069        if {[$g inside $x $y]} {
1070            Rappture::Tooltip::tooltip cancel
1071        }
1072
1073        # there is no currently highlighted element
1074        set _hilite(elem) ""
1075    }
1076}
1077
1078# ----------------------------------------------------------------------
1079# USAGE: Axis hilite <axis> <state>
1080#
1081# USAGE: Axis click <axis> <x> <y>
1082# USAGE: Axis drag <axis> <x> <y>
1083# USAGE: Axis release <axis> <x> <y>
1084#
1085# USAGE: Axis edit <axis>
1086# USAGE: Axis changed <axis> <what>
1087# USAGE: Axis format <axis> <widget> <value>
1088# USAGE: Axis scale <axis> linear|log
1089#
1090# Used internally to handle editing of the x/y axes.  The hilite
1091# operation causes the axis to light up.  The edit operation pops
1092# up a panel with editing options.  The changed operation applies
1093# changes from the panel.
1094# ----------------------------------------------------------------------
1095itcl::body Rappture::NumberResult::Axis {option args} {
1096    set inner [$itk_component(hull).axes component inner]
1097
1098    switch -- $option {
1099        hilite {
1100            if {[llength $args] != 2} {
1101                error "wrong # args: should be \"Axis hilite axis state\""
1102            }
1103            set g $itk_component(plot)
1104            set axis [lindex $args 0]
1105            set state [lindex $args 1]
1106
1107            if {$state} {
1108                $g axis configure $axis \
1109                    -color $itk_option(-activecolor) \
1110                    -titlecolor $itk_option(-activecolor)
1111
1112                set x [expr {[winfo pointerx $g]+4}]
1113                set y [expr {[winfo pointery $g]+4}]
1114                Rappture::Tooltip::tooltip pending $g-$axis @$x,$y
1115            } else {
1116                $g axis configure $axis \
1117                    -color $itk_option(-foreground) \
1118                    -titlecolor $itk_option(-foreground)
1119                Rappture::Tooltip::tooltip cancel
1120            }
1121        }
1122        click {
1123            if {[llength $args] != 3} {
1124                error "wrong # args: should be \"Axis click axis x y\""
1125            }
1126            set axis [lindex $args 0]
1127            set x [lindex $args 1]
1128            set y [lindex $args 2]
1129            set g $itk_component(plot)
1130
1131            set _axis(moved) 0
1132            set _axis(click-x) $x
1133            set _axis(click-y) $y
1134            foreach {min max} [$g axis limits $axis] break
1135            set _axis(min0) $min
1136            set _axis(max0) $max
1137            Rappture::Tooltip::tooltip cancel
1138        }
1139        drag {
1140            if {[llength $args] != 3} {
1141                error "wrong # args: should be \"Axis drag axis x y\""
1142            }
1143            if {![info exists _axis(moved)]} {
1144                return  ;# must have skipped click event -- ignore
1145            }
1146            set axis [lindex $args 0]
1147            set x [lindex $args 1]
1148            set y [lindex $args 2]
1149            set g $itk_component(plot)
1150
1151            if {[info exists _axis(click-x)] && [info exists _axis(click-y)]} {
1152                foreach {x0 y0 pw ph} [$g extents plotarea] break
1153                switch -glob $axis {
1154                  x* {
1155                    set pix $x
1156                    set pix0 $_axis(click-x)
1157                    set pixmin $x0
1158                    set pixmax [expr {$x0+$pw}]
1159                  }
1160                  y* {
1161                    set pix $y
1162                    set pix0 $_axis(click-y)
1163                    set pixmin [expr {$y0+$ph}]
1164                    set pixmax $y0
1165                  }
1166                }
1167                set log [$g axis cget $axis -logscale]
1168                set min $_axis(min0)
1169                set max $_axis(max0)
1170                set dpix [expr {abs($pix-$pix0)}]
1171                set v0 [$g axis invtransform $axis $pixmin]
1172                set v1 [$g axis invtransform $axis [expr {$pixmin+$dpix}]]
1173                if {$log} {
1174                    set v0 [expr {log10($v0)}]
1175                    set v1 [expr {log10($v1)}]
1176                    set min [expr {log10($min)}]
1177                    set max [expr {log10($max)}]
1178                }
1179
1180                if {$pix > $pix0} {
1181                    set delta [expr {$v1-$v0}]
1182                } else {
1183                    set delta [expr {$v0-$v1}]
1184                }
1185                set min [expr {$min-$delta}]
1186                set max [expr {$max-$delta}]
1187                if {$log} {
1188                    set min [expr {pow(10.0,$min)}]
1189                    set max [expr {pow(10.0,$max)}]
1190                }
1191                $g axis configure $axis -min $min -max $max
1192
1193                # move axis, don't edit on release
1194                set _axis(move) 1
1195            }
1196        }
1197        release {
1198            if {[llength $args] != 3} {
1199                error "wrong # args: should be \"Axis release axis x y\""
1200            }
1201            if {![info exists _axis(moved)]} {
1202                return  ;# must have skipped click event -- ignore
1203            }
1204            set axis [lindex $args 0]
1205            set x [lindex $args 1]
1206            set y [lindex $args 2]
1207
1208            if {!$_axis(moved)} {
1209                # small movement? then treat as click -- pop up axis editor
1210                set dx [expr {abs($x-$_axis(click-x))}]
1211                set dy [expr {abs($y-$_axis(click-y))}]
1212                if {$dx < 2 && $dy < 2} {
1213                    _axis edit $axis
1214                }
1215            } else {
1216                # one last movement
1217                Axis drag $axis $x $y
1218            }
1219            catch {unset _axis}
1220        }
1221        edit {
1222            if {[llength $args] != 1} {
1223                error "wrong # args: should be \"Axis edit axis\""
1224            }
1225            set axis [lindex $args 0]
1226            set _axisPopup(current) $axis
1227
1228            # apply last value when deactivating
1229            $itk_component(hull).axes configure -deactivatecommand \
1230                [itcl::code $this Axis changed $axis focus]
1231
1232            # fix axis label controls...
1233            set label [$itk_component(plot) axis cget $axis -title]
1234            $inner.label delete 0 end
1235            $inner.label insert end $label
1236            bind $inner.label <KeyPress-Return> \
1237                [itcl::code $this Axis changed $axis label]
1238            bind $inner.label <FocusOut> \
1239                [itcl::code $this Axis changed $axis label]
1240
1241            # fix min/max controls...
1242            foreach {min max} [$itk_component(plot) axis limits $axis] break
1243            $inner.min delete 0 end
1244            $inner.min insert end $min
1245            bind $inner.min <KeyPress-Return> \
1246                [itcl::code $this Axis changed $axis min]
1247            bind $inner.min <FocusOut> \
1248                [itcl::code $this Axis changed $axis min]
1249
1250            $inner.max delete 0 end
1251            $inner.max insert end $max
1252            bind $inner.max <KeyPress-Return> \
1253                [itcl::code $this Axis changed $axis max]
1254            bind $inner.max <FocusOut> \
1255                [itcl::code $this Axis changed $axis max]
1256
1257            # fix format control...
1258            set fmts [$inner.format choices get -value]
1259            set i [lsearch -exact $fmts $_axisPopup(format-$axis)]
1260            if {$i < 0} { set i 0 }  ;# use Auto choice
1261            $inner.format value [$inner.format choices get -label $i]
1262
1263            bind $inner.format <<Value>> \
1264                [itcl::code $this Axis changed $axis format]
1265
1266            # fix scale control...
1267            if {[$itk_component(plot) axis cget $axis -logscale]} {
1268                set _axisPopup(scale) "log"
1269                $inner.format configure -state disabled
1270            } else {
1271                set _axisPopup(scale) "linear"
1272                $inner.format configure -state normal
1273            }
1274            $inner.scales.linear configure \
1275                -command [itcl::code $this Axis changed $axis scale]
1276            $inner.scales.log configure \
1277                -command [itcl::code $this Axis changed $axis scale]
1278
1279            #
1280            # Figure out where the window should pop up.
1281            #
1282            set x [winfo rootx $itk_component(plot)]
1283            set y [winfo rooty $itk_component(plot)]
1284            set w [winfo width $itk_component(plot)]
1285            set h [winfo height $itk_component(plot)]
1286            foreach {x0 y0 pw ph} [$itk_component(plot) extents plotarea] break
1287            switch -glob -- $axis {
1288                x {
1289                    set x [expr {round($x + $x0+0.5*$pw)}]
1290                    set y [expr {round($y + $y0+$ph + 0.5*($h-$y0-$ph))}]
1291                    set dir "above"
1292                }
1293                x* {
1294                    set x [expr {round($x + $x0+0.5*$pw)}]
1295                    set dir "below"
1296                    set allx [$itk_component(plot) x2axis use]
1297                    set max [llength $allx]
1298                    set i [lsearch -exact $allx $axis]
1299                    set y [expr {round($y + ($i+0.5)*$y0/double($max))}]
1300                }
1301                y {
1302                    set x [expr {round($x + 0.5*$x0)}]
1303                    set y [expr {round($y + $y0+0.5*$ph)}]
1304                    set dir "right"
1305                }
1306                y* {
1307                    set y [expr {round($y + $y0+0.5*$ph)}]
1308                    set dir "left"
1309                    set ally [$itk_component(plot) y2axis use]
1310                    set max [llength $ally]
1311                    set i [lsearch -exact $ally $axis]
1312                    set y [expr {round($y + ($i+0.5)*$y0/double($max))}]
1313                    set x [expr {round($x+$x0+$pw + ($i+0.5)*($w-$x0-$pw)/double($max))}]
1314                }
1315            }
1316            $itk_component(hull).axes activate @$x,$y $dir
1317        }
1318        changed {
1319            if {[llength $args] != 2} {
1320                error "wrong # args: should be \"Axis changed axis what\""
1321            }
1322            set axis [lindex $args 0]
1323            set what [lindex $args 1]
1324            if {$what == "focus"} {
1325                set what [focus]
1326                if {[winfo exists $what]} {
1327                    set what [winfo name $what]
1328                }
1329            }
1330
1331            switch -- $what {
1332                label {
1333                    set val [$inner.label get]
1334                    $itk_component(plot) axis configure $axis -title $val
1335                }
1336                min {
1337                    set val [$inner.min get]
1338                    if {![string is double -strict $val]} {
1339                        Rappture::Tooltip::cue $inner.min "Must be a number"
1340                        bell
1341                        return
1342                    }
1343
1344                    set max [lindex [$itk_component(plot) axis limits $axis] 1]
1345                    if {$val >= $max} {
1346                        Rappture::Tooltip::cue $inner.min "Must be <= max ($max)"
1347                        bell
1348                        return
1349                    }
1350                    catch {
1351                        # can fail in log mode
1352                        $itk_component(plot) axis configure $axis -min $val
1353                    }
1354                    foreach {min max} [$itk_component(plot) axis limits $axis] break
1355                    $inner.min delete 0 end
1356                    $inner.min insert end $min
1357                }
1358                max {
1359                    set val [$inner.max get]
1360                    if {![string is double -strict $val]} {
1361                        Rappture::Tooltip::cue $inner.max "Should be a number"
1362                        bell
1363                        return
1364                    }
1365
1366                    set min [lindex [$itk_component(plot) axis limits $axis] 0]
1367                    if {$val <= $min} {
1368                        Rappture::Tooltip::cue $inner.max "Must be >= min ($min)"
1369                        bell
1370                        return
1371                    }
1372                    catch {
1373                        # can fail in log mode
1374                        $itk_component(plot) axis configure $axis -max $val
1375                    }
1376                    foreach {min max} [$itk_component(plot) axis limits $axis] break
1377                    $inner.max delete 0 end
1378                    $inner.max insert end $max
1379                }
1380                format {
1381                    set fmt [$inner.format translate [$inner.format value]]
1382                    set _axisPopup(format-$axis) $fmt
1383
1384                    # force a refresh
1385                    $itk_component(plot) axis configure $axis -min \
1386                        [$itk_component(plot) axis cget $axis -min]
1387                }
1388                scale {
1389                    Axis scale $axis $_axisPopup(scale)
1390
1391                    if {$_axisPopup(scale) == "log"} {
1392                        $inner.format configure -state disabled
1393                    } else {
1394                        $inner.format configure -state normal
1395                    }
1396
1397                    foreach {min max} [$itk_component(plot) axis limits $axis] break
1398                    $inner.min delete 0 end
1399                    $inner.min insert end $min
1400                    $inner.max delete 0 end
1401                    $inner.max insert end $max
1402                }
1403                default {
1404                    # be lenient so we can handle the "focus" case
1405                }
1406            }
1407        }
1408        format {
1409            if {[llength $args] != 3} {
1410                error "wrong # args: should be \"Axis format axis widget value\""
1411            }
1412            set axis [lindex $args 0]
1413            set value [lindex $args 2]
1414
1415            if {$axis == "x" && $_xlabels
1416                  && [info exists _xval2label($value)]} {
1417                return $_xval2label($value)
1418            }
1419            if {[$itk_component(plot) axis cget $axis -logscale]} {
1420                set fmt "%.6g"
1421            } else {
1422                set fmt $_axisPopup(format-$axis)
1423            }
1424            return [format $fmt $value]
1425        }
1426        scale {
1427            if {[llength $args] != 2} {
1428                error "wrong # args: should be \"Axis scale axis type\""
1429            }
1430            set axis [lindex $args 0]
1431            set type [lindex $args 1]
1432
1433            if {$type == "log"} {
1434                catch {$itk_component(plot) axis configure $axis -logscale 1}
1435                # leave format alone in log mode
1436                $itk_component(plot) axis configure $axis -command ""
1437            } else {
1438                catch {$itk_component(plot) axis configure $axis -logscale 0}
1439                # use special formatting for linear mode
1440                $itk_component(plot) axis configure $axis -command \
1441                    [itcl::code $this Axis format $axis]
1442            }
1443        }
1444        default {
1445            error "bad option \"$option\": should be changed, edit, hilite, or format"
1446        }
1447    }
1448}
1449
1450# ----------------------------------------------------------------------
1451# USAGE: GetAxes <dataobj>
1452#
1453# Used internally to figure out the axes used to plot the given
1454# <dataobj>.  Returns a list of the form {x y}, where x is the
1455# x-axis name (x, x2, x3, etc.), and y is the y-axis name.
1456# ----------------------------------------------------------------------
1457itcl::body Rappture::NumberResult::GetAxes {dataobj} {
1458    # rebuild if needed, so we know about the axes
1459    if {[$_dispatcher ispending !rebuild]} {
1460        $_dispatcher cancel !rebuild
1461        $_dispatcher event -now !rebuild
1462    }
1463
1464    # what is the x axis?  x? x2? x3? ...
1465    set xlabel "Simulation #"
1466    if {[info exists _label2axis(x-$xlabel)]} {
1467        set mapx $_label2axis(x-$xlabel)
1468    } else {
1469        set mapx "x"
1470    }
1471
1472    # what is the y axis?  y? y2? y3? ...
1473    set ylabel [$dataobj get about.label]
1474    if {[info exists _label2axis(y-$ylabel)]} {
1475        set mapy $_label2axis(y-$ylabel)
1476    } else {
1477        set mapy "y"
1478    }
1479
1480    return [list $mapx $mapy]
1481}
1482
1483# ----------------------------------------------------------------------
1484# USAGE: GetValue <dataobj> ?<axis>?
1485#
1486# Used internally to get the {x y} value from this <dataobj>.
1487# Returns x, y, or {x y} in the expected units for this object.
1488# ----------------------------------------------------------------------
1489itcl::body Rappture::NumberResult::GetValue {dataobj {which both}} {
1490    if {[info exists _dataobj2param($dataobj)]} {
1491        set x [lindex $_dataobj2param($dataobj) 1]
1492    } else {
1493        set x 0
1494    }
1495
1496    set y [$dataobj get current]
1497    set units [$dataobj get units]
1498    if {$units != ""} {
1499        set y [Rappture::Units::convert $y -context $units -to $units -units off]
1500    }
1501    if {![string is double -strict $y]} {
1502        set y 0
1503    }
1504
1505    switch -- $which {
1506        x { return $x }
1507        y { return $y }
1508        both { return [list $x $y] }
1509        default { error "bad value \"$which\": should be x, y, both" }
1510    }
1511}
1512
1513# ----------------------------------------------------------------------
1514# USAGE: GetInfo <what> <dataobj> ?<axis>?
1515#
1516# Used internally to get the {x y} labels from this <dataobj>.
1517# Returns xlabel, ylabel, or {xlabel ylabel}.
1518# ----------------------------------------------------------------------
1519itcl::body Rappture::NumberResult::GetInfo {what dataobj {which both}} {
1520    set x [lindex $_params 0]
1521    set y [$dataobj get $what]
1522    if {$what == "about.label"} {
1523        set units [$dataobj get units]
1524        if {"" != $units} {
1525            append y " ($units)"
1526        }
1527    }
1528
1529    switch -- $which {
1530        x { return $x }
1531        y { return $y }
1532        both { return [list $x $y] }
1533        default { error "bad value \"$which\": should be x, y, both" }
1534    }
1535}
1536
1537# ----------------------------------------------------------------------
1538# CONFIGURATION OPTION: -gridcolor
1539# ----------------------------------------------------------------------
1540itcl::configbody Rappture::NumberResult::gridcolor {
1541    if {"" == $itk_option(-gridcolor)} {
1542        $itk_component(plot) grid off
1543    } else {
1544        $itk_component(plot) grid configure -color $itk_option(-gridcolor)
1545        $itk_component(plot) grid on
1546    }
1547}
Note: See TracBrowser for help on using the repository browser.