Context Navigation

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

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

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

Download in other formats: