Context Navigation

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

Last change on this file since 57 was 57, checked in by mmc, 19 years ago

Fixed x/y graphs to support multiple axes.

Added Rappture::result proc for reporting results.

Fixed up app-fermi example to be a little cleaner.

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

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

Download in other formats: