source: branches/r9/gui/scripts/histogramresult.tcl @ 5106

Last change on this file since 5106 was 3813, checked in by ldelgass, 11 years ago

Fix bug in 'add' method of viewer widgets: list search for existing dataobj
entry was wrong (list and pattern transposed), causing potential duplicate
entries in dataobj list.

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