Context Navigation

uqcurve.tcl

Last change on this file was 6021, checked in by ldelgass, 9 years ago
Merge UQ and fixes from 1.4 branch
File size: 58.2 KB

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

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

Context Navigation

source: trunk/gui/scripts/uqcurve.tcl

Download in other formats: