Context Navigation

source: branches/r9/gui/scripts/meshresult.tcl @ 4348

Last change on this file since 4348 was 3813, checked in by ldelgass, 11 years ago
Fix bug in 'add' method of viewer widgets: list search for existing dataobj entry was wrong (list and pattern transposed), causing potential duplicate entries in dataobj list.
File size: 16.9 KB

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

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

Download in other formats: