Context Navigation

source: trunk/gui/scripts/histogramresult.tcl @ 2035

Last change on this file since 2035 was 1929, checked in by gah, 14 years ago

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

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

Download in other formats: