Context Navigation

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

Last change on this file since 818 was 818, checked in by gah, 17 years ago
still in development
File size: 49.5 KB

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

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

Download in other formats: