Context Navigation

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

Last change on this file since 2790 was 1929, checked in by gah, 14 years ago

File size: 17.1 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--12-* 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 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
58	itk::usual MeshResult {
59	keep -background -foreground -cursor -font
60	}
61
62	# ----------------------------------------------------------------------
63	# CONSTRUCTOR
64	# ----------------------------------------------------------------------
65	itcl::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	# ----------------------------------------------------------------------
117	itcl::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	# ----------------------------------------------------------------------
127	itcl::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	# ----------------------------------------------------------------------
181	itcl::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	# ----------------------------------------------------------------------
202	itcl::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	# ----------------------------------------------------------------------
237	itcl::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	# ----------------------------------------------------------------------
273	itcl::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 -maxpect 1]
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	# ----------------------------------------------------------------------
314	itcl::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	# ----------------------------------------------------------------------
412	itcl::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	# ----------------------------------------------------------------------
467	itcl::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	# ----------------------------------------------------------------------
482	itcl::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	# ----------------------------------------------------------------------
511	itcl::configbody Rappture::MeshResult::gridcolor {
512	if {"" == $itk_option(-gridcolor)} {
513	$itk_component(plot) grid off
514	} else {
515	$itk_component(plot) grid configure -color $itk_option(-gridcolor)
516	$itk_component(plot) grid on
517	}
518	}

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

Download in other formats: