source: branches/blt4/gui/scripts/meshresult.tcl @ 1681

Last change on this file since 1681 was 1650, checked in by gah, 15 years ago
File size: 15.3 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: meshresult - mesh plot in a ResultSet
3#
4#  This widget is a mesh plot, meant to view grid structures produced
5#  as output from the run of a Rappture tool.  Use the "add" and
6#  "delete" methods to control the meshes showing on the plot.
7# ======================================================================
8#  AUTHOR:  Michael McLennan, Purdue University
9#  Copyright (c) 2004-2005  Purdue Research Foundation
10#
11#  See the file "license.terms" for information on usage and
12#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13# ======================================================================
14package require Itk
15package require BLT
16
17option add *MeshResult.width 4i widgetDefault
18option add *MeshResult.height 4i widgetDefault
19option add *MeshResult.gridColor #d9d9d9 widgetDefault
20option add *MeshResult.regionColors {green yellow orange red magenta} widgetDefault
21option add *MeshResult.controlBackground gray widgetDefault
22option add *MeshResult.font \
23    -*-helvetica-medium-r-normal-*-12-* widgetDefault
24
25itcl::class Rappture::MeshResult {
26    inherit itk::Widget
27
28    itk_option define -gridcolor gridColor GridColor ""
29    itk_option define -regioncolors regionColors RegionColors ""
30
31    constructor {args} { # defined below }
32    destructor { # defined below }
33
34    public method add {dataobj {settings ""}}
35    public method get {}
36    public method delete {args}
37    public method scale {args}
38    public method parameters {title args} { # do nothing }
39    public method download {option args}
40
41    protected method _rebuild {}
42    protected method _fixLimits {}
43    protected method _zoom {option args}
44    protected method _hilite {state x y}
45
46    private variable _dlist ""     ;# list of dataobj objects
47    private variable _dobj2color   ;# maps dataobj => plotting color
48    private variable _dobj2width   ;# maps dataobj => line width
49    private variable _dobj2dashes  ;# maps dataobj => BLT -dashes list
50    private variable _dobj2raise   ;# maps dataobj => raise flag 0/1
51    private variable _mrkr2tip     ;# maps graph element => tooltip
52    private variable _xmin ""      ;# autoscale min for x-axis
53    private variable _xmax ""      ;# autoscale max for x-axis
54    private variable _ymin ""      ;# autoscale min for y-axis
55    private variable _ymax ""      ;# autoscale max for y-axis
56}
57                                                                               
58itk::usual MeshResult {
59    keep -background -foreground -cursor -font
60}
61
62# ----------------------------------------------------------------------
63# CONSTRUCTOR
64# ----------------------------------------------------------------------
65itcl::body Rappture::MeshResult::constructor {args} {
66    option add hull.width hull.height
67    pack propagate $itk_component(hull) no
68
69    itk_component add controls {
70        frame $itk_interior.cntls
71    } {
72        usual
73        rename -background -controlbackground controlBackground Background
74    }
75    pack $itk_component(controls) -side right -fill y
76
77    itk_component add reset {
78        button $itk_component(controls).reset \
79            -borderwidth 1 -padx 1 -pady 1 \
80            -bitmap [Rappture::icon reset] \
81            -command [itcl::code $this _zoom reset]
82    } {
83        usual
84        ignore -borderwidth
85        rename -highlightbackground -controlbackground controlBackground Background
86    }
87    pack $itk_component(reset) -padx 4 -pady 4
88    Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
89
90    itk_component add plot {
91        blt::graph $itk_interior.plot \
92            -highlightthickness 0 -plotpadx 0 -plotpady 0 \
93            -rightmargin 10 -invertxy 1
94    } {
95        keep -background -foreground -cursor -font
96    }
97    pack $itk_component(plot) -expand yes -fill both
98
99    # special pen for highlighting active traces
100    $itk_component(plot) marker bind all <Enter> \
101        [itcl::code $this _hilite on %x %y]
102    $itk_component(plot) marker bind all <Leave> \
103        [itcl::code $this _hilite off %x %y]
104
105    bind $itk_component(plot) <Leave> \
106        [list Rappture::Tooltip::tooltip cancel]
107
108    Blt_ZoomStack $itk_component(plot)
109    $itk_component(plot) legend configure -hide yes
110
111    eval itk_initialize $args
112}
113
114# ----------------------------------------------------------------------
115# DESTRUCTOR
116# ----------------------------------------------------------------------
117itcl::body Rappture::MeshResult::destructor {} {
118}
119
120# ----------------------------------------------------------------------
121# USAGE: add <dataobj> ?<settings>?
122#
123# Clients use this to add a dataobj to the plot.  The optional <settings>
124# are used to configure the plot.  Allowed settings are -color,
125# -brightness, -width, -linestyle and -raise.
126# ----------------------------------------------------------------------
127itcl::body Rappture::MeshResult::add {dataobj {settings ""}} {
128    array set params {
129        -color auto
130        -brightness 0
131        -width 1
132        -raise 0
133        -linestyle solid
134        -description ""
135        -param ""
136    }
137    foreach {opt val} $settings {
138        if {![info exists params($opt)]} {
139            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
140        }
141        set params($opt) $val
142    }
143    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
144        # can't handle -autocolors yet
145        set params(-color) black
146    }
147
148    # convert -linestyle to BLT -dashes
149    switch -- $params(-linestyle) {
150        dashed { set params(-linestyle) {4 4} }
151        dotted { set params(-linestyle) {2 4} }
152        default { set params(-linestyle) {} }
153    }
154
155    # if -brightness is set, then update the color
156    if {$params(-brightness) != 0} {
157        set params(-color) [Rappture::color::brightness \
158            $params(-color) $params(-brightness)]
159    }
160
161    set pos [lsearch -exact $dataobj $_dlist]
162    if {$pos < 0} {
163        lappend _dlist $dataobj
164        set _dobj2color($dataobj) $params(-color)
165        set _dobj2width($dataobj) $params(-width)
166        set _dobj2dashes($dataobj) $params(-linestyle)
167        #set _dobj2raise($dataobj) $params(-raise)
168        set _dobj2raise($dataobj) 0
169
170        after cancel [itcl::code $this _rebuild]
171        after idle [itcl::code $this _rebuild]
172    }
173}
174
175# ----------------------------------------------------------------------
176# USAGE: get
177#
178# Clients use this to query the list of objects being plotted, in
179# order from bottom to top of this result.
180# ----------------------------------------------------------------------
181itcl::body Rappture::MeshResult::get {} {
182    # put the dataobj list in order according to -raise options
183    set dlist $_dlist
184    foreach obj $dlist {
185        if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
186            set i [lsearch -exact $dlist $obj]
187            if {$i >= 0} {
188                set dlist [lreplace $dlist $i $i]
189                lappend dlist $obj
190            }
191        }
192    }
193    return $dlist
194}
195
196# ----------------------------------------------------------------------
197# USAGE: delete ?<dataobj> <dataobj> ...?
198#
199# Clients use this to delete a dataobj from the plot.  If no dataobjs
200# are specified, then all dataobjs are deleted.
201# ----------------------------------------------------------------------
202itcl::body Rappture::MeshResult::delete {args} {
203    if {[llength $args] == 0} {
204        set args $_dlist
205    }
206
207    # delete all specified dataobjs
208    set changed 0
209    foreach dataobj $args {
210        set pos [lsearch -exact $_dlist $dataobj]
211        if {$pos >= 0} {
212            set _dlist [lreplace $_dlist $pos $pos]
213            catch {unset _dobj2color($dataobj)}
214            catch {unset _dobj2width($dataobj)}
215            catch {unset _dobj2dashes($dataobj)}
216            catch {unset _dobj2raise($dataobj)}
217            set changed 1
218        }
219    }
220
221    # if anything changed, then rebuild the plot
222    if {$changed} {
223        after cancel [itcl::code $this _rebuild]
224        after idle [itcl::code $this _rebuild]
225    }
226}
227
228# ----------------------------------------------------------------------
229# USAGE: scale ?<dataobj1> <dataobj2> ...?
230#
231# Sets the default limits for the overall plot according to the
232# limits of the data for all of the given <dataobj> objects.  This
233# accounts for all dataobjs--even those not showing on the screen.
234# Because of this, the limits are appropriate for all dataobjs as
235# the user scans through data in the ResultSet viewer.
236# ----------------------------------------------------------------------
237itcl::body Rappture::MeshResult::scale {args} {
238    set _xmin ""
239    set _xmax ""
240    set _ymin ""
241    set _ymax ""
242    foreach obj $args {
243        foreach axis {x y} {
244            foreach {min max} [$obj limits $axis] break
245            if {"" != $min && "" != $max} {
246                if {"" == [set _${axis}min]} {
247                    set _${axis}min $min
248                    set _${axis}max $max
249                } else {
250                    if {$min < [set _${axis}min]} {
251                        set _${axis}min $min
252                    }
253                    if {$max > [set _${axis}max]} {
254                        set _${axis}max $max
255                    }
256                }
257            }
258        }
259    }
260    _fixLimits
261}
262
263# ----------------------------------------------------------------------
264# USAGE: download coming
265# USAGE: download controls <downloadCommand>
266# USAGE: download now
267#
268# Clients use this method to create a downloadable representation
269# of the plot.  Returns a list of the form {ext string}, where
270# "ext" is the file extension (indicating the type of data) and
271# "string" is the data itself.
272# ----------------------------------------------------------------------
273itcl::body Rappture::MeshResult::download {option args} {
274    switch $option {
275        coming {
276            # nothing to do
277        }
278        controls {
279            # no controls for this download yet
280            return ""
281        }
282        now {
283            set psdata [$itk_component(plot) postscript output]
284
285            set cmds {
286                set fout "mesh[pid].pdf"
287                exec ps2pdf - $fout << $psdata
288
289                set fid [open $fout r]
290                fconfigure $fid -translation binary -encoding binary
291                set pdfdata [read $fid]
292                close $fid
293
294                file delete -force $fout
295            }
296            if {[catch $cmds result] == 0} {
297                return [list .pdf $pdfdata]
298            }
299            return [list .ps $psdata]
300        }
301        default {
302            error "bad option \"$option\": should be coming, controls, now"
303        }
304    }
305}
306
307# ----------------------------------------------------------------------
308# USAGE: _rebuild
309#
310# Called automatically whenever something changes that affects the
311# data in the widget.  Clears any existing data and rebuilds the
312# widget to display new data.
313# ----------------------------------------------------------------------
314itcl::body Rappture::MeshResult::_rebuild {} {
315    set g $itk_component(plot)
316    blt::busy hold [winfo toplevel $g]
317
318    # first clear out the widget
319    eval $g marker delete [$g marker names]
320    $g axis configure x -min "" -max "" -loose yes -checklimits no \
321        -descending yes
322    $g axis configure y -min "" -max "" -loose yes -checklimits no
323
324    # extract axis information from the first dataobj
325    set dlist [get]
326    set xydata [lindex $dlist 0]
327    if {$xydata != ""} {
328        set legend [$xydata hints legend]
329        if {"" != $legend} {
330            if {$legend == "off"} {
331                $g legend configure -hide yes
332            } else {
333                $g legend configure -hide no \
334                    -position plotarea -anchor $legend -borderwidth 0
335            }
336        }
337
338        set xlabel [$xydata hints xlabel]
339        if {"" != $xlabel} {
340            $g xaxis configure -title $xlabel
341        }
342
343        set ylabel [$xydata hints ylabel]
344        if {"" != $ylabel} {
345            $g yaxis configure -title $ylabel
346        }
347    }
348
349    set multiple [expr {[llength $dlist] > 1}]
350    catch {unset _mrkr2tip}
351
352    # plot all of the dataobjs
353    set count 0
354    foreach xydata $dlist {
355        if {$multiple} {
356            if {[info exists _dobj2color($xydata)]} {
357                set color $_dobj2color($xydata)
358            } else {
359                set color [$xydata hints color]
360                if {"" == $color} {
361                    set color black
362                }
363            }
364
365            if {[info exists _dobj2width($xydata)]} {
366                set lwidth $_dobj2width($xydata)
367            } else {
368                set lwidth 2
369            }
370        } else {
371            set color black
372            set lwidth 1
373        }
374
375        if {[info exists _dobj2dashes($xydata)]} {
376            set dashes $_dobj2dashes($xydata)
377        } else {
378            set dashes ""
379        }
380
381        foreach {plist r} [$xydata elements] {
382            if {$count == 0} {
383                if {$r == "unknown"} {
384                    set fill gray
385                } elseif {![info exists colors($r)]} {
386                    set i [array size colors]
387                    set fill [lindex $itk_option(-regioncolors) $i]
388                    set colors($r) $fill
389                } else {
390                    set fill $colors($r)
391                }
392                set mrkr [$g marker create polygon -coords $plist -fill $fill]
393                set _mrkr2tip($mrkr) $r
394            }
395            set mrkr [$g marker create line -coords $plist \
396                -linewidth $lwidth -outline $color -dashes $dashes]
397            set _mrkr2tip($mrkr) $r
398        }
399        incr count
400    }
401
402    _fixLimits
403    blt::busy release [winfo toplevel $g]
404}
405
406# ----------------------------------------------------------------------
407# USAGE: _fixLimits
408#
409# Used internally to apply automatic limits to the axes for the
410# current plot.
411# ----------------------------------------------------------------------
412itcl::body Rappture::MeshResult::_fixLimits {} {
413    set g $itk_component(plot)
414
415    #
416    # HACK ALERT!
417    # Use this code to fix up the y-axis limits for the BLT graph.
418    # The auto-limits don't always work well.  We want them to be
419    # set to a "nice" number slightly above or below the min/max
420    # limits.
421    #
422    if {$_xmin != $_xmax} {
423        $g axis configure x -min $_xmin -max $_xmax
424    } else {
425        $g axis configure x -min "" -max ""
426    }
427
428    if {"" != $_ymin && "" != $_ymax} {
429        set min $_ymin
430        set max $_ymax
431        set log [$g axis cget y -logscale]
432        if {$log} {
433            if {$min == $max} {
434                set min [expr {0.9*$min}]
435                set max [expr {1.1*$max}]
436            }
437            set min [expr {pow(10.0,floor(log10($min)))}]
438            set max [expr {pow(10.0,ceil(log10($max)))}]
439        } else {
440            if {$min > 0} {
441                set min [expr {0.95*$min}]
442            } else {
443                set min [expr {1.05*$min}]
444            }
445            if {$max > 0} {
446                set max [expr {1.05*$max}]
447            } else {
448                set max [expr {0.95*$max}]
449            }
450        }
451        if {$min != $max} {
452            $g axis configure y -min $min -max $max
453        } else {
454            $g axis configure y -min "" -max ""
455        }
456    } else {
457        $g axis configure y -min "" -max ""
458    }
459}
460
461# ----------------------------------------------------------------------
462# USAGE: _zoom reset
463#
464# Called automatically when the user clicks on one of the zoom
465# controls for this widget.  Changes the zoom for the current view.
466# ----------------------------------------------------------------------
467itcl::body Rappture::MeshResult::_zoom {option args} {
468    switch -- $option {
469        reset {
470            _fixLimits
471        }
472    }
473}
474
475# ----------------------------------------------------------------------
476# USAGE: _hilite <state> <x> <y>
477#
478# Called automatically when the user brushes one of the elements
479# on the plot.  Causes the element to highlight and a tooltip to
480# pop up with element info.
481# ----------------------------------------------------------------------
482itcl::body Rappture::MeshResult::_hilite {state x y} {
483    set mrkr [$itk_component(plot) marker get current]
484    if {$state} {
485        #
486        # Highlight ON:
487        # - pop up tooltip about data
488        #
489        set tip ""
490        if {[info exists _mrkr2tip($mrkr)]} {
491            set tip $_mrkr2tip($mrkr)
492        }
493        if {"" != $tip} {
494            set x [expr {$x+4}]  ;# move the tooltip over a bit
495            set y [expr {$y+4}]
496            Rappture::Tooltip::text $itk_component(plot) $tip
497            Rappture::Tooltip::tooltip show $itk_component(plot) +$x,$y
498        }
499    } else {
500        #
501        # Highlight OFF:
502        # - take down tooltip
503        #
504        Rappture::Tooltip::tooltip cancel
505    }
506}
507
508# ----------------------------------------------------------------------
509# CONFIGURATION OPTION: -gridcolor
510# ----------------------------------------------------------------------
511itcl::configbody Rappture::MeshResult::gridcolor {
512    if { "" == $itk_option(-gridcolor) } {
513        foreach axis [$itk_component(plot) axis names] {
514            $itk_component(plot) axis configure $axis -grid off
515        }
516    } else {
517        foreach axis [$itk_component(plot) axis names] {
518            $itk_component(plot) axis configure $axis \
519                -gridcolor $itk_option(-gridcolor) -grid on
520        }
521    }
522}
Note: See TracBrowser for help on using the repository browser.