source: branches/1.3/gui/scripts/xyresult.tcl @ 3908

Last change on this file since 3908 was 3908, checked in by gah, 11 years ago

fix xyresult.tcl to use $label-log instead of $axis-log when checking for log scale

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