source: branches/1.3/gui/scripts/histogramresult.tcl @ 4772

Last change on this file since 4772 was 3844, checked in by ldelgass, 11 years ago

Sync with trunk. Branch now differs only from trunk by r3722 (branch is version
1.3, trunk is version 1.4)

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.