Context Navigation

source: branches/blt4/gui/scripts/barresult.tcl @ 1695

Last change on this file since 1695 was 1650, checked in by gah, 15 years ago

File size: 56.7 KB

Line
1
2	# ----------------------------------------------------------------------
3	# COMPONENT: barresult - X/Y plot in a ResultSet
4	#
5	# This widget is an X/Y plot, meant to view line graphs produced
6	# as output from the run of a Rappture tool. Use the "add" and
7	# "delete" methods to control the curves showing on the plot.
8	# ======================================================================
9	# AUTHOR: Michael McLennan, Purdue University
10	# Copyright (c) 2004-2005 Purdue Research Foundation
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 *BarResult.width 3i widgetDefault
19	option add *BarResult.height 3i widgetDefault
20	option add *BarResult.gridColor #d9d9d9 widgetDefault
21	option add *BarResult.activeColor blue widgetDefault
22	option add *BarResult.dimColor gray widgetDefault
23	option add *BarResult.controlBackground gray widgetDefault
24	option add *BarResult.font \
25	--helvetica-medium-r-normal--12-* widgetDefault
26
27	set autocolors {
28	#0000ff #ff0000 #00cc00
29	#cc00cc #ff9900 #cccc00
30	#000080 #800000 #006600
31	#660066 #996600 #666600
32	}
33	set autocolors {
34	#0000cd
35	#cd0000
36	#00cd00
37	#3a5fcd
38	#cdcd00
39	#cd1076
40	#009acd
41	#00c5cd
42	#a2b5cd
43	#7ac5cd
44	#66cdaa
45	#a2cd5a
46	#cd9b9b
47	#cdba96
48	#cd3333
49	#cd6600
50	#cd8c95
51	#cd00cd
52	#9a32cd
53	#6ca6cd
54	#9ac0cd
55	#9bcd9b
56	#00cd66
57	#cdc673
58	#cdad00
59	#cd5555
60	#cd853f
61	#cd7054
62	#cd5b45
63	#cd6889
64	#cd69c9
65	#551a8b
66	}
67
68	option add *BarResult.autoColors $autocolors widgetDefault
69	option add BarResultBalloon*Entry.background white widgetDefault
70
71	itcl::class Rappture::BarResult {
72	inherit itk::Widget
73
74	itk_option define -gridcolor gridColor GridColor ""
75	itk_option define -activecolor activeColor ActiveColor ""
76	itk_option define -dimcolor dimColor DimColor ""
77	itk_option define -autocolors autoColors AutoColors ""
78
79	constructor {args} { # defined below }
80	destructor { # defined below }
81
82	public method add {curve {settings ""}}
83	public method get {}
84	public method delete {args}
85	public method scale {args}
86	public method parameters {title args} {
87	# do nothing
88	}
89	public method download {option args}
90
91	protected method _rebuild {}
92	protected method _resetLimits {}
93	protected method _zoom {option args}
94	protected method _hilite {state x y}
95	protected method _axis {option args}
96	protected method _getAxes {xydata}
97	protected method _getLineMarkerOptions { style }
98	protected method _getTextMarkerOptions { style }
99	protected method _enterMarker { g name x y text }
100	protected method _leaveMarker { g name }
101	private method _formatTickLabel { w value }
102
103	private variable _dispatcher "" ;# dispatcher for !events
104	private variable _clist "" ;# list of curve objects
105	private variable _curve2color ;# maps curve => plotting color
106	private variable _curve2width ;# maps curve => line width
107	private variable _curve2dashes ;# maps curve => BLT -dashes list
108	private variable _curve2raise ;# maps curve => raise flag 0/1
109	private variable _curve2desc ;# maps curve => description of data
110	private variable _elem2curve ;# maps graph element => curve
111	private variable _label2axis ;# maps axis label => axis ID
112	private variable _limits ;# axis limits: x-min, x-max, etc.
113	private variable _autoColorI 0 ;# index for next "-color auto"
114
115	private variable _hilite ;# info for element currently highlighted
116	private variable _axis ;# info for axis manipulations
117	private variable _axisPopup ;# info for axis being edited in popup
118	common _downloadPopup ;# download options from popup
119	private variable _markers
120	private variable cur_ ""
121	private variable initialized_ 0
122	private variable _tickLabels
123	}
124
125	itk::usual BarResult {
126	keep -background -foreground -cursor -font
127	}
128
129	itk::usual Panedwindow {
130	keep -background -cursor
131	}
132
133	# ----------------------------------------------------------------------
134	# CONSTRUCTOR
135	# ----------------------------------------------------------------------
136	itcl::body Rappture::BarResult::constructor {args} {
137	Rappture::dispatcher _dispatcher
138	$_dispatcher register !rebuild
139	$_dispatcher dispatch $this !rebuild "[itcl::code $this _rebuild]; list"
140
141	array set _downloadPopup {
142	format csv
143	}
144
145	option add hull.width hull.height
146	pack propagate $itk_component(hull) no
147
148	itk_component add main {
149	Rappture::SidebarFrame $itk_interior.main
150	}
151	pack $itk_component(main) -expand yes -fill both
152	set f [$itk_component(main) component controls]
153
154	itk_component add reset {
155	button $f.reset -borderwidth 1 -padx 1 -pady 1 \
156	-highlightthickness 0 \
157	-image [Rappture::icon reset-view] \
158	-command [itcl::code $this _zoom reset]
159	} {
160	usual
161	ignore -borderwidth -highlightthickness
162	}
163	pack $itk_component(reset) -padx 4 -pady 2 -anchor e
164	Rappture::Tooltip::for $itk_component(reset) \
165	"Reset the view to the default zoom level"
166
167	set f [$itk_component(main) component frame]
168	itk_component add plot {
169	blt::barchart $f.plot \
170	-highlightthickness 0 -plotpadx 0 -plotpady 0 \
171	-barmode aligned -rightmargin 1
172	} {
173	keep -background -foreground -cursor -font
174	}
175	pack $itk_component(plot) -expand yes -fill both
176
177	$itk_component(plot) pen configure activeBar \
178	-borderwidth 2 -foreground black -background red
179
180	# Add bindings so you can mouse over points to see values:
181	bind $itk_component(plot) <Motion> \
182	[itcl::code $this _hilite at %x %y]
183	bind $itk_component(plot) <Leave> \
184	[itcl::code $this _hilite off %x %y]
185
186	# Add support for editing axes:
187	Rappture::Balloon $itk_component(hull).axes -title "Axis Options"
188	set inner [$itk_component(hull).axes component inner]
189
190	label $inner.labell -text "Label:"
191	entry $inner.label -width 15 -highlightbackground $itk_option(-background)
192	grid $inner.labell -row 1 -column 0 -sticky e
193	grid $inner.label -row 1 -column 1 -sticky ew -pady 4
194
195	label $inner.minl -text "Minimum:"
196	entry $inner.min -width 15 -highlightbackground $itk_option(-background)
197	grid $inner.minl -row 2 -column 0 -sticky e
198	grid $inner.min -row 2 -column 1 -sticky ew -pady 4
199
200	label $inner.maxl -text "Maximum:"
201	entry $inner.max -width 15 -highlightbackground $itk_option(-background)
202	grid $inner.maxl -row 3 -column 0 -sticky e
203	grid $inner.max -row 3 -column 1 -sticky ew -pady 4
204
205	label $inner.formatl -text "Format:"
206	Rappture::Combobox $inner.format -width 15 -editable no
207	$inner.format choices insert end \
208	"%.3g" "Auto" \
209	"%.0f" "X" \
210	"%.1f" "X.X" \
211	"%.2f" "X.XX" \
212	"%.3f" "X.XXX" \
213	"%.6f" "X.XXXXXX" \
214	"%.1e" "X.Xe+XX" \
215	"%.2e" "X.XXe+XX" \
216	"%.3e" "X.XXXe+XX" \
217	"%.6e" "X.XXXXXXe+XX"
218	grid $inner.formatl -row 4 -column 0 -sticky e
219	grid $inner.format -row 4 -column 1 -sticky ew -pady 4
220
221	label $inner.scalel -text "Scale:"
222	frame $inner.scales
223	radiobutton $inner.scales.linear -text "Linear" \
224	-variable [itcl::scope _axisPopup(scale)] -value "linear"
225	pack $inner.scales.linear -side left
226	radiobutton $inner.scales.log -text "Logarithmic" \
227	-variable [itcl::scope _axisPopup(scale)] -value "log"
228	pack $inner.scales.log -side left
229	grid $inner.scalel -row 5 -column 0 -sticky e
230	grid $inner.scales -row 5 -column 1 -sticky ew -pady 4
231
232	foreach axis {x y} {
233	set _axisPopup(format-$axis) "%.3g"
234	}
235	_axis scale x linear
236	_axis scale y linear
237
238	$itk_component(plot) legend configure -hide yes
239
240	#
241	# Add legend for editing hidden/elements:
242	#
243	set inner [$itk_component(main) insert end \
244	-title "Legend" \
245	-icon [Rappture::icon wrench]]
246	$inner configure -borderwidth 4
247
248	itk_component add legend {
249	Rappture::XyLegend $inner.legend $itk_component(plot)
250	}
251	pack $itk_component(legend) -expand yes -fill both
252
253	after idle [subst {
254	update idletasks
255	$itk_component(legend) reset
256	}]
257
258	# quick-and-dirty zoom functionality, for now...
259	Blt_ZoomStack $itk_component(plot)
260	eval itk_initialize $args
261
262	set _hilite(elem) ""
263	}
264
265	# ----------------------------------------------------------------------
266	# DESTRUCTOR
267	# ----------------------------------------------------------------------
268	itcl::body Rappture::BarResult::destructor {} {
269	}
270
271	# ----------------------------------------------------------------------
272	# USAGE: add <curve> ?<settings>?
273	#
274	# Clients use this to add a curve to the plot. The optional <settings>
275	# are used to configure the plot. Allowed settings are -color,
276	# -brightness, -width, -linestyle and -raise.
277	# ----------------------------------------------------------------------
278	itcl::body Rappture::BarResult::add {curve {settings ""}} {
279	array set params {
280	-color auto
281	-brightness 0
282	-width 1
283	-type "bar"
284	-raise 0
285	-linestyle solid
286	-description ""
287	-param ""
288	}
289	foreach {opt val} $settings {
290	if {![info exists params($opt)]} {
291	error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
292	}
293	set params($opt) $val
294	}
295
296	# if the color is "auto", then select a color from -autocolors
297	if {$params(-color) == "auto" \|\| $params(-color) == "autoreset"} {
298	if {$params(-color) == "autoreset"} {
299	set _autoColorI 0
300	}
301	set color [lindex $itk_option(-autocolors) $_autoColorI]
302	if {"" == $color} { set color black }
303	set params(-color) $color
304
305	# set up for next auto color
306	if {[incr _autoColorI] >= [llength $itk_option(-autocolors)]} {
307	set _autoColorI 0
308	}
309	}
310
311	# convert -linestyle to BLT -dashes
312	switch -- $params(-linestyle) {
313	dashed { set params(-linestyle) {4 4} }
314	dotted { set params(-linestyle) {2 4} }
315	default { set params(-linestyle) {} }
316	}
317
318	# if -brightness is set, then update the color
319	if {$params(-brightness) != 0} {
320	set params(-color) [Rappture::color::brightness \
321	$params(-color) $params(-brightness)]
322
323	set bg [$itk_component(plot) cget -plotbackground]
324	foreach {h s v} [Rappture::color::RGBtoHSV $bg] break
325	if {$v > 0.5} {
326	set params(-color) [Rappture::color::brightness_max \
327	$params(-color) 0.8]
328	} else {
329	set params(-color) [Rappture::color::brightness_min \
330	$params(-color) 0.2]
331	}
332	}
333
334	set pos [lsearch -exact $curve $_clist]
335	if {$pos < 0} {
336	lappend _clist $curve
337	set _curve2color($curve) $params(-color)
338	set _curve2width($curve) $params(-width)
339	set _curve2dashes($curve) $params(-linestyle)
340	set _curve2raise($curve) $params(-raise)
341	set _curve2desc($curve) $params(-description)
342
343	$_dispatcher event -idle !rebuild
344	}
345	}
346
347	# ----------------------------------------------------------------------
348	# USAGE: get
349	#
350	# Clients use this to query the list of objects being plotted, in
351	# order from bottom to top of this result.
352	# ----------------------------------------------------------------------
353	itcl::body Rappture::BarResult::get {} {
354	# put the dataobj list in order according to -raise options
355	set clist $_clist
356	foreach obj $clist {
357	if {[info exists _curve2raise($obj)] && $_curve2raise($obj)} {
358	set i [lsearch -exact $clist $obj]
359	if {$i >= 0} {
360	set clist [lreplace $clist $i $i]
361	lappend clist $obj
362	}
363	}
364	}
365	return $clist
366	}
367
368	# ----------------------------------------------------------------------
369	# USAGE: delete ?<curve1> <curve2> ...?
370	#
371	# Clients use this to delete a curve from the plot. If no curves
372	# are specified, then all curves are deleted.
373	# ----------------------------------------------------------------------
374	itcl::body Rappture::BarResult::delete {args} {
375	if {[llength $args] == 0} {
376	set args $_clist
377	}
378
379	# delete all specified curves
380	set changed 0
381	foreach curve $args {
382	set pos [lsearch -exact $_clist $curve]
383	if {$pos >= 0} {
384	set _clist [lreplace $_clist $pos $pos]
385	catch {unset _curve2color($curve)}
386	catch {unset _curve2width($curve)}
387	catch {unset _curve2dashes($curve)}
388	catch {unset _curve2raise($curve)}
389	foreach elem [array names _elem2curve] {
390	if {$_elem2curve($elem) == $curve} {
391	unset _elem2curve($elem)
392	}
393	}
394	set changed 1
395	}
396	}
397
398	# If anything changed, then rebuild the plot
399	if {$changed} {
400	$_dispatcher event -idle !rebuild
401	}
402
403	# Nothing left? then start over with auto colors
404	if {[llength $_clist] == 0} {
405	set _autoColorI 0
406	}
407	}
408
409	# ----------------------------------------------------------------------
410	# USAGE: scale ?<curve1> <curve2> ...?
411	#
412	# Sets the default limits for the overall plot according to the
413	# limits of the data for all of the given <curve> objects. This
414	# accounts for all curves--even those not showing on the screen.
415	# Because of this, the limits are appropriate for all curves as
416	# the user scans through data in the ResultSet viewer.
417	# ----------------------------------------------------------------------
418	itcl::body Rappture::BarResult::scale {args} {
419	set allx [$itk_component(plot) x2axis use]
420	lappend allx x ;# fix main x-axis too
421	foreach axis $allx {
422	_axis scale $axis linear
423	}
424
425	set ally [$itk_component(plot) y2axis use]
426	lappend ally y ;# fix main y-axis too
427	foreach axis $ally {
428	_axis scale $axis linear
429	}
430
431	catch {unset _limits}
432	foreach xydata $args {
433	# find the axes for this curve (e.g., {x y2})
434	foreach {map(x) map(y)} [_getAxes $xydata] break
435
436	foreach axis {x y} {
437	# get defaults for both linear and log scales
438	foreach type {lin log} {
439	# store results -- ex: _limits(x2log-min)
440	set id $map($axis)$type
441	foreach {min max} [$xydata limits $axis$type] break
442	if {"" != $min && "" != $max} {
443	if {![info exists _limits($id-min)]} {
444	set _limits($id-min) $min
445	set _limits($id-max) $max
446	} else {
447	if {$min < $_limits($id-min)} {
448	set _limits($id-min) $min
449	}
450	if {$max > $_limits($id-max)} {
451	set _limits($id-max) $max
452	}
453	}
454	}
455	}
456
457	if {[$xydata hints ${axis}scale] == "log"} {
458	_axis scale $map($axis) log
459	}
460	}
461	}
462	_resetLimits
463	}
464
465	# ----------------------------------------------------------------------
466	# USAGE: download coming
467	# USAGE: download controls <downloadCommand>
468	# USAGE: download now
469	#
470	# Clients use this method to create a downloadable representation
471	# of the plot. Returns a list of the form {ext string}, where
472	# "ext" is the file extension (indicating the type of data) and
473	# "string" is the data itself.
474	# ----------------------------------------------------------------------
475	itcl::body Rappture::BarResult::download {option args} {
476	switch $option {
477	coming {
478	# nothing to do
479	}
480	controls {
481	set popup .barresultdownload
482	if {![winfo exists .barresultdownload]} {
483	# if we haven't created the popup yet, do it now
484	Rappture::Balloon $popup -title "[Rappture::filexfer::label downloadWord] as..."
485	set inner [$popup component inner]
486	label $inner.summary -text "" -anchor w
487	pack $inner.summary -side top
488	radiobutton $inner.csv -text "Data as Comma-Separated Values" \
489	-variable Rappture::BarResult::_downloadPopup(format) \
490	-value csv
491	pack $inner.csv -anchor w
492	radiobutton $inner.pdf -text "Image as PDF/PostScript" \
493	-variable Rappture::BarResult::_downloadPopup(format) \
494	-value pdf
495	pack $inner.pdf -anchor w
496	radiobutton $inner.jpg -text "Image (draft)" \
497	-variable Rappture::BarResult::_downloadPopup(format) \
498	-value jpg
499	pack $inner.jpg -anchor w
500	button $inner.go -text [Rappture::filexfer::label download] \
501	-command [lindex $args 0]
502	pack $inner.go -pady 4
503	} else {
504	set inner [$popup component inner]
505	}
506	set num [llength [get]]
507	set num [expr {($num == 1) ? "1 result" : "$num results"}]
508	$inner.summary configure -text "[Rappture::filexfer::label downloadWord] $num in the following format:"
509	update idletasks ;# fix initial sizes
510	return $popup
511	}
512	now {
513	set popup .barresultdownload
514	if {[winfo exists .barresultdownload]} {
515	$popup deactivate
516	}
517	switch -- $_downloadPopup(format) {
518	csv {
519	# reverse the objects so the selected data appears on top
520	set dlist ""
521	foreach dataobj [get] {
522	set dlist [linsert $dlist 0 $dataobj]
523	}
524
525	# generate the comma-separated value data for these objects
526	set csvdata ""
527	foreach dataobj $dlist {
528	append csvdata "[string repeat - 60]\n"
529	append csvdata " [$dataobj hints label]\n"
530	if {[info exists _curve2desc($dataobj)]
531	&& [llength [split $_curve2desc($dataobj) \n]] > 1} {
532	set indent "for:"
533	foreach line [split $_curve2desc($dataobj) \n] {
534	append csvdata " $indent $line\n"
535	set indent " "
536	}
537	}
538	append csvdata "[string repeat - 60]\n"
539
540	append csvdata "[$dataobj hints xlabel], [$dataobj hints ylabel]\n"
541	set first 1
542	foreach comp [$dataobj components] {
543	if {!$first} {
544	# blank line between components
545	append csvdata "\n"
546	}
547	set xv [$dataobj mesh $comp]
548	set yv [$dataobj values $comp]
549	foreach x [$xv range 0 end] y [$yv range 0 end] {
550	append csvdata [format "%20.15g, %20.15g\n" $x $y]
551	}
552	set first 0
553	}
554	append csvdata "\n"
555	}
556	return [list .txt $csvdata]
557	}
558	pdf {
559	set psdata [$itk_component(plot) postscript output \
560	-decorations no]
561
562	set cmds {
563	set fout "xy[pid].pdf"
564	exec ps2pdf - $fout << $psdata
565
566	set fid [open $fout r]
567	fconfigure $fid -translation binary -encoding binary
568	set pdfdata [read $fid]
569	close $fid
570
571	file delete -force $fout
572	}
573	if {[catch $cmds result] == 0} {
574	return [list .pdf $pdfdata]
575	}
576	return [list .ps $psdata]
577	}
578	jpg {
579	set img [image create picture]
580	$itk_component(plot) snap $img
581	$img export jpg -quality 100 -data bytes
582	image delete $img
583	return [list .jpg $bytes]
584	}
585	png {
586	set img [image create picture]
587	$itk_component(plot) snap $img
588	$img export png -data bytes
589	image delete $img
590	return [list .png $bytes]
591	}
592	}
593	}
594	default {
595	error "bad option \"$option\": should be coming, controls, now"
596	}
597	}
598	}
599
600	# ----------------------------------------------------------------------
601	# USAGE: _rebuild
602	#
603	# Called automatically whenever something changes that affects the
604	# data in the widget. Clears any existing data and rebuilds the
605	# widget to display new data.
606	# ----------------------------------------------------------------------
607	itcl::body Rappture::BarResult::_rebuild {} {
608	set g $itk_component(plot)
609
610	# first clear out the widget
611	eval $g element delete [$g element names]
612	foreach axis [$g axis names] {
613	$g axis configure $axis -hide yes -checklimits no -loose yes
614	}
615	# Presumably you want at least an X-axis and Y-axis displayed.
616	$g xaxis configure -hide no
617	$g yaxis configure -hide no
618	array unset _label2axis
619
620	#
621	# Scan through all objects and create a list of all axes.
622	# The first x-axis gets mapped to "x". The second, to "x2".
623	# Beyond that, we must create new axes "x3", "x4", etc.
624	# We do the same for y.
625	#
626	set anum(x) 0
627	set anum(y) 0
628	foreach xydata [get] {
629	foreach ax {x y} {
630	set label [$xydata hints ${ax}label]
631	if {"" != $label} {
632	if {![info exists _label2axis($ax-$label)]} {
633	switch [incr anum($ax)] {
634	1 { set axis $ax }
635	2 { set axis ${ax}2 }
636	default {
637	set axis $ax$anum($ax)
638	catch {$g axis create $axis}
639	}
640	}
641	$g axis configure $axis -title $label -hide no \
642	-checklimits no
643	set _label2axis($ax-$label) $axis
644
645	# if this axis has a description, add it as a tooltip
646	set desc [string trim [$xydata hints ${ax}desc]]
647	Rappture::Tooltip::text $g-$axis $desc
648	}
649	}
650	}
651	}
652
653	#
654	# All of the extra axes get mapped to the x2/y2 (top/right)
655	# position.
656	#
657	set all ""
658	foreach ax {x y} {
659	lappend all $ax
660
661	set extra ""
662	for {set i 2} {$i <= $anum($ax)} {incr i} {
663	lappend extra ${ax}$i
664	}
665	eval lappend all $extra
666	$g ${ax}2axis use $extra
667	if {$ax == "y"} {
668	$g configure -rightmargin [expr {($extra == "") ? 10 : 0}]
669	}
670	}
671
672	foreach axis $all {
673	set _axisPopup(format-$axis) "%.3g"
674
675	$g axis bind $axis <Enter> \
676	[itcl::code $this _axis hilite $axis on]
677	$g axis bind $axis <Leave> \
678	[itcl::code $this _axis hilite $axis off]
679	$g axis bind $axis <ButtonPress> \
680	[itcl::code $this _axis click $axis %x %y]
681	$g axis bind $axis <B1-Motion> \
682	[itcl::code $this _axis drag $axis %x %y]
683	$g axis bind $axis <ButtonRelease> \
684	[itcl::code $this _axis release $axis %x %y]
685	$g axis bind $axis <KeyPress> \
686	[list ::Rappture::Tooltip::tooltip cancel]
687	}
688
689	#
690	# Plot all of the curves.
691	#
692	set count 0
693	foreach xydata $_clist {
694	set label [$xydata hints label]
695	foreach {mapx mapy} [_getAxes $xydata] break
696
697	foreach comp [$xydata components] {
698	set xv [$xydata mesh $comp]
699	set yv [$xydata values $comp]
700
701	if {[info exists _curve2color($xydata)]} {
702	set color $_curve2color($xydata)
703	} else {
704	set color [$xydata hints color]
705	if {"" == $color} {
706	set color black
707	}
708	}
709
710	if {[info exists _curve2width($xydata)]} {
711	set lwidth $_curve2width($xydata)
712	} else {
713	set lwidth 2
714	}
715
716	if {[info exists _curve2dashes($xydata)]} {
717	set dashes $_curve2dashes($xydata)
718	} else {
719	set dashes ""
720	}
721
722	if {([$xv length] <= 1) \|\| ($lwidth == 0)} {
723	set sym square
724	set pixels 2
725	} else {
726	set sym ""
727	set pixels 6
728	}
729
730	set elem "elem[incr count]"
731	set _elem2curve($elem) $xydata
732	set labels [$xydata hints xticks]
733	if { $labels != "" } {
734	$g axis configure $mapx \
735	-command [itcl::code $this _formatTickLabel] \
736	-minorticks 0
737	set _tickLabels $labels
738	}
739	$g element create $elem -x $xv -y $yv \
740	-borderwidth $lwidth -label $label \
741	-background $color -foreground $color -mapx $mapx -mapy $mapy
742	}
743	}
744
745	foreach xydata $_clist {
746	set xmin -Inf
747	set ymin -Inf
748	set xmax Inf
749	set ymax Inf
750	#
751	# Create text/line markers for each *axis.marker specified.
752	#
753	foreach m [$xydata xmarkers] {
754	foreach {at label style} $m break
755	set id [$g marker create line -coords [list $at $ymin $at $ymax]]
756	$g marker bind $id <Enter> \
757	[itcl::code $this _enterMarker $g x-$label $at $ymin $at]
758	$g marker bind $id <Leave> \
759	[itcl::code $this _leaveMarker $g x-$label]
760	set options [_getLineMarkerOptions $style]
761	if { $options != "" } {
762	eval $g marker configure $id $options
763	}
764	if { $label != "" } {
765	set id [$g marker create text -anchor nw \
766	-text $label -coords [list $at $ymax]]
767	set options [_getTextMarkerOptions $style]
768	if { $options != "" } {
769	eval $g marker configure $id $options
770	}
771	}
772	}
773	foreach m [$xydata ymarkers] {
774	foreach {at label style} $m break
775	set id [$g marker create line -coords [list $xmin $at $xmax $at]]
776	$g marker bind $id <Enter> \
777	[itcl::code $this _enterMarker $g y-$label $at $xmin $at]
778	$g marker bind $id <Leave> \
779	[itcl::code $this _leaveMarker $g y-$label]
780	set options [_getLineMarkerOptions $style]
781	if { $options != "" } {
782	eval $g marker configure $id $options
783	}
784	if { $label != "" } {
785	set id [$g marker create text -anchor se \
786	-text $label -coords [list $xmax $at]]
787	set options [_getTextMarkerOptions $style]
788	if { $options != "" } {
789	eval $g marker configure $id $options
790	}
791	}
792	}
793	}
794	$itk_component(legend) reset
795	}
796
797	# ----------------------------------------------------------------------
798	# USAGE: _resetLimits
799	#
800	# Used internally to apply automatic limits to the axes for the
801	# current plot.
802	# ----------------------------------------------------------------------
803	itcl::body Rappture::BarResult::_resetLimits {} {
804	set g $itk_component(plot)
805	foreach axis [$g axis names] {
806	$g axis configure $axis -min "" -max ""
807	}
808	return
809
810	#
811	# HACK ALERT!
812	# Use this code to fix up the y-axis limits for the BLT graph.
813	# The auto-limits don't always work well. We want them to be
814	# set to a "nice" number slightly above or below the min/max
815	# limits.
816	#
817	foreach axis [$g axis names] {
818	if {[info exists _limits(${axis}lin-min)]} {
819	set log [$g axis cget $axis -logscale]
820	if {$log} {
821	set min $_limits(${axis}log-min)
822	if {$min == 0} { set min 1 }
823	set max $_limits(${axis}log-max)
824	if {$max == 0} { set max 1 }
825
826	if {$min == $max} {
827	set logmin [expr {floor(log10(abs(0.9*$min)))}]
828	set logmax [expr {ceil(log10(abs(1.1*$max)))}]
829	} else {
830	set logmin [expr {floor(log10(abs($min)))}]
831	set logmax [expr {ceil(log10(abs($max)))}]
832	if {[string match y* $axis]} {
833	# add a little padding
834	set delta [expr {$logmax-$logmin}]
835	if {$delta == 0} { set delta 1 }
836	set logmin [expr {$logmin-0.05*$delta}]
837	set logmax [expr {$logmax+0.05*$delta}]
838	}
839	}
840	if {$logmin < -300} {
841	set min 1e-300
842	} elseif {$logmin > 300} {
843	set min 1e+300
844	} else {
845	set min [expr {pow(10.0,$logmin)}]
846	}
847
848	if {$logmax < -300} {
849	set max 1e-300
850	} elseif {$logmax > 300} {
851	set max 1e+300
852	} else {
853	set max [expr {pow(10.0,$logmax)}]
854	}
855	} else {
856	set min $_limits(${axis}lin-min)
857	set max $_limits(${axis}lin-max)
858
859	if {[string match y* $axis]} {
860	# add a little padding
861	set delta [expr {$max-$min}]
862	set min [expr {$min-0.05*$delta}]
863	set max [expr {$max+0.05*$delta}]
864	}
865	}
866	if {$min < $max} {
867	$g axis configure $axis -min $min -max $max
868	} else {
869	$g axis configure $axis -min "" -max ""
870	}
871	} else {
872	$g axis configure $axis -min "" -max ""
873	}
874	}
875	}
876
877	# ----------------------------------------------------------------------
878	# USAGE: _zoom reset
879	#
880	# Called automatically when the user clicks on one of the zoom
881	# controls for this widget. Changes the zoom for the current view.
882	# ----------------------------------------------------------------------
883	itcl::body Rappture::BarResult::_zoom {option args} {
884	switch -- $option {
885	reset {
886	_resetLimits
887	}
888	}
889	}
890
891	# ----------------------------------------------------------------------
892	# USAGE: _hilite <state> <x> <y>
893	#
894	# Called automatically when the user brushes one of the elements
895	# on the plot. Causes the element to highlight and a tooltip to
896	# pop up with element info.
897	# ----------------------------------------------------------------------
898	itcl::body Rappture::BarResult::_hilite {state x y} {
899	set g $itk_component(plot)
900	set elem ""
901
902	# Peek inside of Blt_ZoomStack package to see if we're currently in the
903	# middle of a zoom selection.
904	if {[info exists ::zoomInfo($g,corner)] && $::zoomInfo($g,corner) == "B" } {
905	return;
906	}
907	set tip ""
908	if {$state == "at"} {
909	if {[$g element closest $x $y info -interpolate yes]} {
910	# for dealing with xy line plots
911	set elem $info(name)
912
913	# Some elements are generated dynamically and therefore will
914	# not have a curve object associated with them.
915	set mapx [$g element cget $elem -mapx]
916	set mapy [$g element cget $elem -mapy]
917	if {[info exists _elem2curve($elem)]} {
918	foreach {mapx mapy} [_getAxes $_elem2curve($elem)] break
919	}
920
921	# search again for an exact point -- this time don't interpolate
922	set tip ""
923	array unset info
924	if {[$g element closest $x $y info -interpolate no]
925	&& $info(name) == $elem} {
926
927	set x [$g axis transform $mapx $info(x)]
928	set y [$g axis transform $mapy $info(y)]
929
930	if {[info exists _elem2curve($elem)]} {
931	set curve $_elem2curve($elem)
932	set yunits [$curve hints yunits]
933	set xunits [$curve hints xunits]
934	} else {
935	set xunits ""
936	set yunits ""
937	}
938	set tip [$g element cget $elem -label]
939	set yval [_axis format y dummy $info(y)]
940	append tip "\n$yval$yunits"
941	set xval [_axis format x dummy $info(x)]
942	append tip " @ $xval$xunits"
943	set tip [string trim $tip]
944	}
945	set state 1
946	} elseif {[$g element closest $x $y info -interpolate no]} {
947	# for dealing with xy scatter plot
948	set elem $info(name)
949
950	# Some elements are generated dynamically and therefore will
951	# not have a curve object associated with them.
952	set mapx [$g element cget $elem -mapx]
953	set mapy [$g element cget $elem -mapy]
954	if {[info exists _elem2curve($elem)]} {
955	foreach {mapx mapy} [_getAxes $_elem2curve($elem)] break
956	}
957
958	set tip ""
959	set x [$g axis transform $mapx $info(x)]
960	set y [$g axis transform $mapy $info(y)]
961
962	if {[info exists _elem2curve($elem)]} {
963	set curve $_elem2curve($elem)
964	set yunits [$curve hints yunits]
965	set xunits [$curve hints xunits]
966	} else {
967	set xunits ""
968	set yunits ""
969	}
970	set tip [$g element cget $elem -label]
971	set yval [_axis format y dummy $info(y)]
972	append tip "\n$yval$yunits"
973	set xval [_axis format x dummy $info(x)]
974	append tip " @ $xval$xunits"
975	set tip [string trim $tip]
976	set state 1
977	} else {
978	set state 0
979	}
980	}
981
982	if {$state} {
983	#
984	# Highlight ON:
985	# - activate trace
986	# - multiple axes? dim other axes
987	# - pop up tooltip about data
988	#
989	if { [$g element exists $_hilite(elem)] && $_hilite(elem) != $elem } {
990	$g element deactivate $_hilite(elem)
991	$g crosshairs configure -hide yes
992	Rappture::Tooltip::tooltip cancel
993	}
994	set bg [$g element cget $elem -background]
995	set fg [$g element cget $elem -background]
996	foreach {h s v} [Rappture::color::RGBtoHSV $fg] break
997	if { $v > 0.2 } {
998	set v [expr $v - 0.2]
999	}
1000	set fg [Rappture::color::HSVtoRGB $h $s $v]
1001	$g pen configure activeBar -background $bg -foreground $fg
1002	$g element activate $elem
1003	set _hilite(elem) $elem
1004
1005	set mapx [$g element cget $elem -mapx]
1006	set mapy [$g element cget $elem -mapy]
1007	if {[info exists _elem2curve($elem)]} {
1008	foreach {mapx mapy} [_getAxes $_elem2curve($elem)] break
1009	}
1010	set allx [$g x2axis use]
1011	if {[llength $allx] > 0} {
1012	lappend allx x ;# fix main x-axis too
1013	foreach axis $allx {
1014	if {$axis == $mapx} {
1015	$g axis configure $axis -color $itk_option(-foreground) \
1016	-titlecolor $itk_option(-foreground)
1017	} else {
1018	$g axis configure $axis -color $itk_option(-dimcolor) \
1019	-titlecolor $itk_option(-dimcolor)
1020	}
1021	}
1022	}
1023	set ally [$g y2axis use]
1024	if {[llength $ally] > 0} {
1025	lappend ally y ;# fix main y-axis too
1026	foreach axis $ally {
1027	if {$axis == $mapy} {
1028	$g axis configure $axis -color $itk_option(-foreground) \
1029	-titlecolor $itk_option(-foreground)
1030	} else {
1031	$g axis configure $axis -color $itk_option(-dimcolor) \
1032	-titlecolor $itk_option(-dimcolor)
1033	}
1034	}
1035	}
1036
1037	if {"" != $tip} {
1038	$g crosshairs configure -hide no -position @$x,$y
1039
1040	if {$x > 0.5*[winfo width $g]} {
1041	if {$x < 4} {
1042	set tipx "-0"
1043	} else {
1044	set tipx "-[expr {$x-4}]" ;# move tooltip to the left
1045	}
1046	} else {
1047	if {$x < -4} {
1048	set tipx "+0"
1049	} else {
1050	set tipx "+[expr {$x+4}]" ;# move tooltip to the right
1051	}
1052	}
1053	if {$y > 0.5*[winfo height $g]} {
1054	if {$y < 4} {
1055	set tipy "-0"
1056	} else {
1057	set tipy "-[expr {$y-4}]" ;# move tooltip to the top
1058	}
1059	} else {
1060	if {$y < -4} {
1061	set tipy "+0"
1062	} else {
1063	set tipy "+[expr {$y+4}]" ;# move tooltip to the bottom
1064	}
1065	}
1066	Rappture::Tooltip::text $g $tip
1067	Rappture::Tooltip::tooltip show $g $tipx,$tipy
1068	}
1069	} else {
1070	#
1071	# Highlight OFF:
1072	# - deactivate (color back to normal)
1073	# - put all axes back to normal color
1074	# - take down tooltip
1075	#
1076	if { [$g element exists $_hilite(elem)] } {
1077	$g element deactivate $_hilite(elem)
1078	}
1079	set allx [$g x2axis use]
1080	if {[llength $allx] > 0} {
1081	lappend allx x ;# fix main x-axis too
1082	foreach axis $allx {
1083	$g axis configure $axis -color $itk_option(-foreground) \
1084	-titlecolor $itk_option(-foreground)
1085	}
1086	}
1087
1088	set ally [$g y2axis use]
1089	if {[llength $ally] > 0} {
1090	lappend ally y ;# fix main y-axis too
1091	foreach axis $ally {
1092	$g axis configure $axis -color $itk_option(-foreground) \
1093	-titlecolor $itk_option(-foreground)
1094	}
1095	}
1096
1097	$g crosshairs configure -hide yes
1098
1099	# only cancel in plotting area or we'll mess up axes
1100	if {[$g inside $x $y]} {
1101	Rappture::Tooltip::tooltip cancel
1102	}
1103
1104	# There is no currently highlighted element
1105	set _hilite(elem) ""
1106	}
1107	}
1108
1109	# ----------------------------------------------------------------------
1110	# USAGE: _axis hilite <axis> <state>
1111	#
1112	# USAGE: _axis click <axis> <x> <y>
1113	# USAGE: _axis drag <axis> <x> <y>
1114	# USAGE: _axis release <axis> <x> <y>
1115	#
1116	# USAGE: _axis edit <axis>
1117	# USAGE: _axis changed <axis> <what>
1118	# USAGE: _axis format <axis> <widget> <value>
1119	# USAGE: _axis scale <axis> linear\|log
1120	#
1121	# Used internally to handle editing of the x/y axes. The hilite
1122	# operation causes the axis to light up. The edit operation pops
1123	# up a panel with editing options. The changed operation applies
1124	# changes from the panel.
1125	# ----------------------------------------------------------------------
1126	itcl::body Rappture::BarResult::_axis {option args} {
1127	set inner [$itk_component(hull).axes component inner]
1128
1129	switch -- $option {
1130	hilite {
1131	if {[llength $args] != 2} {
1132	error "wrong # args: should be \"_axis hilite axis state\""
1133	}
1134	set g $itk_component(plot)
1135	set axis [lindex $args 0]
1136	set state [lindex $args 1]
1137
1138	if {$state} {
1139	$g axis configure $axis \
1140	-color $itk_option(-activecolor) \
1141	-titlecolor $itk_option(-activecolor)
1142
1143	set x [expr {[winfo pointerx $g]+4}]
1144	set y [expr {[winfo pointery $g]+4}]
1145	Rappture::Tooltip::tooltip pending $g-$axis @$x,$y
1146	} else {
1147	$g axis configure $axis \
1148	-color $itk_option(-foreground) \
1149	-titlecolor $itk_option(-foreground)
1150	Rappture::Tooltip::tooltip cancel
1151	}
1152	}
1153	click {
1154	if {[llength $args] != 3} {
1155	error "wrong # args: should be \"_axis click axis x y\""
1156	}
1157	set axis [lindex $args 0]
1158	set x [lindex $args 1]
1159	set y [lindex $args 2]
1160	set g $itk_component(plot)
1161
1162	set _axis(moved) 0
1163	set _axis(click-x) $x
1164	set _axis(click-y) $y
1165	foreach {min max} [$g axis limits $axis] break
1166	set _axis(min0) $min
1167	set _axis(max0) $max
1168	Rappture::Tooltip::tooltip cancel
1169	}
1170	drag {
1171	if {[llength $args] != 3} {
1172	error "wrong # args: should be \"_axis drag axis x y\""
1173	}
1174	if {![info exists _axis(moved)]} {
1175	return ;# must have skipped click event -- ignore
1176	}
1177	set axis [lindex $args 0]
1178	set x [lindex $args 1]
1179	set y [lindex $args 2]
1180	set g $itk_component(plot)
1181
1182	if {[info exists _axis(click-x)] && [info exists _axis(click-y)]} {
1183	foreach {x0 y0 pw ph} [$g extents plotarea] break
1184	switch -glob $axis {
1185	x* {
1186	set pix $x
1187	set pix0 $_axis(click-x)
1188	set pixmin $x0
1189	set pixmax [expr {$x0+$pw}]
1190	}
1191	y* {
1192	set pix $y
1193	set pix0 $_axis(click-y)
1194	set pixmin [expr {$y0+$ph}]
1195	set pixmax $y0
1196	}
1197	}
1198	set log [$g axis cget $axis -logscale]
1199	set min $_axis(min0)
1200	set max $_axis(max0)
1201	set dpix [expr {abs($pix-$pix0)}]
1202	set v0 [$g axis invtransform $axis $pixmin]
1203	set v1 [$g axis invtransform $axis [expr {$pixmin+$dpix}]]
1204	if {$log} {
1205	set v0 [expr {log10($v0)}]
1206	set v1 [expr {log10($v1)}]
1207	set min [expr {log10($min)}]
1208	set max [expr {log10($max)}]
1209	}
1210
1211	if {$pix > $pix0} {
1212	set delta [expr {$v1-$v0}]
1213	} else {
1214	set delta [expr {$v0-$v1}]
1215	}
1216	set min [expr {$min-$delta}]
1217	set max [expr {$max-$delta}]
1218	if {$log} {
1219	set min [expr {pow(10.0,$min)}]
1220	set max [expr {pow(10.0,$max)}]
1221	}
1222	$g axis configure $axis -min $min -max $max
1223
1224	# move axis, don't edit on release
1225	set _axis(move) 1
1226	}
1227	}
1228	release {
1229	if {[llength $args] != 3} {
1230	error "wrong # args: should be \"_axis release axis x y\""
1231	}
1232	if {![info exists _axis(moved)]} {
1233	return ;# must have skipped click event -- ignore
1234	}
1235	set axis [lindex $args 0]
1236	set x [lindex $args 1]
1237	set y [lindex $args 2]
1238
1239	if {!$_axis(moved)} {
1240	# small movement? then treat as click -- pop up axis editor
1241	set dx [expr {abs($x-$_axis(click-x))}]
1242	set dy [expr {abs($y-$_axis(click-y))}]
1243	if {$dx < 2 && $dy < 2} {
1244	_axis edit $axis
1245	}
1246	} else {
1247	# one last movement
1248	_axis drag $axis $x $y
1249	}
1250	catch {unset _axis}
1251	}
1252	edit {
1253	if {[llength $args] != 1} {
1254	error "wrong # args: should be \"_axis edit axis\""
1255	}
1256	set axis [lindex $args 0]
1257	set _axisPopup(current) $axis
1258
1259	# apply last value when deactivating
1260	$itk_component(hull).axes configure -deactivatecommand \
1261	[itcl::code $this _axis changed $axis focus]
1262
1263	# fix axis label controls...
1264	set label [$itk_component(plot) axis cget $axis -title]
1265	$inner.label delete 0 end
1266	$inner.label insert end $label
1267	bind $inner.label <KeyPress-Return> \
1268	[itcl::code $this _axis changed $axis label]
1269	bind $inner.label <FocusOut> \
1270	[itcl::code $this _axis changed $axis label]
1271
1272	# fix min/max controls...
1273	foreach {min max} [$itk_component(plot) axis limits $axis] break
1274	$inner.min delete 0 end
1275	$inner.min insert end $min
1276	bind $inner.min <KeyPress-Return> \
1277	[itcl::code $this _axis changed $axis min]
1278	bind $inner.min <FocusOut> \
1279	[itcl::code $this _axis changed $axis min]
1280
1281	$inner.max delete 0 end
1282	$inner.max insert end $max
1283	bind $inner.max <KeyPress-Return> \
1284	[itcl::code $this _axis changed $axis max]
1285	bind $inner.max <FocusOut> \
1286	[itcl::code $this _axis changed $axis max]
1287
1288	# fix format control...
1289	set fmts [$inner.format choices get -value]
1290	set i [lsearch -exact $fmts $_axisPopup(format-$axis)]
1291	if {$i < 0} { set i 0 } ;# use Auto choice
1292	$inner.format value [$inner.format choices get -label $i]
1293
1294	bind $inner.format <<Value>> \
1295	[itcl::code $this _axis changed $axis format]
1296
1297	# fix scale control...
1298	if {[$itk_component(plot) axis cget $axis -logscale]} {
1299	set _axisPopup(scale) "log"
1300	$inner.format configure -state disabled
1301	} else {
1302	set _axisPopup(scale) "linear"
1303	$inner.format configure -state normal
1304	}
1305	$inner.scales.linear configure \
1306	-command [itcl::code $this _axis changed $axis scale]
1307	$inner.scales.log configure \
1308	-command [itcl::code $this _axis changed $axis scale]
1309
1310	#
1311	# Figure out where the window should pop up.
1312	#
1313	set x [winfo rootx $itk_component(plot)]
1314	set y [winfo rooty $itk_component(plot)]
1315	set w [winfo width $itk_component(plot)]
1316	set h [winfo height $itk_component(plot)]
1317	foreach {x0 y0 pw ph} [$itk_component(plot) extents plotarea] break
1318	switch -glob -- $axis {
1319	x {
1320	set x [expr {round($x + $x0+0.5*$pw)}]
1321	set y [expr {round($y + $y0+$ph + 0.5*($h-$y0-$ph))}]
1322	set dir "above"
1323	}
1324	x* {
1325	set x [expr {round($x + $x0+0.5*$pw)}]
1326	set dir "below"
1327	set allx [$itk_component(plot) x2axis use]
1328	set max [llength $allx]
1329	set i [lsearch -exact $allx $axis]
1330	set y [expr {round($y + ($i+0.5)*$y0/double($max))}]
1331	}
1332	y {
1333	set x [expr {round($x + 0.5*$x0)}]
1334	set y [expr {round($y + $y0+0.5*$ph)}]
1335	set dir "right"
1336	}
1337	y* {
1338	set y [expr {round($y + $y0+0.5*$ph)}]
1339	set dir "left"
1340	set ally [$itk_component(plot) y2axis use]
1341	set max [llength $ally]
1342	set i [lsearch -exact $ally $axis]
1343	set y [expr {round($y + ($i+0.5)*$y0/double($max))}]
1344	set x [expr {round($x+$x0+$pw + ($i+0.5)*($w-$x0-$pw)/double($max))}]
1345	}
1346	}
1347	$itk_component(hull).axes activate @$x,$y $dir
1348	}
1349	changed {
1350	if {[llength $args] != 2} {
1351	error "wrong # args: should be \"_axis changed axis what\""
1352	}
1353	set axis [lindex $args 0]
1354	set what [lindex $args 1]
1355	if {$what == "focus"} {
1356	set what [focus]
1357	if {[winfo exists $what]} {
1358	set what [winfo name $what]
1359	}
1360	}
1361
1362	switch -- $what {
1363	label {
1364	set val [$inner.label get]
1365	$itk_component(plot) axis configure $axis -title $val
1366	}
1367	min {
1368	set val [$inner.min get]
1369	if {![string is double -strict $val]} {
1370	Rappture::Tooltip::cue $inner.min "Must be a number"
1371	bell
1372	return
1373	}
1374
1375	set max [lindex [$itk_component(plot) axis limits $axis] 1]
1376	if {$val >= $max} {
1377	Rappture::Tooltip::cue $inner.min "Must be <= max ($max)"
1378	bell
1379	return
1380	}
1381	catch {
1382	# can fail in log mode
1383	$itk_component(plot) axis configure $axis -min $val
1384	}
1385	foreach {min max} [$itk_component(plot) axis limits $axis] break
1386	$inner.min delete 0 end
1387	$inner.min insert end $min
1388	}
1389	max {
1390	set val [$inner.max get]
1391	if {![string is double -strict $val]} {
1392	Rappture::Tooltip::cue $inner.max "Should be a number"
1393	bell
1394	return
1395	}
1396
1397	set min [lindex [$itk_component(plot) axis limits $axis] 0]
1398	if {$val <= $min} {
1399	Rappture::Tooltip::cue $inner.max "Must be >= min ($min)"
1400	bell
1401	return
1402	}
1403	catch {
1404	# can fail in log mode
1405	$itk_component(plot) axis configure $axis -max $val
1406	}
1407	foreach {min max} [$itk_component(plot) axis limits $axis] break
1408	$inner.max delete 0 end
1409	$inner.max insert end $max
1410	}
1411	format {
1412	set fmt [$inner.format translate [$inner.format value]]
1413	set _axisPopup(format-$axis) $fmt
1414
1415	# force a refresh
1416	$itk_component(plot) axis configure $axis -min \
1417	[$itk_component(plot) axis cget $axis -min]
1418	}
1419	scale {
1420	_axis scale $axis $_axisPopup(scale)
1421
1422	if {$_axisPopup(scale) == "log"} {
1423	$inner.format configure -state disabled
1424	} else {
1425	$inner.format configure -state normal
1426	}
1427
1428	foreach {min max} [$itk_component(plot) axis limits $axis] break
1429	$inner.min delete 0 end
1430	$inner.min insert end $min
1431	$inner.max delete 0 end
1432	$inner.max insert end $max
1433	}
1434	default {
1435	# be lenient so we can handle the "focus" case
1436	}
1437	}
1438	}
1439	format {
1440	if {[llength $args] != 3} {
1441	error "wrong # args: should be \"_axis format axis widget value\""
1442	}
1443	set axis [lindex $args 0]
1444	set value [lindex $args 2]
1445
1446	if {[$itk_component(plot) axis cget $axis -logscale]} {
1447	set fmt "%.3g"
1448	} else {
1449	set fmt $_axisPopup(format-$axis)
1450	}
1451	return [format $fmt $value]
1452	}
1453	scale {
1454	if {[llength $args] != 2} {
1455	error "wrong # args: should be \"_axis scale axis type\""
1456	}
1457	set axis [lindex $args 0]
1458	set type [lindex $args 1]
1459
1460	if {$type == "log"} {
1461	catch {$itk_component(plot) axis configure $axis -logscale 1}
1462	# leave format alone in log mode
1463	$itk_component(plot) axis configure $axis -command ""
1464	} else {
1465	catch {$itk_component(plot) axis configure $axis -logscale 0}
1466	# use special formatting for linear mode
1467	$itk_component(plot) axis configure $axis -command \
1468	[itcl::code $this _axis format $axis]
1469	}
1470	}
1471	default {
1472	error "bad option \"$option\": should be changed, edit, hilite, or format"
1473	}
1474	}
1475	}
1476
1477
1478	# ----------------------------------------------------------------------
1479	# USAGE: _getLineMarkerOptions <style>
1480	#
1481	# Used internally to create a list of configuration options specific to the
1482	# axis line marker. The input is a list of name value pairs. Options that
1483	# are not recognized are ignored.
1484	# ----------------------------------------------------------------------
1485	itcl::body Rappture::BarResult::_getLineMarkerOptions {style} {
1486	array set lineOptions {
1487	"-color" "-color"
1488	"-dashes" "-dashes"
1489	"-linecolor" "-foreground"
1490	"-linewidth" "-borderwidth"
1491	}
1492	set options {}
1493	foreach {name value} $style {
1494	if { [info exists lineOptions($name)] } {
1495	lappend options $lineOptions($name) $value
1496	}
1497	}
1498	return $options
1499	}
1500
1501	# ----------------------------------------------------------------------
1502	# USAGE: _getTextMarkerOptions <style>
1503	#
1504	# Used internally to create a list of configuration options specific to the
1505	# axis text marker. The input is a list of name value pairs. Options that
1506	# are not recognized are ignored.
1507	# ----------------------------------------------------------------------
1508	itcl::body Rappture::BarResult::_getTextMarkerOptions {style} {
1509	array set textOptions {
1510	"-color" "-outline"
1511	"-textcolor" "-outline"
1512	"-font" "-font"
1513	"-xoffset" "-xoffset"
1514	"-yoffset" "-yoffset"
1515	"-anchor" "-anchor"
1516	}
1517	set options {}
1518	foreach {name value} $style {
1519	if { [info exists textOptions($name)] } {
1520	lappend options $textOptions($name) $value
1521	}
1522	}
1523	return $options
1524	}
1525
1526	# ----------------------------------------------------------------------
1527	# USAGE: _getAxes <curveObj>
1528	#
1529	# Used internally to figure out the axes used to plot the given
1530	# <curveObj>. Returns a list of the form {x y}, where x is the
1531	# x-axis name (x, x2, x3, etc.), and y is the y-axis name.
1532	# ----------------------------------------------------------------------
1533	itcl::body Rappture::BarResult::_getAxes {xydata} {
1534	# rebuild if needed, so we know about the axes
1535	if {[$_dispatcher ispending !rebuild]} {
1536	$_dispatcher cancel !rebuild
1537	$_dispatcher event -now !rebuild
1538	}
1539
1540	# what is the x axis? x? x2? x3? ...
1541	set xlabel [$xydata hints xlabel]
1542	if {[info exists _label2axis(x-$xlabel)]} {
1543	set mapx $_label2axis(x-$xlabel)
1544	} else {
1545	set mapx "x"
1546	}
1547
1548	# what is the y axis? y? y2? y3? ...
1549	set ylabel [$xydata hints ylabel]
1550	if {[info exists _label2axis(y-$ylabel)]} {
1551	set mapy $_label2axis(y-$ylabel)
1552	} else {
1553	set mapy "y"
1554	}
1555
1556	return [list $mapx $mapy]
1557	}
1558
1559	# ----------------------------------------------------------------------
1560	# CONFIGURATION OPTION: -gridcolor
1561	# ----------------------------------------------------------------------
1562	itcl::configbody Rappture::BarResult::gridcolor {
1563	if { "" == $itk_option(-gridcolor) } {
1564	foreach axis [$itk_component(plot) axis names] {
1565	$itk_component(plot) axis configure $axis -grid off
1566	}
1567	} else {
1568	foreach axis [$itk_component(plot) axis names] {
1569	$itk_component(plot) axis configure $axis \
1570	-gridcolor $itk_option(-gridcolor) -grid on
1571	}
1572	}
1573	}
1574
1575	# ----------------------------------------------------------------------
1576	# CONFIGURATION OPTION: -autocolors
1577	# ----------------------------------------------------------------------
1578	itcl::configbody Rappture::BarResult::autocolors {
1579	foreach c $itk_option(-autocolors) {
1580	if {[catch {winfo rgb $itk_component(hull) $c}]} {
1581	error "bad color \"$c\""
1582	}
1583	}
1584	if {$_autoColorI >= [llength $itk_option(-autocolors)]} {
1585	set _autoColorI 0
1586	}
1587	}
1588
1589	itcl::body Rappture::BarResult::_enterMarker { g name x y text } {
1590	_leaveMarker $g $name
1591	set id [$g marker create text \
1592	-coords [list $x $y] \
1593	-yoffset -1 \
1594	-anchor s \
1595	-text $text]
1596	set _markers($name) $id
1597	}
1598
1599	itcl::body Rappture::BarResult::_leaveMarker { g name } {
1600	if { [info exists _markers($name)] } {
1601	set id $_markers($name)
1602	$g marker delete $id
1603	unset _markers($name)
1604	}
1605	}
1606
1607	itcl::body Rappture::BarResult::_formatTickLabel { w value } {
1608	# Determine the element name from the value
1609
1610	set index [expr round($value)]
1611	if { $index != $value } {
1612	return $value
1613	}
1614	return [lindex $_tickLabels [expr $index - 1]]
1615	if { $label == "" } {
1616	return $value
1617	}
1618	return $label
1619	}

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

Download in other formats: