Context Navigation

source: branches/1.4/gui/scripts/meshresult.tcl @ 5312

Last change on this file since 5312 was 3844, checked in by ldelgass, 11 years ago
Sync with trunk. Branch now differs only from trunk by r3722 (branch is version 1.3, trunk is version 1.4)
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: