source: branches/1.3/gui/scripts/barchartresult.tcl @ 3721

Last change on this file since 3721 was 3454, checked in by gah, 12 years ago

add KP_Enter to Return bindings. Implement OK handler in visviewer base class. Fix setting # of isolines while running a sequence of heightmaps/contours

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