Context Navigation

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

Last change on this file since 438 was 413, checked in by mmc, 18 years ago

Added <description> capability to output objects, including axes.

Fixed the ResultSet? so that it is more compact and supports the simulation number as a parameter. This is useful when there are datasets with wildly varying parameters.

File size: 43.5 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 Purdue Research Foundation
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 *XyResult.width 3i widgetDefault
18	option add *XyResult.height 3i widgetDefault
19	option add *XyResult.gridColor #d9d9d9 widgetDefault
20	option add *XyResult.activeColor blue widgetDefault
21	option add *XyResult.dimColor gray widgetDefault
22	option add *XyResult.controlBackground gray widgetDefault
23	option add *XyResult.font \
24	--helvetica-medium-r-normal---120- widgetDefault
25
26	option add *XyResult.autoColors {
27	#0000ff #ff0000 #00cc00
28	#cc00cc #ff9900 #cccc00
29	#000080 #800000 #006600
30	#660066 #996600 #666600
31	} widgetDefault
32
33	option add XyResultBalloon*Entry.background white widgetDefault
34
35	itcl::class Rappture::XyResult {
36	inherit itk::Widget
37
38	itk_option define -gridcolor gridColor GridColor ""
39	itk_option define -activecolor activeColor ActiveColor ""
40	itk_option define -dimcolor dimColor DimColor ""
41	itk_option define -autocolors autoColors AutoColors ""
42
43	constructor {args} { # defined below }
44	destructor { # defined below }
45
46	public method add {curve {settings ""}}
47	public method get {}
48	public method delete {args}
49	public method scale {args}
50	public method download {option}
51
52	protected method _rebuild {}
53	protected method _resetLimits {}
54	protected method _zoom {option args}
55	protected method _hilite {state x y}
56	protected method _axis {option args}
57	protected method _getAxes {xydata}
58
59	private variable _dispatcher "" ;# dispatcher for !events
60
61	private variable _clist "" ;# list of curve objects
62	private variable _curve2color ;# maps curve => plotting color
63	private variable _curve2width ;# maps curve => line width
64	private variable _curve2dashes ;# maps curve => BLT -dashes list
65	private variable _curve2raise ;# maps curve => raise flag 0/1
66	private variable _elem2curve ;# maps graph element => curve
67	private variable _label2axis ;# maps axis label => axis ID
68	private variable _limits ;# axis limits: x-min, x-max, etc.
69	private variable _autoColorI 0 ;# index for next "-color auto"
70
71	private variable _hilite ;# info for element currently highlighted
72	private variable _axis ;# info for axis manipulations
73	private variable _axisPopup ;# info for axis being edited in popup
74	}
75
76	itk::usual XyResult {
77	keep -background -foreground -cursor -font
78	}
79
80	# ----------------------------------------------------------------------
81	# CONSTRUCTOR
82	# ----------------------------------------------------------------------
83	itcl::body Rappture::XyResult::constructor {args} {
84	Rappture::dispatcher _dispatcher
85	$_dispatcher register !rebuild
86	$_dispatcher dispatch $this !rebuild "[itcl::code $this _rebuild]; list"
87
88	option add hull.width hull.height
89	pack propagate $itk_component(hull) no
90
91	itk_component add controls {
92	frame $itk_interior.cntls
93	} {
94	usual
95	rename -background -controlbackground controlBackground Background
96	}
97	pack $itk_component(controls) -side right -fill y
98
99	itk_component add reset {
100	button $itk_component(controls).reset \
101	-borderwidth 1 -padx 1 -pady 1 \
102	-bitmap [Rappture::icon reset] \
103	-command [itcl::code $this _zoom reset]
104	} {
105	usual
106	ignore -borderwidth
107	rename -highlightbackground -controlbackground controlBackground Background
108	}
109	pack $itk_component(reset) -padx 4 -pady 4
110	Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
111
112
113	itk_component add plot {
114	blt::graph $itk_interior.plot \
115	-highlightthickness 0 -plotpadx 0 -plotpady 0 \
116	-rightmargin 10
117	} {
118	keep -background -foreground -cursor -font
119	}
120	pack $itk_component(plot) -expand yes -fill both
121	$itk_component(plot) pen configure activeLine \
122	-symbol square -pixels 3 -linewidth 2 -color black
123
124	#
125	# Add bindings so you can mouse over points to see values:
126	#
127	bind $itk_component(plot) <Motion> \
128	[itcl::code $this _hilite at %x %y]
129	bind $itk_component(plot) <Leave> \
130	[itcl::code $this _hilite off %x %y]
131
132	#
133	# Add support for editing axes:
134	#
135	Rappture::Balloon $itk_component(hull).axes -title "Axis Options"
136	set inner [$itk_component(hull).axes component inner]
137
138	label $inner.labell -text "Label:"
139	entry $inner.label -width 15 -highlightbackground $itk_option(-background)
140	grid $inner.labell -row 1 -column 0 -sticky e
141	grid $inner.label -row 1 -column 1 -sticky ew -pady 4
142
143	label $inner.minl -text "Minimum:"
144	entry $inner.min -width 15 -highlightbackground $itk_option(-background)
145	grid $inner.minl -row 2 -column 0 -sticky e
146	grid $inner.min -row 2 -column 1 -sticky ew -pady 4
147
148	label $inner.maxl -text "Maximum:"
149	entry $inner.max -width 15 -highlightbackground $itk_option(-background)
150	grid $inner.maxl -row 3 -column 0 -sticky e
151	grid $inner.max -row 3 -column 1 -sticky ew -pady 4
152
153	label $inner.formatl -text "Format:"
154	Rappture::Combobox $inner.format -width 15 -editable no
155	$inner.format choices insert end \
156	"%.3g" "Auto" \
157	"%.0f" "X" \
158	"%.1f" "X.X" \
159	"%.2f" "X.XX" \
160	"%.3f" "X.XXX" \
161	"%.6f" "X.XXXXXX" \
162	"%.1e" "X.Xe+XX" \
163	"%.2e" "X.XXe+XX" \
164	"%.3e" "X.XXXe+XX" \
165	"%.6e" "X.XXXXXXe+XX"
166	grid $inner.formatl -row 4 -column 0 -sticky e
167	grid $inner.format -row 4 -column 1 -sticky ew -pady 4
168
169	label $inner.scalel -text "Scale:"
170	frame $inner.scales
171	radiobutton $inner.scales.linear -text "Linear" \
172	-variable [itcl::scope _axisPopup(scale)] -value "linear"
173	pack $inner.scales.linear -side left
174	radiobutton $inner.scales.log -text "Logarithmic" \
175	-variable [itcl::scope _axisPopup(scale)] -value "log"
176	pack $inner.scales.log -side left
177	grid $inner.scalel -row 5 -column 0 -sticky e
178	grid $inner.scales -row 5 -column 1 -sticky ew -pady 4
179
180	foreach axis {x y} {
181	set _axisPopup(format-$axis) "%.3g"
182	}
183	_axis scale x linear
184	_axis scale y linear
185
186	# quick-and-dirty zoom functionality, for now...
187	Blt_ZoomStack $itk_component(plot)
188	$itk_component(plot) legend configure -hide yes
189
190	eval itk_initialize $args
191
192	set _hilite(elem) ""
193	}
194
195	# ----------------------------------------------------------------------
196	# DESTRUCTOR
197	# ----------------------------------------------------------------------
198	itcl::body Rappture::XyResult::destructor {} {
199	}
200
201	# ----------------------------------------------------------------------
202	# USAGE: add <curve> ?<settings>?
203	#
204	# Clients use this to add a curve to the plot. The optional <settings>
205	# are used to configure the plot. Allowed settings are -color,
206	# -brightness, -width, -linestyle and -raise.
207	# ----------------------------------------------------------------------
208	itcl::body Rappture::XyResult::add {curve {settings ""}} {
209	array set params {
210	-color auto
211	-brightness 0
212	-width 1
213	-raise 0
214	-linestyle solid
215	}
216	foreach {opt val} $settings {
217	if {![info exists params($opt)]} {
218	error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
219	}
220	set params($opt) $val
221	}
222
223	# if the color is "auto", then select a color from -autocolors
224	if {$params(-color) == "auto" \|\| $params(-color) == "autoreset"} {
225	if {$params(-color) == "autoreset"} {
226	set _autoColorI 0
227	}
228	set color [lindex $itk_option(-autocolors) $_autoColorI]
229	if {"" == $color} { set color black }
230	set params(-color) $color
231
232	# set up for next auto color
233	if {[incr _autoColorI] >= [llength $itk_option(-autocolors)]} {
234	set _autoColorI 0
235	}
236	}
237
238	# convert -linestyle to BLT -dashes
239	switch -- $params(-linestyle) {
240	dashed { set params(-linestyle) {4 4} }
241	dotted { set params(-linestyle) {2 4} }
242	default { set params(-linestyle) {} }
243	}
244
245	# if -brightness is set, then update the color
246	if {$params(-brightness) != 0} {
247	set params(-color) [Rappture::color::brightness \
248	$params(-color) $params(-brightness)]
249
250	set bg [$itk_component(plot) cget -plotbackground]
251	foreach {h s v} [Rappture::color::RGBtoHSV $bg] break
252	if {$v > 0.5} {
253	set params(-color) [Rappture::color::brightness_max \
254	$params(-color) 0.8]
255	} else {
256	set params(-color) [Rappture::color::brightness_min \
257	$params(-color) 0.2]
258	}
259	}
260
261	set pos [lsearch -exact $curve $_clist]
262	if {$pos < 0} {
263	lappend _clist $curve
264	set _curve2color($curve) $params(-color)
265	set _curve2width($curve) $params(-width)
266	set _curve2dashes($curve) $params(-linestyle)
267	set _curve2raise($curve) $params(-raise)
268
269	$_dispatcher event -idle !rebuild
270	}
271	}
272
273	# ----------------------------------------------------------------------
274	# USAGE: get
275	#
276	# Clients use this to query the list of objects being plotted, in
277	# order from bottom to top of this result.
278	# ----------------------------------------------------------------------
279	itcl::body Rappture::XyResult::get {} {
280	# put the dataobj list in order according to -raise options
281	set clist $_clist
282	foreach obj $clist {
283	if {[info exists _curve2raise($obj)] && $_curve2raise($obj)} {
284	set i [lsearch -exact $clist $obj]
285	if {$i >= 0} {
286	set clist [lreplace $clist $i $i]
287	lappend clist $obj
288	}
289	}
290	}
291	return $clist
292	}
293
294	# ----------------------------------------------------------------------
295	# USAGE: delete ?<curve1> <curve2> ...?
296	#
297	# Clients use this to delete a curve from the plot. If no curves
298	# are specified, then all curves are deleted.
299	# ----------------------------------------------------------------------
300	itcl::body Rappture::XyResult::delete {args} {
301	if {[llength $args] == 0} {
302	set args $_clist
303	}
304
305	# delete all specified curves
306	set changed 0
307	foreach curve $args {
308	set pos [lsearch -exact $_clist $curve]
309	if {$pos >= 0} {
310	set _clist [lreplace $_clist $pos $pos]
311	catch {unset _curve2color($curve)}
312	catch {unset _curve2width($curve)}
313	catch {unset _curve2dashes($curve)}
314	catch {unset _curve2raise($curve)}
315	foreach elem [array names _elem2curve] {
316	if {$_elem2curve($elem) == $curve} {
317	unset _elem2curve($elem)
318	}
319	}
320	set changed 1
321	}
322	}
323
324	# if anything changed, then rebuild the plot
325	if {$changed} {
326	$_dispatcher event -idle !rebuild
327	}
328
329	# nothing left? then start over with auto colors
330	if {[llength $_clist] == 0} {
331	set _autoColorI 0
332	}
333	}
334
335	# ----------------------------------------------------------------------
336	# USAGE: scale ?<curve1> <curve2> ...?
337	#
338	# Sets the default limits for the overall plot according to the
339	# limits of the data for all of the given <curve> objects. This
340	# accounts for all curves--even those not showing on the screen.
341	# Because of this, the limits are appropriate for all curves as
342	# the user scans through data in the ResultSet viewer.
343	# ----------------------------------------------------------------------
344	itcl::body Rappture::XyResult::scale {args} {
345	set allx [$itk_component(plot) x2axis use]
346	lappend allx x ;# fix main x-axis too
347	foreach axis $allx {
348	_axis scale $axis linear
349	}
350
351	set ally [$itk_component(plot) y2axis use]
352	lappend ally y ;# fix main y-axis too
353	foreach axis $ally {
354	_axis scale $axis linear
355	}
356
357	catch {unset _limits}
358	foreach xydata $args {
359	# find the axes for this curve (e.g., {x y2})
360	foreach {map(x) map(y)} [_getAxes $xydata] break
361
362	foreach axis {x y} {
363	# get defaults for both linear and log scales
364	foreach type {lin log} {
365	# store results -- ex: _limits(x2log-min)
366	set id $map($axis)$type
367	foreach {min max} [$xydata limits $axis$type] break
368	if {"" != $min && "" != $max} {
369	if {![info exists _limits($id-min)]} {
370	set _limits($id-min) $min
371	set _limits($id-max) $max
372	} else {
373	if {$min < $_limits($id-min)} {
374	set _limits($id-min) $min
375	}
376	if {$max > $_limits($id-max)} {
377	set _limits($id-max) $max
378	}
379	}
380	}
381	}
382
383	if {[$xydata hints ${axis}scale] == "log"} {
384	_axis scale $map($axis) log
385	}
386	}
387	}
388	_resetLimits
389	}
390
391	# ----------------------------------------------------------------------
392	# USAGE: download coming
393	# USAGE: download now
394	#
395	# Clients use this method to create a downloadable representation
396	# of the plot. Returns a list of the form {ext string}, where
397	# "ext" is the file extension (indicating the type of data) and
398	# "string" is the data itself.
399	# ----------------------------------------------------------------------
400	itcl::body Rappture::XyResult::download {option} {
401	switch $option {
402	coming {
403	# nothing to do
404	}
405	now {
406	set psdata [$itk_component(plot) postscript output -maxpect 1]
407
408	set cmds {
409	set fout "xy[pid].pdf"
410	exec ps2pdf - $fout << $psdata
411
412	set fid [open $fout r]
413	fconfigure $fid -translation binary -encoding binary
414	set pdfdata [read $fid]
415	close $fid
416
417	file delete -force $fout
418	}
419	if {[catch $cmds result] == 0} {
420	return [list .pdf $pdfdata]
421	}
422	return [list .ps $psdata]
423	}
424	default {
425	error "bad option \"$option\": should be coming, now"
426	}
427	}
428	}
429
430	# ----------------------------------------------------------------------
431	# USAGE: _rebuild
432	#
433	# Called automatically whenever something changes that affects the
434	# data in the widget. Clears any existing data and rebuilds the
435	# widget to display new data.
436	# ----------------------------------------------------------------------
437	itcl::body Rappture::XyResult::_rebuild {} {
438	set g $itk_component(plot)
439
440	# first clear out the widget
441	eval $g element delete [$g element names]
442	foreach axis [$g axis names] {
443	$g axis configure $axis -hide yes
444	}
445	catch {unset _label2axis}
446
447	#
448	# Scan through all objects and create a list of all axes.
449	# The first x-axis gets mapped to "x". The second, to "x2".
450	# Beyond that, we must create new axes "x3", "x4", etc.
451	# We do the same for y.
452	#
453	set anum(x) 0
454	set anum(y) 0
455	foreach xydata [get] {
456	foreach ax {x y} {
457	set label [$xydata hints ${ax}label]
458	if {"" != $label} {
459	if {![info exists _label2axis($ax-$label)]} {
460	switch [incr anum($ax)] {
461	1 { set axis $ax }
462	2 { set axis ${ax}2 }
463	default {
464	set axis $ax$anum($ax)
465	catch {$g axis create $axis}
466	}
467	}
468	$g axis configure $axis -title $label -hide no
469	set _label2axis($ax-$label) $axis
470
471	# if this axis has a description, add it as a tooltip
472	set desc [string trim [$xydata hints ${ax}desc]]
473	Rappture::Tooltip::text $g-$axis $desc
474	}
475	}
476	}
477	}
478
479	#
480	# All of the extra axes get mapped to the x2/y2 (top/right)
481	# position.
482	#
483	set all ""
484	foreach ax {x y} {
485	lappend all $ax
486
487	set extra ""
488	for {set i 2} {$i <= $anum($ax)} {incr i} {
489	lappend extra ${ax}$i
490	}
491	eval lappend all $extra
492	$g ${ax}2axis use $extra
493	if {$ax == "y"} {
494	$g configure -rightmargin [expr {($extra == "") ? 10 : 0}]
495	}
496	}
497
498	foreach axis $all {
499	set _axisPopup(format-$axis) "%.3g"
500
501	$g axis bind $axis <Enter> \
502	[itcl::code $this _axis hilite $axis on]
503	$g axis bind $axis <Leave> \
504	[itcl::code $this _axis hilite $axis off]
505	$g axis bind $axis <ButtonPress> \
506	[itcl::code $this _axis click $axis %x %y]
507	$g axis bind $axis <B1-Motion> \
508	[itcl::code $this _axis drag $axis %x %y]
509	$g axis bind $axis <ButtonRelease> \
510	[itcl::code $this _axis release $axis %x %y]
511	$g axis bind $axis <KeyPress> \
512	[list ::Rappture::Tooltip::tooltip cancel]
513	}
514
515	#
516	# Plot all of the curves.
517	#
518	set count 0
519	foreach xydata $_clist {
520	set label [$xydata hints label]
521	foreach {mapx mapy} [_getAxes $xydata] break
522
523	foreach comp [$xydata components] {
524	set xv [$xydata mesh $comp]
525	set yv [$xydata values $comp]
526
527	if {[info exists _curve2color($xydata)]} {
528	set color $_curve2color($xydata)
529	} else {
530	set color [$xydata hints color]
531	if {"" == $color} {
532	set color black
533	}
534	}
535
536	if {[info exists _curve2width($xydata)]} {
537	set lwidth $_curve2width($xydata)
538	} else {
539	set lwidth 2
540	}
541
542	if {[info exists _curve2dashes($xydata)]} {
543	set dashes $_curve2dashes($xydata)
544	} else {
545	set dashes ""
546	}
547
548	if {[$xv length] <= 1} {
549	set sym square
550	} else {
551	set sym ""
552	}
553
554	set elem "elem[incr count]"
555	set _elem2curve($elem) $xydata
556
557	$g element create $elem -x $xv -y $yv \
558	-symbol $sym -pixels 6 -linewidth $lwidth -label $label \
559	-color $color -dashes $dashes \
560	-mapx $mapx -mapy $mapy
561	}
562	}
563	}
564
565	# ----------------------------------------------------------------------
566	# USAGE: _resetLimits
567	#
568	# Used internally to apply automatic limits to the axes for the
569	# current plot.
570	# ----------------------------------------------------------------------
571	itcl::body Rappture::XyResult::_resetLimits {} {
572	set g $itk_component(plot)
573
574	#
575	# HACK ALERT!
576	# Use this code to fix up the y-axis limits for the BLT graph.
577	# The auto-limits don't always work well. We want them to be
578	# set to a "nice" number slightly above or below the min/max
579	# limits.
580	#
581	foreach axis [$g axis names] {
582	if {[info exists _limits(${axis}lin-min)]} {
583	set log [$g axis cget $axis -logscale]
584	if {$log} {
585	set min $_limits(${axis}log-min)
586	if {$min == 0} { set min 1 }
587	set max $_limits(${axis}log-max)
588	if {$max == 0} { set max 1 }
589
590	if {$min == $max} {
591	set logmin [expr {floor(log10(abs(0.9*$min)))}]
592	set logmax [expr {ceil(log10(abs(1.1*$max)))}]
593	} else {
594	set logmin [expr {floor(log10(abs($min)))}]
595	set logmax [expr {ceil(log10(abs($max)))}]
596	if {[string match y* $axis]} {
597	# add a little padding
598	set delta [expr {$logmax-$logmin}]
599	if {$delta == 0} { set delta 1 }
600	set logmin [expr {$logmin-0.05*$delta}]
601	set logmax [expr {$logmax+0.05*$delta}]
602	}
603	}
604	if {$logmin < -300} {
605	set min 1e-300
606	} elseif {$logmin > 300} {
607	set min 1e+300
608	} else {
609	set min [expr {pow(10.0,$logmin)}]
610	}
611
612	if {$logmax < -300} {
613	set max 1e-300
614	} elseif {$logmax > 300} {
615	set max 1e+300
616	} else {
617	set max [expr {pow(10.0,$logmax)}]
618	}
619	} else {
620	set min $_limits(${axis}lin-min)
621	set max $_limits(${axis}lin-max)
622
623	if {[string match y* $axis]} {
624	# add a little padding
625	set delta [expr {$max-$min}]
626	set min [expr {$min-0.05*$delta}]
627	set max [expr {$max+0.05*$delta}]
628	}
629	}
630	if {$min != $max} {
631	$g axis configure $axis -min $min -max $max
632	} else {
633	$g axis configure $axis -min "" -max ""
634	}
635	} else {
636	$g axis configure $axis -min "" -max ""
637	}
638	}
639	}
640
641	# ----------------------------------------------------------------------
642	# USAGE: _zoom reset
643	#
644	# Called automatically when the user clicks on one of the zoom
645	# controls for this widget. Changes the zoom for the current view.
646	# ----------------------------------------------------------------------
647	itcl::body Rappture::XyResult::_zoom {option args} {
648	switch -- $option {
649	reset {
650	_resetLimits
651	}
652	}
653	}
654
655	# ----------------------------------------------------------------------
656	# USAGE: _hilite <state> <x> <y>
657	#
658	# Called automatically when the user brushes one of the elements
659	# on the plot. Causes the element to highlight and a tooltip to
660	# pop up with element info.
661	# ----------------------------------------------------------------------
662	itcl::body Rappture::XyResult::_hilite {state x y} {
663	set g $itk_component(plot)
664	set elem ""
665	if {$state == "at"} {
666	if {[$g element closest $x $y info -interpolate yes]} {
667	set elem $info(name)
668	foreach {mapx mapy} [_getAxes $_elem2curve($elem)] break
669
670	# search again for an exact point -- this time don't interpolate
671	set tip ""
672	if {[$g element closest $x $y info -interpolate no]
673	&& $info(name) == $elem} {
674	set x [$g axis transform $mapx $info(x)]
675	set y [$g axis transform $mapy $info(y)]
676
677	if {[info exists _elem2curve($elem)]} {
678	set curve $_elem2curve($elem)
679	set tip [$curve hints tooltip]
680	if {[info exists info(y)]} {
681	set val [_axis format y dummy $info(y)]
682	set units [$curve hints yunits]
683	append tip "\n$val$units"
684
685	if {[info exists info(x)]} {
686	set val [_axis format x dummy $info(x)]
687	set units [$curve hints xunits]
688	append tip " @ $val$units"
689	}
690	}
691	set tip [string trim $tip]
692	}
693	}
694	set state 1
695	} else {
696	set state 0
697	}
698	}
699
700	if {$state} {
701	#
702	# Highlight ON:
703	# - activate trace
704	# - multiple axes? dim other axes
705	# - pop up tooltip about data
706	#
707	if {$_hilite(elem) != "" && $_hilite(elem) != $elem} {
708	$g element deactivate $_hilite(elem)
709	$g crosshairs configure -hide yes
710	Rappture::Tooltip::tooltip cancel
711	}
712	$g element activate $elem
713	set _hilite(elem) $elem
714
715	set dlist [$g element show]
716	set i [lsearch -exact $dlist $elem]
717	if {$i >= 0} {
718	set dlist [lreplace $dlist $i $i]
719	lappend dlist $elem
720	$g element show $dlist
721	}
722
723	foreach {mapx mapy} [_getAxes $_elem2curve($elem)] break
724
725	set allx [$g x2axis use]
726	if {[llength $allx] > 0} {
727	lappend allx x ;# fix main x-axis too
728	foreach axis $allx {
729	if {$axis == $mapx} {
730	$g axis configure $axis -color $itk_option(-foreground) \
731	-titlecolor $itk_option(-foreground)
732	} else {
733	$g axis configure $axis -color $itk_option(-dimcolor) \
734	-titlecolor $itk_option(-dimcolor)
735	}
736	}
737	}
738	set ally [$g y2axis use]
739	if {[llength $ally] > 0} {
740	lappend ally y ;# fix main y-axis too
741	foreach axis $ally {
742	if {$axis == $mapy} {
743	$g axis configure $axis -color $itk_option(-foreground) \
744	-titlecolor $itk_option(-foreground)
745	} else {
746	$g axis configure $axis -color $itk_option(-dimcolor) \
747	-titlecolor $itk_option(-dimcolor)
748	}
749	}
750	}
751
752	if {"" != $tip} {
753	$g crosshairs configure -hide no -position @$x,$y
754
755	if {$x > 0.5*[winfo width $g]} {
756	if {$x < 4} {
757	set tipx "-0"
758	} else {
759	set tipx "-[expr {$x-4}]" ;# move tooltip to the left
760	}
761	} else {
762	if {$x < -4} {
763	set tipx "+0"
764	} else {
765	set tipx "+[expr {$x+4}]" ;# move tooltip to the right
766	}
767	}
768	if {$y > 0.5*[winfo height $g]} {
769	if {$y < 4} {
770	set tipy "-0"
771	} else {
772	set tipy "-[expr {$y-4}]" ;# move tooltip to the top
773	}
774	} else {
775	if {$y < -4} {
776	set tipy "+0"
777	} else {
778	set tipy "+[expr {$y+4}]" ;# move tooltip to the bottom
779	}
780	}
781	Rappture::Tooltip::text $g $tip
782	Rappture::Tooltip::tooltip show $g $tipx,$tipy
783	}
784	} else {
785	#
786	# Highlight OFF:
787	# - deactivate (color back to normal)
788	# - put all axes back to normal color
789	# - take down tooltip
790	#
791	if {"" != $_hilite(elem)} {
792	$g element deactivate $_hilite(elem)
793
794	set allx [$g x2axis use]
795	if {[llength $allx] > 0} {
796	lappend allx x ;# fix main x-axis too
797	foreach axis $allx {
798	$g axis configure $axis -color $itk_option(-foreground) \
799	-titlecolor $itk_option(-foreground)
800	}
801	}
802
803	set ally [$g y2axis use]
804	if {[llength $ally] > 0} {
805	lappend ally y ;# fix main y-axis too
806	foreach axis $ally {
807	$g axis configure $axis -color $itk_option(-foreground) \
808	-titlecolor $itk_option(-foreground)
809	}
810	}
811	}
812
813	$g crosshairs configure -hide yes
814
815	# only cancel in plotting area or we'll mess up axes
816	if {[$g inside $x $y]} {
817	Rappture::Tooltip::tooltip cancel
818	}
819
820	# there is no currently highlighted element
821	set _hilite(elem) ""
822	}
823	}
824
825	# ----------------------------------------------------------------------
826	# USAGE: _axis hilite <axis> <state>
827	#
828	# USAGE: _axis click <axis> <x> <y>
829	# USAGE: _axis drag <axis> <x> <y>
830	# USAGE: _axis release <axis> <x> <y>
831	#
832	# USAGE: _axis edit <axis>
833	# USAGE: _axis changed <axis> <what>
834	# USAGE: _axis format <axis> <widget> <value>
835	# USAGE: _axis scale <axis> linear\|log
836	#
837	# Used internally to handle editing of the x/y axes. The hilite
838	# operation causes the axis to light up. The edit operation pops
839	# up a panel with editing options. The changed operation applies
840	# changes from the panel.
841	# ----------------------------------------------------------------------
842	itcl::body Rappture::XyResult::_axis {option args} {
843	set inner [$itk_component(hull).axes component inner]
844
845	switch -- $option {
846	hilite {
847	if {[llength $args] != 2} {
848	error "wrong # args: should be \"_axis hilite axis state\""
849	}
850	set g $itk_component(plot)
851	set axis [lindex $args 0]
852	set state [lindex $args 1]
853
854	if {$state} {
855	$g axis configure $axis \
856	-color $itk_option(-activecolor) \
857	-titlecolor $itk_option(-activecolor)
858
859	set x [expr {[winfo pointerx $g]+4}]
860	set y [expr {[winfo pointery $g]+4}]
861	Rappture::Tooltip::tooltip pending $g-$axis @$x,$y
862	} else {
863	$g axis configure $axis \
864	-color $itk_option(-foreground) \
865	-titlecolor $itk_option(-foreground)
866	Rappture::Tooltip::tooltip cancel
867	}
868	}
869	click {
870	if {[llength $args] != 3} {
871	error "wrong # args: should be \"_axis click axis x y\""
872	}
873	set axis [lindex $args 0]
874	set x [lindex $args 1]
875	set y [lindex $args 2]
876	set g $itk_component(plot)
877
878	set _axis(moved) 0
879	set _axis(click-x) $x
880	set _axis(click-y) $y
881	foreach {min max} [$g axis limits $axis] break
882	set _axis(min0) $min
883	set _axis(max0) $max
884	Rappture::Tooltip::tooltip cancel
885	}
886	drag {
887	if {[llength $args] != 3} {
888	error "wrong # args: should be \"_axis drag axis x y\""
889	}
890	set axis [lindex $args 0]
891	set x [lindex $args 1]
892	set y [lindex $args 2]
893	set g $itk_component(plot)
894
895	if {[info exists _axis(click-x)] && [info exists _axis(click-y)]} {
896	foreach {x0 y0 pw ph} [$g extents plotarea] break
897	switch -glob $axis {
898	x* {
899	set pix $x
900	set pix0 $_axis(click-x)
901	set pixmin $x0
902	set pixmax [expr {$x0+$pw}]
903	}
904	y* {
905	set pix $y
906	set pix0 $_axis(click-y)
907	set pixmin [expr {$y0+$ph}]
908	set pixmax $y0
909	}
910	}
911	set log [$g axis cget $axis -logscale]
912	set min $_axis(min0)
913	set max $_axis(max0)
914	set dpix [expr {abs($pix-$pix0)}]
915	set v0 [$g axis invtransform $axis $pixmin]
916	set v1 [$g axis invtransform $axis [expr {$pixmin+$dpix}]]
917	if {$log} {
918	set v0 [expr {log10($v0)}]
919	set v1 [expr {log10($v1)}]
920	set min [expr {log10($min)}]
921	set max [expr {log10($max)}]
922	}
923
924	if {$pix > $pix0} {
925	set delta [expr {$v1-$v0}]
926	} else {
927	set delta [expr {$v0-$v1}]
928	}
929	set min [expr {$min-$delta}]
930	set max [expr {$max-$delta}]
931	if {$log} {
932	set min [expr {pow(10.0,$min)}]
933	set max [expr {pow(10.0,$max)}]
934	}
935	$g axis configure $axis -min $min -max $max
936
937	# move axis, don't edit on release
938	set _axis(move) 1
939	}
940	}
941	release {
942	if {[llength $args] != 3} {
943	error "wrong # args: should be \"_axis release axis x y\""
944	}
945	set axis [lindex $args 0]
946	set x [lindex $args 1]
947	set y [lindex $args 2]
948
949	if {![info exists _axis(moved)] \|\| !$_axis(moved)} {
950	# small movement? then treat as click -- pop up axis editor
951	set dx [expr {abs($x-$_axis(click-x))}]
952	set dy [expr {abs($y-$_axis(click-y))}]
953	if {$dx < 2 && $dy < 2} {
954	_axis edit $axis
955	}
956	} else {
957	# one last movement
958	_axis drag $axis $x $y
959	}
960	catch {unset _axis}
961	}
962	edit {
963	if {[llength $args] != 1} {
964	error "wrong # args: should be \"_axis edit axis\""
965	}
966	set axis [lindex $args 0]
967	set _axisPopup(current) $axis
968
969	# apply last value when deactivating
970	$itk_component(hull).axes configure -deactivatecommand \
971	[itcl::code $this _axis changed $axis focus]
972
973	# fix axis label controls...
974	set label [$itk_component(plot) axis cget $axis -title]
975	$inner.label delete 0 end
976	$inner.label insert end $label
977	bind $inner.label <KeyPress-Return> \
978	[itcl::code $this _axis changed $axis label]
979	bind $inner.label <FocusOut> \
980	[itcl::code $this _axis changed $axis label]
981
982	# fix min/max controls...
983	foreach {min max} [$itk_component(plot) axis limits $axis] break
984	$inner.min delete 0 end
985	$inner.min insert end $min
986	bind $inner.min <KeyPress-Return> \
987	[itcl::code $this _axis changed $axis min]
988	bind $inner.min <FocusOut> \
989	[itcl::code $this _axis changed $axis min]
990
991	$inner.max delete 0 end
992	$inner.max insert end $max
993	bind $inner.max <KeyPress-Return> \
994	[itcl::code $this _axis changed $axis max]
995	bind $inner.max <FocusOut> \
996	[itcl::code $this _axis changed $axis max]
997
998	# fix format control...
999	set fmts [$inner.format choices get -value]
1000	set i [lsearch -exact $fmts $_axisPopup(format-$axis)]
1001	if {$i < 0} { set i 0 } ;# use Auto choice
1002	$inner.format value [$inner.format choices get -label $i]
1003
1004	bind $inner.format <<Value>> \
1005	[itcl::code $this _axis changed $axis format]
1006
1007	# fix scale control...
1008	if {[$itk_component(plot) axis cget $axis -logscale]} {
1009	set _axisPopup(scale) "log"
1010	$inner.format configure -state disabled
1011	} else {
1012	set _axisPopup(scale) "linear"
1013	$inner.format configure -state normal
1014	}
1015	$inner.scales.linear configure \
1016	-command [itcl::code $this _axis changed $axis scale]
1017	$inner.scales.log configure \
1018	-command [itcl::code $this _axis changed $axis scale]
1019
1020	#
1021	# Figure out where the window should pop up.
1022	#
1023	set x [winfo rootx $itk_component(plot)]
1024	set y [winfo rooty $itk_component(plot)]
1025	set w [winfo width $itk_component(plot)]
1026	set h [winfo height $itk_component(plot)]
1027	foreach {x0 y0 pw ph} [$itk_component(plot) extents plotarea] break
1028	switch -glob -- $axis {
1029	x {
1030	set x [expr {round($x + $x0+0.5*$pw)}]
1031	set y [expr {round($y + $y0+$ph + 0.5*($h-$y0-$ph))}]
1032	set dir "above"
1033	}
1034	x* {
1035	set x [expr {round($x + $x0+0.5*$pw)}]
1036	set dir "below"
1037	set allx [$itk_component(plot) x2axis use]
1038	set max [llength $allx]
1039	set i [lsearch -exact $allx $axis]
1040	set y [expr {round($y + ($i+0.5)*$y0/double($max))}]
1041	}
1042	y {
1043	set x [expr {round($x + 0.5*$x0)}]
1044	set y [expr {round($y + $y0+0.5*$ph)}]
1045	set dir "right"
1046	}
1047	y* {
1048	set y [expr {round($y + $y0+0.5*$ph)}]
1049	set dir "left"
1050	set ally [$itk_component(plot) y2axis use]
1051	set max [llength $ally]
1052	set i [lsearch -exact $ally $axis]
1053	set y [expr {round($y + ($i+0.5)*$y0/double($max))}]
1054	set x [expr {round($x+$x0+$pw + ($i+0.5)*($w-$x0-$pw)/double($max))}]
1055	}
1056	}
1057	$itk_component(hull).axes activate @$x,$y $dir
1058	}
1059	changed {
1060	if {[llength $args] != 2} {
1061	error "wrong # args: should be \"_axis changed axis what\""
1062	}
1063	set axis [lindex $args 0]
1064	set what [lindex $args 1]
1065	if {$what == "focus"} {
1066	set what [focus]
1067	if {[winfo exists $what]} {
1068	set what [winfo name $what]
1069	}
1070	}
1071
1072	switch -- $what {
1073	label {
1074	set val [$inner.label get]
1075	$itk_component(plot) axis configure $axis -title $val
1076	}
1077	min {
1078	set val [$inner.min get]
1079	if {![string is double -strict $val]} {
1080	Rappture::Tooltip::cue $inner.min "Must be a number"
1081	bell
1082	return
1083	}
1084
1085	set max [lindex [$itk_component(plot) axis limits $axis] 1]
1086	if {$val >= $max} {
1087	Rappture::Tooltip::cue $inner.min "Must be <= max ($max)"
1088	bell
1089	return
1090	}
1091	catch {
1092	# can fail in log mode
1093	$itk_component(plot) axis configure $axis -min $val
1094	}
1095	foreach {min max} [$itk_component(plot) axis limits $axis] break
1096	$inner.min delete 0 end
1097	$inner.min insert end $min
1098	}
1099	max {
1100	set val [$inner.max get]
1101	if {![string is double -strict $val]} {
1102	Rappture::Tooltip::cue $inner.max "Should be a number"
1103	bell
1104	return
1105	}
1106
1107	set min [lindex [$itk_component(plot) axis limits $axis] 0]
1108	if {$val <= $min} {
1109	Rappture::Tooltip::cue $inner.max "Must be >= min ($min)"
1110	bell
1111	return
1112	}
1113	catch {
1114	# can fail in log mode
1115	$itk_component(plot) axis configure $axis -max $val
1116	}
1117	foreach {min max} [$itk_component(plot) axis limits $axis] break
1118	$inner.max delete 0 end
1119	$inner.max insert end $max
1120	}
1121	format {
1122	set fmt [$inner.format translate [$inner.format value]]
1123	set _axisPopup(format-$axis) $fmt
1124
1125	# force a refresh
1126	$itk_component(plot) axis configure $axis -min \
1127	[$itk_component(plot) axis cget $axis -min]
1128	}
1129	scale {
1130	_axis scale $axis $_axisPopup(scale)
1131
1132	if {$_axisPopup(scale) == "log"} {
1133	$inner.format configure -state disabled
1134	} else {
1135	$inner.format configure -state normal
1136	}
1137
1138	foreach {min max} [$itk_component(plot) axis limits $axis] break
1139	$inner.min delete 0 end
1140	$inner.min insert end $min
1141	$inner.max delete 0 end
1142	$inner.max insert end $max
1143	}
1144	default {
1145	# be lenient so we can handle the "focus" case
1146	}
1147	}
1148	}
1149	format {
1150	if {[llength $args] != 3} {
1151	error "wrong # args: should be \"_axis format axis widget value\""
1152	}
1153	set axis [lindex $args 0]
1154	set value [lindex $args 2]
1155
1156	if {[$itk_component(plot) axis cget $axis -logscale]} {
1157	set fmt "%.3g"
1158	} else {
1159	set fmt $_axisPopup(format-$axis)
1160	}
1161	return [format $fmt $value]
1162	}
1163	scale {
1164	if {[llength $args] != 2} {
1165	error "wrong # args: should be \"_axis scale axis type\""
1166	}
1167	set axis [lindex $args 0]
1168	set type [lindex $args 1]
1169
1170	if {$type == "log"} {
1171	catch {$itk_component(plot) axis configure $axis -logscale 1}
1172	# leave format alone in log mode
1173	$itk_component(plot) axis configure $axis -command ""
1174	} else {
1175	catch {$itk_component(plot) axis configure $axis -logscale 0}
1176	# use special formatting for linear mode
1177	$itk_component(plot) axis configure $axis -command \
1178	[itcl::code $this _axis format $axis]
1179	}
1180	}
1181	default {
1182	error "bad option \"$option\": should be changed, edit, hilite, or format"
1183	}
1184	}
1185	}
1186
1187	# ----------------------------------------------------------------------
1188	# USAGE: _getAxes <curveObj>
1189	#
1190	# Used internally to figure out the axes used to plot the given
1191	# <curveObj>. Returns a list of the form {x y}, where x is the
1192	# x-axis name (x, x2, x3, etc.), and y is the y-axis name.
1193	# ----------------------------------------------------------------------
1194	itcl::body Rappture::XyResult::_getAxes {xydata} {
1195	# rebuild if needed, so we know about the axes
1196	if {[$_dispatcher ispending !rebuild]} {
1197	$_dispatcher cancel !rebuild
1198	$_dispatcher event -now !rebuild
1199	}
1200
1201	# what is the x axis? x? x2? x3? ...
1202	set xlabel [$xydata hints xlabel]
1203	if {[info exists _label2axis(x-$xlabel)]} {
1204	set mapx $_label2axis(x-$xlabel)
1205	} else {
1206	set mapx "x"
1207	}
1208
1209	# what is the y axis? y? y2? y3? ...
1210	set ylabel [$xydata hints ylabel]
1211	if {[info exists _label2axis(y-$ylabel)]} {
1212	set mapy $_label2axis(y-$ylabel)
1213	} else {
1214	set mapy "y"
1215	}
1216
1217	return [list $mapx $mapy]
1218	}
1219
1220	# ----------------------------------------------------------------------
1221	# CONFIGURATION OPTION: -gridcolor
1222	# ----------------------------------------------------------------------
1223	itcl::configbody Rappture::XyResult::gridcolor {
1224	if {"" == $itk_option(-gridcolor)} {
1225	$itk_component(plot) grid off
1226	} else {
1227	$itk_component(plot) grid configure -color $itk_option(-gridcolor)
1228	$itk_component(plot) grid on
1229	}
1230	}
1231
1232	# ----------------------------------------------------------------------
1233	# CONFIGURATION OPTION: -autocolors
1234	# ----------------------------------------------------------------------
1235	itcl::configbody Rappture::XyResult::autocolors {
1236	foreach c $itk_option(-autocolors) {
1237	if {[catch {winfo rgb $itk_component(hull) $c}]} {
1238	error "bad color \"$c\""
1239	}
1240	}
1241	if {$_autoColorI >= [llength $itk_option(-autocolors)]} {
1242	set _autoColorI 0
1243	}
1244	}

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

Download in other formats: