source: trunk/gui/scripts/histogramresult.tcl @ 2744

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