Context Navigation

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

Last change on this file since 1342 was 1342, checked in by gah, 16 years ago
preliminary HQ output from molvisviewer; unexpand tabs; all jpeg generation at 100%
File size: 15.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]; update
317
318	# first clear out the widget
319	eval $g marker delete [$g marker names]
320	$g axis configure x -min "" -max "" -loose yes -descending yes
321	$g axis configure y -min "" -max "" -loose yes
322
323	# extract axis information from the first dataobj
324	set dlist [get]
325	set xydata [lindex $dlist 0]
326	if {$xydata != ""} {
327	set legend [$xydata hints legend]
328	if {"" != $legend} {
329	if {$legend == "off"} {
330	$g legend configure -hide yes
331	} else {
332	$g legend configure -hide no \
333	-position plotarea -anchor $legend -borderwidth 0
334	}
335	}
336
337	set xlabel [$xydata hints xlabel]
338	if {"" != $xlabel} {
339	$g xaxis configure -title $xlabel
340	}
341
342	set ylabel [$xydata hints ylabel]
343	if {"" != $ylabel} {
344	$g yaxis configure -title $ylabel
345	}
346	}
347
348	set multiple [expr {[llength $dlist] > 1}]
349	catch {unset _mrkr2tip}
350
351	# plot all of the dataobjs
352	set count 0
353	foreach xydata $dlist {
354	if {$multiple} {
355	if {[info exists _dobj2color($xydata)]} {
356	set color $_dobj2color($xydata)
357	} else {
358	set color [$xydata hints color]
359	if {"" == $color} {
360	set color black
361	}
362	}
363
364	if {[info exists _dobj2width($xydata)]} {
365	set lwidth $_dobj2width($xydata)
366	} else {
367	set lwidth 2
368	}
369	} else {
370	set color black
371	set lwidth 1
372	}
373
374	if {[info exists _dobj2dashes($xydata)]} {
375	set dashes $_dobj2dashes($xydata)
376	} else {
377	set dashes ""
378	}
379
380	foreach {plist r} [$xydata elements] {
381	if {$count == 0} {
382	if {$r == "unknown"} {
383	set fill gray
384	} elseif {![info exists colors($r)]} {
385	set i [array size colors]
386	set fill [lindex $itk_option(-regioncolors) $i]
387	set colors($r) $fill
388	} else {
389	set fill $colors($r)
390	}
391	set mrkr [$g marker create polygon -coords $plist -fill $fill]
392	set _mrkr2tip($mrkr) $r
393	}
394	set mrkr [$g marker create line -coords $plist \
395	-linewidth $lwidth -outline $color -dashes $dashes]
396	set _mrkr2tip($mrkr) $r
397	}
398	incr count
399	}
400
401	_fixLimits
402	blt::busy release [winfo toplevel $g]
403	}
404
405	# ----------------------------------------------------------------------
406	# USAGE: _fixLimits
407	#
408	# Used internally to apply automatic limits to the axes for the
409	# current plot.
410	# ----------------------------------------------------------------------
411	itcl::body Rappture::MeshResult::_fixLimits {} {
412	set g $itk_component(plot)
413
414	#
415	# HACK ALERT!
416	# Use this code to fix up the y-axis limits for the BLT graph.
417	# The auto-limits don't always work well. We want them to be
418	# set to a "nice" number slightly above or below the min/max
419	# limits.
420	#
421	if {$_xmin != $_xmax} {
422	$g axis configure x -min $_xmin -max $_xmax
423	} else {
424	$g axis configure x -min "" -max ""
425	}
426
427	if {"" != $_ymin && "" != $_ymax} {
428	set min $_ymin
429	set max $_ymax
430	set log [$g axis cget y -logscale]
431	if {$log} {
432	if {$min == $max} {
433	set min [expr {0.9*$min}]
434	set max [expr {1.1*$max}]
435	}
436	set min [expr {pow(10.0,floor(log10($min)))}]
437	set max [expr {pow(10.0,ceil(log10($max)))}]
438	} else {
439	if {$min > 0} {
440	set min [expr {0.95*$min}]
441	} else {
442	set min [expr {1.05*$min}]
443	}
444	if {$max > 0} {
445	set max [expr {1.05*$max}]
446	} else {
447	set max [expr {0.95*$max}]
448	}
449	}
450	if {$min != $max} {
451	$g axis configure y -min $min -max $max
452	} else {
453	$g axis configure y -min "" -max ""
454	}
455	} else {
456	$g axis configure y -min "" -max ""
457	}
458	}
459
460	# ----------------------------------------------------------------------
461	# USAGE: _zoom reset
462	#
463	# Called automatically when the user clicks on one of the zoom
464	# controls for this widget. Changes the zoom for the current view.
465	# ----------------------------------------------------------------------
466	itcl::body Rappture::MeshResult::_zoom {option args} {
467	switch -- $option {
468	reset {
469	_fixLimits
470	}
471	}
472	}
473
474	# ----------------------------------------------------------------------
475	# USAGE: _hilite <state> <x> <y>
476	#
477	# Called automatically when the user brushes one of the elements
478	# on the plot. Causes the element to highlight and a tooltip to
479	# pop up with element info.
480	# ----------------------------------------------------------------------
481	itcl::body Rappture::MeshResult::_hilite {state x y} {
482	set mrkr [$itk_component(plot) marker get current]
483	if {$state} {
484	#
485	# Highlight ON:
486	# - pop up tooltip about data
487	#
488	set tip ""
489	if {[info exists _mrkr2tip($mrkr)]} {
490	set tip $_mrkr2tip($mrkr)
491	}
492	if {"" != $tip} {
493	set x [expr {$x+4}] ;# move the tooltip over a bit
494	set y [expr {$y+4}]
495	Rappture::Tooltip::text $itk_component(plot) $tip
496	Rappture::Tooltip::tooltip show $itk_component(plot) +$x,$y
497	}
498	} else {
499	#
500	# Highlight OFF:
501	# - take down tooltip
502	#
503	Rappture::Tooltip::tooltip cancel
504	}
505	}
506
507	# ----------------------------------------------------------------------
508	# CONFIGURATION OPTION: -gridcolor
509	# ----------------------------------------------------------------------
510	itcl::configbody Rappture::MeshResult::gridcolor {
511	if {"" == $itk_option(-gridcolor)} {
512	$itk_component(plot) grid off
513	} else {
514	$itk_component(plot) grid configure -color $itk_option(-gridcolor)
515	$itk_component(plot) grid on
516	}
517	}

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

Download in other formats: