Context Navigation

source: trunk/gui/scripts/historesult.tcl @ 1313

Last change on this file since 1313 was 1077, checked in by mmc, 16 years ago
Fixed the Rappture::filexfer facility so that if importfile/exportfile commands are not available, it reverts to local Load/Save? operations. This is important for applications that are not deployed in a hub, but used instead in a standard desktop environment.
File size: 53.1 KB

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

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

Download in other formats: