source: trunk/gui/scripts/historesult.tcl @ 924

Last change on this file since 924 was 878, checked in by gah, 17 years ago

nanovis isosurface interface

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