source: trunk/gui/scripts/barresult.tcl @ 1555

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