Context Navigation

source: trunk/gui/scripts/meshresult.tcl @ 438

Last change on this file since 438 was 413, checked in by mmc, 19 years ago

Added <description> capability to output objects, including axes.

Fixed the ResultSet? so that it is more compact and supports the simulation number as a parameter. This is useful when there are datasets with wildly varying parameters.

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: