Context Navigation

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

Last change on this file since 3177 was 3177, checked in by mmc, 12 years ago
Updated all of the copyright notices to reference the transfer to the new HUBzero Foundation, LLC.
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-2012 HUBzero Foundation, LLC
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: