Context Navigation

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

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

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

Download in other formats: