Context Navigation

source: trunk/gui/scripts/xyresult.tcl @ 12

Last change on this file since 12 was 12, checked in by mmc, 19 years ago
Fixed a new nits to so that the pntoy works better. The <tool><control>auto</control></tool> mode is now truly automatic, and the Simulate button no longer appears in that mode.
File size: 10.7 KB

Line
1	# ----------------------------------------------------------------------
2	# COMPONENT: xyresult - X/Y plot in a ResultSet
3	#
4	# This widget is an X/Y plot, meant to view line graphs produced
5	# as output from the run of a Rappture tool. Use the "add" and
6	# "delete" methods to control the curves showing on the plot.
7	# ======================================================================
8	# AUTHOR: Michael McLennan, Purdue University
9	# Copyright (c) 2004-2005
10	# Purdue Research Foundation, West Lafayette, IN
11	# ======================================================================
12	package require Itk
13	package require BLT
14
15	option add *XyResult.width 4i widgetDefault
16	option add *XyResult.height 4i widgetDefault
17	option add *XyResult.gridColor #d9d9d9 widgetDefault
18	option add *XyResult.font \
19	--helvetica-medium-r-normal---120- widgetDefault
20
21	itcl::class Rappture::XyResult {
22	inherit itk::Widget
23
24	itk_option define -gridcolor gridColor GridColor ""
25
26	constructor {args} { # defined below }
27	destructor { # defined below }
28
29	public method add {curve {settings ""}}
30	public method delete {args}
31	public method scale {args}
32
33	protected method _rebuild {}
34	protected method _fixLimits {}
35
36	private variable _clist "" ;# list of curve objects
37	private variable _curve2color ;# maps curve => plotting color
38	private variable _curve2width ;# maps curve => line width
39	private variable _curve2raise ;# maps curve => raise flag 0/1
40	private variable _curve2elems ;# maps curve => elements on graph
41	private variable _xmin "" ;# autoscale min for x-axis
42	private variable _xmax "" ;# autoscale max for x-axis
43	private variable _ymin "" ;# autoscale min for y-axis
44	private variable _ymax "" ;# autoscale max for y-axis
45	}
46
47	itk::usual XyResult {
48	keep -background -foreground -cursor -font
49	}
50
51	# ----------------------------------------------------------------------
52	# CONSTRUCTOR
53	# ----------------------------------------------------------------------
54	itcl::body Rappture::XyResult::constructor {args} {
55	option add hull.width hull.height
56	pack propagate $itk_component(hull) no
57
58	itk_component add plot {
59	blt::graph $itk_interior.plot \
60	-highlightthickness 0 -plotpadx 0 -plotpady 0 \
61	-rightmargin 10
62	} {
63	keep -background -foreground -cursor -font
64	}
65	pack $itk_component(plot) -expand yes -fill both
66
67	Blt_ZoomStack $itk_component(plot)
68	$itk_component(plot) legend configure -hide yes
69
70	eval itk_initialize $args
71	}
72
73	# ----------------------------------------------------------------------
74	# DESTRUCTOR
75	# ----------------------------------------------------------------------
76	itcl::body Rappture::XyResult::destructor {} {
77	}
78
79	# ----------------------------------------------------------------------
80	# USAGE: add <curve> ?<settings>?
81	#
82	# Clients use this to add a curve to the plot. The optional <settings>
83	# are used to configure the plot. Allowed settings are -color, -width,
84	# and -raise.
85	# ----------------------------------------------------------------------
86	itcl::body Rappture::XyResult::add {curve {settings ""}} {
87	array set params {
88	-color black
89	-width 1
90	-raise 0
91	}
92	foreach {opt val} $settings {
93	if {![info exists params($opt)]} {
94	error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
95	}
96	set params($opt) $val
97	}
98
99	set pos [lsearch -exact $curve $_clist]
100	if {$pos < 0} {
101	lappend _clist $curve
102	set _curve2color($curve) $params(-color)
103	set _curve2width($curve) $params(-width)
104	set _curve2raise($curve) $params(-raise)
105
106	after cancel [itcl::code $this _rebuild]
107	after idle [itcl::code $this _rebuild]
108	}
109	}
110
111	# ----------------------------------------------------------------------
112	# USAGE: delete ?<curve1> <curve2> ...?
113	#
114	# Clients use this to delete a curve from the plot. If no curves
115	# are specified, then all curves are deleted.
116	# ----------------------------------------------------------------------
117	itcl::body Rappture::XyResult::delete {args} {
118	if {[llength $args] == 0} {
119	set args $_clist
120	}
121
122	# delete all specified curves
123	set changed 0
124	foreach curve $args {
125	set pos [lsearch -exact $_clist $curve]
126	if {$pos >= 0} {
127	set _clist [lreplace $_clist $pos $pos]
128	catch {unset _curve2color($curve)}
129	catch {unset _curve2width($curve)}
130	catch {unset _curve2raise($curve)}
131	catch {unset _curve2elems($curve)}
132	set changed 1
133	}
134	}
135
136	# if anything changed, then rebuild the plot
137	if {$changed} {
138	after cancel [itcl::code $this _rebuild]
139	after idle [itcl::code $this _rebuild]
140	}
141	}
142
143	# ----------------------------------------------------------------------
144	# USAGE: scale ?<curve1> <curve2> ...?
145	#
146	# Sets the default limits for the overall plot according to the
147	# limits of the data for all of the given <curve> objects. This
148	# accounts for all curves--even those not showing on the screen.
149	# Because of this, the limits are appropriate for all curves as
150	# the user scans through data in the ResultSet viewer.
151	# ----------------------------------------------------------------------
152	itcl::body Rappture::XyResult::scale {args} {
153	set _xmin ""
154	set _xmax ""
155	set _ymin ""
156	set _ymax ""
157	foreach obj $args {
158	foreach axis {x y} {
159	foreach {min max} [$obj limits $axis] break
160	if {"" != $min && "" != $max} {
161	if {"" == [set _${axis}min]} {
162	set _${axis}min $min
163	set _${axis}max $max
164	} else {
165	if {$min < [set _${axis}min]} {
166	set _${axis}min $min
167	}
168	if {$max > [set _${axis}max]} {
169	set _${axis}max $max
170	}
171	}
172	}
173	}
174	}
175	_fixLimits
176	}
177
178	# ----------------------------------------------------------------------
179	# USAGE: _rebuild
180	#
181	# Called automatically whenever something changes that affects the
182	# data in the widget. Clears any existing data and rebuilds the
183	# widget to display new data.
184	# ----------------------------------------------------------------------
185	itcl::body Rappture::XyResult::_rebuild {} {
186	set g $itk_component(plot)
187
188	# first clear out the widget
189	eval $g element delete [$g element names]
190	$g axis configure y -min "" -max ""
191
192	# extract axis information from the first curve
193	set xydata [lindex $_clist 0]
194	if {$xydata != ""} {
195	set legend [$xydata hints legend]
196	if {"" != $legend} {
197	if {$legend == "off"} {
198	$g legend configure -hide yes
199	} else {
200	$g legend configure -hide no \
201	-position plotarea -anchor $legend -borderwidth 0
202	}
203	}
204
205	set xlabel [$xydata hints xlabel]
206	if {"" != $xlabel} {
207	$g xaxis configure -title $xlabel
208	}
209
210	set ylabel [$xydata hints ylabel]
211	if {"" != $ylabel} {
212	$g yaxis configure -title $ylabel
213	}
214	}
215
216	# plot all of the curves
217	set count 0
218	foreach xydata $_clist {
219	set _curve2elems($xydata) ""
220
221	foreach comp [$xydata components] {
222	set xv [$xydata mesh $comp]
223	set yv [$xydata values $comp]
224
225	if {[info exists _curve2color($xydata)]} {
226	set color $_curve2color($xydata)
227	} else {
228	set color [$xydata hints color]
229	if {"" == $color} {
230	set color black
231	}
232	}
233
234	if {[info exists _curve2width($xydata)]} {
235	set lwidth $_curve2width($xydata)
236	} else {
237	set lwidth 2
238	}
239
240	set elem "elem[incr count]"
241	lappend _curve2elems($xydata) $elem
242
243	set label [$xydata hints label]
244	$g element create $elem -x $xv -y $yv \
245	-symbol "" -linewidth $lwidth -label $label -color $color
246
247	set style [$xydata hints style]
248	if {$style != ""} {
249	eval $g element configure $elem $style
250	}
251	}
252	}
253
254	# raise those tagged to be on top
255	set dlist [$g element show]
256	foreach xydata $_clist {
257	if {[info exists _curve2raise($xydata)] && $_curve2raise($xydata)} {
258	foreach elem $_curve2elems($xydata) {
259	set i [lsearch -exact $dlist $elem]
260	if {$i >= 0} {
261	# move element to end of display list
262	set dlist [lreplace $dlist $i $i]
263	lappend dlist $elem
264	}
265	}
266	}
267	}
268	$g element show $dlist
269
270	_fixLimits
271	}
272
273	# ----------------------------------------------------------------------
274	# USAGE: _fixLimits
275	#
276	# Used internally to apply automatic limits to the axes for the
277	# current plot.
278	# ----------------------------------------------------------------------
279	itcl::body Rappture::XyResult::_fixLimits {} {
280	set g $itk_component(plot)
281
282	#
283	# HACK ALERT!
284	# Use this code to fix up the y-axis limits for the BLT graph.
285	# The auto-limits don't always work well. We want them to be
286	# set to a "nice" number slightly above or below the min/max
287	# limits.
288	#
289	$g axis configure x -min $_xmin -max $_xmax
290
291	if {"" != $_ymin && "" != $_ymax} {
292	set min $_ymin
293	set max $_ymax
294	set log [$g axis cget y -logscale]
295	if {$log} {
296	if {$min == $max} {
297	set min [expr {0.9*$min}]
298	set max [expr {1.1*$max}]
299	}
300	set min [expr {pow(10.0,floor(log10($min)))}]
301	set max [expr {pow(10.0,ceil(log10($max)))}]
302	} else {
303	if {$min > 0} {
304	set min [expr {0.95*$min}]
305	} else {
306	set min [expr {1.05*$min}]
307	}
308	if {$max > 0} {
309	set max [expr {1.05*$max}]
310	} else {
311	set max [expr {0.95*$max}]
312	}
313	}
314	$g axis configure y -min $min -max $max
315	} else {
316	$g axis configure y -min "" -max ""
317	}
318	}
319
320	# ----------------------------------------------------------------------
321	# CONFIGURATION OPTION: -gridcolor
322	# ----------------------------------------------------------------------
323	itcl::configbody Rappture::XyResult::gridcolor {
324	if {"" == $itk_option(-gridcolor)} {
325	$itk_component(plot) grid off
326	} else {
327	$itk_component(plot) grid configure -color $itk_option(-gridcolor)
328	$itk_component(plot) grid on
329	}
330	}

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

Download in other formats: