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

Last change on this file since 2790 was 2762, checked in by gah, 12 years ago

fix for right-click in streamlines viewer, about command now uses path to find rappture.

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