source: trunk/gui/scripts/barchartresult.tcl @ 5975

Last change on this file since 5975 was 5659, checked in by ldelgass, 9 years ago

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