Context Navigation

meshresult.tcl @ 608

Last change on this file since 608 was 464, checked in by mmc, 18 years ago

Added popup options for the "download" button. Right now this works
only for <curve> objects. You can select between CSV and PDF output.
Will add other formats later.

Fixed a few "after cancel" errors that were happening when you switch
between inputs in the structure demo.

Fixed the colors and fonts for the new bug report window.

File size: 17.0 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 args}
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	-description ""
134	}
135	foreach {opt val} $settings {
136	if {![info exists params($opt)]} {
137	error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
138	}
139	set params($opt) $val
140	}
141	if {$params(-color) == "auto" \|\| $params(-color) == "autoreset"} {
142	# can't handle -autocolors yet
143	set params(-color) black
144	}
145
146	# convert -linestyle to BLT -dashes
147	switch -- $params(-linestyle) {
148	dashed { set params(-linestyle) {4 4} }
149	dotted { set params(-linestyle) {2 4} }
150	default { set params(-linestyle) {} }
151	}
152
153	# if -brightness is set, then update the color
154	if {$params(-brightness) != 0} {
155	set params(-color) [Rappture::color::brightness \
156	$params(-color) $params(-brightness)]
157	}
158
159	set pos [lsearch -exact $dataobj $_dlist]
160	if {$pos < 0} {
161	lappend _dlist $dataobj
162	set _dobj2color($dataobj) $params(-color)
163	set _dobj2width($dataobj) $params(-width)
164	set _dobj2dashes($dataobj) $params(-linestyle)
165	#set _dobj2raise($dataobj) $params(-raise)
166	set _dobj2raise($dataobj) 0
167
168	after cancel [itcl::code $this _rebuild]
169	after idle [itcl::code $this _rebuild]
170	}
171	}
172
173	# ----------------------------------------------------------------------
174	# USAGE: get
175	#
176	# Clients use this to query the list of objects being plotted, in
177	# order from bottom to top of this result.
178	# ----------------------------------------------------------------------
179	itcl::body Rappture::MeshResult::get {} {
180	# put the dataobj list in order according to -raise options
181	set dlist $_dlist
182	foreach obj $dlist {
183	if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
184	set i [lsearch -exact $dlist $obj]
185	if {$i >= 0} {
186	set dlist [lreplace $dlist $i $i]
187	lappend dlist $obj
188	}
189	}
190	}
191	return $dlist
192	}
193
194	# ----------------------------------------------------------------------
195	# USAGE: delete ?<dataobj> <dataobj> ...?
196	#
197	# Clients use this to delete a dataobj from the plot. If no dataobjs
198	# are specified, then all dataobjs are deleted.
199	# ----------------------------------------------------------------------
200	itcl::body Rappture::MeshResult::delete {args} {
201	if {[llength $args] == 0} {
202	set args $_dlist
203	}
204
205	# delete all specified dataobjs
206	set changed 0
207	foreach dataobj $args {
208	set pos [lsearch -exact $_dlist $dataobj]
209	if {$pos >= 0} {
210	set _dlist [lreplace $_dlist $pos $pos]
211	catch {unset _dobj2color($dataobj)}
212	catch {unset _dobj2width($dataobj)}
213	catch {unset _dobj2dashes($dataobj)}
214	catch {unset _dobj2raise($dataobj)}
215	set changed 1
216	}
217	}
218
219	# if anything changed, then rebuild the plot
220	if {$changed} {
221	after cancel [itcl::code $this _rebuild]
222	after idle [itcl::code $this _rebuild]
223	}
224	}
225
226	# ----------------------------------------------------------------------
227	# USAGE: scale ?<dataobj1> <dataobj2> ...?
228	#
229	# Sets the default limits for the overall plot according to the
230	# limits of the data for all of the given <dataobj> objects. This
231	# accounts for all dataobjs--even those not showing on the screen.
232	# Because of this, the limits are appropriate for all dataobjs as
233	# the user scans through data in the ResultSet viewer.
234	# ----------------------------------------------------------------------
235	itcl::body Rappture::MeshResult::scale {args} {
236	set _xmin ""
237	set _xmax ""
238	set _ymin ""
239	set _ymax ""
240	foreach obj $args {
241	foreach axis {x y} {
242	foreach {min max} [$obj limits $axis] break
243	if {"" != $min && "" != $max} {
244	if {"" == [set _${axis}min]} {
245	set _${axis}min $min
246	set _${axis}max $max
247	} else {
248	if {$min < [set _${axis}min]} {
249	set _${axis}min $min
250	}
251	if {$max > [set _${axis}max]} {
252	set _${axis}max $max
253	}
254	}
255	}
256	}
257	}
258	_fixLimits
259	}
260
261	# ----------------------------------------------------------------------
262	# USAGE: download coming
263	# USAGE: download controls <downloadCommand>
264	# USAGE: download now
265	#
266	# Clients use this method to create a downloadable representation
267	# of the plot. Returns a list of the form {ext string}, where
268	# "ext" is the file extension (indicating the type of data) and
269	# "string" is the data itself.
270	# ----------------------------------------------------------------------
271	itcl::body Rappture::MeshResult::download {option args} {
272	switch $option {
273	coming {
274	# nothing to do
275	}
276	controls {
277	# no controls for this download yet
278	return ""
279	}
280	now {
281	set psdata [$itk_component(plot) postscript output -maxpect 1]
282
283	set cmds {
284	set fout "mesh[pid].pdf"
285	exec ps2pdf - $fout << $psdata
286
287	set fid [open $fout r]
288	fconfigure $fid -translation binary -encoding binary
289	set pdfdata [read $fid]
290	close $fid
291
292	file delete -force $fout
293	}
294	if {[catch $cmds result] == 0} {
295	return [list .pdf $pdfdata]
296	}
297	return [list .ps $psdata]
298	}
299	default {
300	error "bad option \"$option\": should be coming, controls, now"
301	}
302	}
303	}
304
305	# ----------------------------------------------------------------------
306	# USAGE: _rebuild
307	#
308	# Called automatically whenever something changes that affects the
309	# data in the widget. Clears any existing data and rebuilds the
310	# widget to display new data.
311	# ----------------------------------------------------------------------
312	itcl::body Rappture::MeshResult::_rebuild {} {
313	set g $itk_component(plot)
314	blt::busy hold [winfo toplevel $g]; update
315
316	# first clear out the widget
317	eval $g marker delete [$g marker names]
318	$g axis configure x -min "" -max "" -loose yes -descending yes
319	$g axis configure y -min "" -max "" -loose yes
320
321	# extract axis information from the first dataobj
322	set dlist [get]
323	set xydata [lindex $dlist 0]
324	if {$xydata != ""} {
325	set legend [$xydata hints legend]
326	if {"" != $legend} {
327	if {$legend == "off"} {
328	$g legend configure -hide yes
329	} else {
330	$g legend configure -hide no \
331	-position plotarea -anchor $legend -borderwidth 0
332	}
333	}
334
335	set xlabel [$xydata hints xlabel]
336	if {"" != $xlabel} {
337	$g xaxis configure -title $xlabel
338	}
339
340	set ylabel [$xydata hints ylabel]
341	if {"" != $ylabel} {
342	$g yaxis configure -title $ylabel
343	}
344	}
345
346	set multiple [expr {[llength $dlist] > 1}]
347	catch {unset _mrkr2tip}
348
349	# plot all of the dataobjs
350	set count 0
351	foreach xydata $dlist {
352	if {$multiple} {
353	if {[info exists _dobj2color($xydata)]} {
354	set color $_dobj2color($xydata)
355	} else {
356	set color [$xydata hints color]
357	if {"" == $color} {
358	set color black
359	}
360	}
361
362	if {[info exists _dobj2width($xydata)]} {
363	set lwidth $_dobj2width($xydata)
364	} else {
365	set lwidth 2
366	}
367	} else {
368	set color black
369	set lwidth 1
370	}
371
372	if {[info exists _dobj2dashes($xydata)]} {
373	set dashes $_dobj2dashes($xydata)
374	} else {
375	set dashes ""
376	}
377
378	foreach {plist r} [$xydata elements] {
379	if {$count == 0} {
380	if {$r == "unknown"} {
381	set fill gray
382	} elseif {![info exists colors($r)]} {
383	set i [array size colors]
384	set fill [lindex $itk_option(-regioncolors) $i]
385	set colors($r) $fill
386	} else {
387	set fill $colors($r)
388	}
389	set mrkr [$g marker create polygon -coords $plist -fill $fill]
390	set _mrkr2tip($mrkr) $r
391	}
392	set mrkr [$g marker create line -coords $plist \
393	-linewidth $lwidth -outline $color -dashes $dashes]
394	set _mrkr2tip($mrkr) $r
395	}
396	incr count
397	}
398
399	_fixLimits
400	blt::busy release [winfo toplevel $g]
401	}
402
403	# ----------------------------------------------------------------------
404	# USAGE: _fixLimits
405	#
406	# Used internally to apply automatic limits to the axes for the
407	# current plot.
408	# ----------------------------------------------------------------------
409	itcl::body Rappture::MeshResult::_fixLimits {} {
410	set g $itk_component(plot)
411
412	#
413	# HACK ALERT!
414	# Use this code to fix up the y-axis limits for the BLT graph.
415	# The auto-limits don't always work well. We want them to be
416	# set to a "nice" number slightly above or below the min/max
417	# limits.
418	#
419	if {$_xmin != $_xmax} {
420	$g axis configure x -min $_xmin -max $_xmax
421	} else {
422	$g axis configure x -min "" -max ""
423	}
424
425	if {"" != $_ymin && "" != $_ymax} {
426	set min $_ymin
427	set max $_ymax
428	set log [$g axis cget y -logscale]
429	if {$log} {
430	if {$min == $max} {
431	set min [expr {0.9*$min}]
432	set max [expr {1.1*$max}]
433	}
434	set min [expr {pow(10.0,floor(log10($min)))}]
435	set max [expr {pow(10.0,ceil(log10($max)))}]
436	} else {
437	if {$min > 0} {
438	set min [expr {0.95*$min}]
439	} else {
440	set min [expr {1.05*$min}]
441	}
442	if {$max > 0} {
443	set max [expr {1.05*$max}]
444	} else {
445	set max [expr {0.95*$max}]
446	}
447	}
448	if {$min != $max} {
449	$g axis configure y -min $min -max $max
450	} else {
451	$g axis configure y -min "" -max ""
452	}
453	} else {
454	$g axis configure y -min "" -max ""
455	}
456	}
457
458	# ----------------------------------------------------------------------
459	# USAGE: _zoom reset
460	#
461	# Called automatically when the user clicks on one of the zoom
462	# controls for this widget. Changes the zoom for the current view.
463	# ----------------------------------------------------------------------
464	itcl::body Rappture::MeshResult::_zoom {option args} {
465	switch -- $option {
466	reset {
467	_fixLimits
468	}
469	}
470	}
471
472	# ----------------------------------------------------------------------
473	# USAGE: _hilite <state> <x> <y>
474	#
475	# Called automatically when the user brushes one of the elements
476	# on the plot. Causes the element to highlight and a tooltip to
477	# pop up with element info.
478	# ----------------------------------------------------------------------
479	itcl::body Rappture::MeshResult::_hilite {state x y} {
480	set mrkr [$itk_component(plot) marker get current]
481	if {$state} {
482	#
483	# Highlight ON:
484	# - pop up tooltip about data
485	#
486	set tip ""
487	if {[info exists _mrkr2tip($mrkr)]} {
488	set tip $_mrkr2tip($mrkr)
489	}
490	if {"" != $tip} {
491	set x [expr {$x+4}] ;# move the tooltip over a bit
492	set y [expr {$y+4}]
493	Rappture::Tooltip::text $itk_component(plot) $tip
494	Rappture::Tooltip::tooltip show $itk_component(plot) +$x,$y
495	}
496	} else {
497	#
498	# Highlight OFF:
499	# - take down tooltip
500	#
501	Rappture::Tooltip::tooltip cancel
502	}
503	}
504
505	# ----------------------------------------------------------------------
506	# CONFIGURATION OPTION: -gridcolor
507	# ----------------------------------------------------------------------
508	itcl::configbody Rappture::MeshResult::gridcolor {
509	if {"" == $itk_option(-gridcolor)} {
510	$itk_component(plot) grid off
511	} else {
512	$itk_component(plot) grid configure -color $itk_option(-gridcolor)
513	$itk_component(plot) grid on
514	}
515	}

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

Context Navigation

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

Download in other formats: