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

Last change on this file since 3443 was 3330, checked in by gah, 12 years ago

merge (by hand) with Rappture1.2 branch

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