source: branches/1.3/gui/scripts/meshresult.tcl @ 3800

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

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