Context Navigation

source: branches/1.4/gui/scripts/xylegend.tcl @ 4941

Last change on this file since 4941 was 4939, checked in by ldelgass, 10 years ago
merge r4918,r4921-4922 from 1.3 branch (recolor)
File size: 19.6 KB

Line
1	# -- mode: tcl; indent-tabs-mode: nil --
2
3	# ----------------------------------------------------------------------
4	# COMPONENT: xylegend - X/Y plot legend.
5	#
6	# This widget is a legend for an X/Y plot, meant to view line graphs produced
7	# as output from the run of a Rappture tool. Use the "add" and
8	# "delete" methods to control the curves showing on the plot.
9	# ======================================================================
10	# AUTHOR: Michael McLennan, Purdue University
11	# Copyright (c) 2004-2012 HUBzero Foundation, LLC
12	#
13	# See the file "license.terms" for information on usage and
14	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15	# ======================================================================
16	package require Itk
17	package require BLT
18
19	option add *Xylegend.font \
20	--helvetica-medium-r-normal--8-* widgetDefault
21
22	option add *Xylegend.Button.font \
23	--helvetica-medium-r-normal--9-* widgetDefault
24
25	itcl::class ::Rappture::XyLegend {
26	inherit itk::Widget
27
28	private variable _autocolors {
29	#0000cd
30	#cd0000
31	#00cd00
32	#3a5fcd
33	#cdcd00
34	#cd1076
35	#009acd
36	#00c5cd
37	#a2b5cd
38	#7ac5cd
39	#66cdaa
40	#a2cd5a
41	#cd9b9b
42	#cdba96
43	#cd3333
44	#cd6600
45	#cd8c95
46	#cd00cd
47	#9a32cd
48	#6ca6cd
49	#9ac0cd
50	#9bcd9b
51	#00cd66
52	#cdc673
53	#cdad00
54	#cd5555
55	#cd853f
56	#cd7054
57	#cd5b45
58	#cd6889
59	#cd69c9
60	#551a8b
61	}
62	private variable _lastColorIndex ""
63	private variable _dispatcher "" ;# dispatcher for !events
64	private variable _graph ""
65	private variable _tree ""
66	private variable _diff ""; # Polygon marker used for difference.
67	private variable _rename ""; # Node selected to be renamed.
68	private variable _diffelements
69	private variable _unmapHidden 0
70
71	constructor {graph args} {}
72	destructor {}
73
74	public method reset { list }
75
76	private method Add { elem label {flags ""}}
77	private method Average {}
78	private method BuildPopup { popup }
79	private method Check {}
80	private method Delete { args }
81	private method Difference {}
82	private method Editor { option args }
83	private method GetData { elem what }
84	private method Hide { args }
85	private method Lower { args }
86	private method Raise { args }
87	private method Recolor {}
88	private method PopupMenu { x y }
89	private method Rename {}
90	private method SelectAll {}
91	private method Show { args }
92	private method Toggle { args }
93	private method UnmapHidden {}
94	}
95
96	itk::usual XyLegend {
97	keep -background -foreground -cursor
98	}
99
100	itk::usual TreeView {
101	keep -background -foreground -cursor
102	}
103
104	blt::bitmap define dot1 {
105	#define dot1_width 8
106	#define dot1_height 8
107	static unsigned char dot1_bits[] = {
108	0x55, 0xaa, 0x55, 0xaa, 0x55, 0xaa, 0x55, 0xaa};
109	}
110
111	# ----------------------------------------------------------------------
112	# CONSTRUCTOR
113	# ----------------------------------------------------------------------
114	itcl::body Rappture::XyLegend::constructor { graph args } {
115	option add hull.width hull.height
116	pack propagate $itk_component(hull) no
117	itk_component add scrollbars {
118	Rappture::Scroller $itk_interior.scrl \
119	-xscrollmode auto -yscrollmode auto \
120	-width 200 -height 100
121	}
122	set _tree [blt::tree create]
123	itk_component add legend {
124	blt::treeview $itk_component(scrollbars).legend -linewidth 0 \
125	-bg white -selectmode multiple \
126	-highlightthickness 0 \
127	-tree $_tree \
128	-font "Arial 9" \
129	-flat yes -separator /
130	}
131	$itk_component(scrollbars) contents $itk_component(legend)
132	$itk_component(legend) column insert 0 "show" \
133	-text "" -weight 0.0 -pad 0 -borderwidth 0
134	$itk_component(legend) style checkbox "check" -showvalue no \
135	-onvalue 0 -offvalue 1 \
136	-boxcolor grey50 -checkcolor black -activebackground grey90
137	$itk_component(legend) column configure "treeView" -justify left \
138	-weight 1.0 -text "" -pad 0 -borderwidth 0 -edit no
139	$itk_component(legend) column configure "show" -style "check" -pad {0 0} \
140	-edit yes
141	itk_component add controls {
142	frame $itk_component(hull).controls -width 100 -relief sunken -bd 2
143	}
144	set controls $itk_component(controls)
145	grid $itk_component(controls) -column 0 -row 1 -sticky nsew
146	grid columnconfigure $itk_component(hull) 0 -weight 1
147	grid rowconfigure $itk_component(hull) 1 \
148	-minsize [winfo reqheight $itk_component(scrollbars)]
149	grid rowconfigure $itk_component(hull) 0 -weight 1
150	grid $itk_component(scrollbars) -column 0 -row 0 -sticky nsew
151	set commands {
152	hide ""
153	show ""
154	toggle ""
155	raise findup
156	lower finddn
157	average ""
158	difference ""
159	delete ""
160	rename ""
161	recolor ""
162	}
163	foreach { but icon} $commands {
164	set title [string totitle $but]
165	button $controls.$but -text $title \
166	-relief flat -pady 0 -padx 0 -font "Arial 9" \
167	-command [itcl::code $this $title] -overrelief flat \
168	-activebackground grey90
169	}
170	grid $controls.hide -column 0 -row 0 -sticky w
171	grid $controls.show -column 0 -row 1 -sticky w
172	grid $controls.toggle -column 0 -row 2 -sticky w
173	grid $controls.raise -column 0 -row 3 -sticky w
174	grid $controls.lower -column 0 -row 4 -sticky w
175	grid $controls.difference -column 1 -row 0 -sticky w
176	grid $controls.average -column 1 -row 1 -sticky w
177	grid $controls.rename -column 1 -row 2 -sticky w
178	grid $controls.recolor -column 1 -row 3 -sticky w
179	grid $controls.delete -column 1 -row 4 -sticky w
180
181	grid columnconfigure $controls 0 -weight 1
182	grid columnconfigure $controls 1 -weight 1
183
184	set _graph $graph
185	set cmd [itcl::code $this Toggle current]
186	$itk_component(legend) bind CheckBoxStyle <ButtonRelease-1> \
187	[itcl::code [subst -nocommands {
188	if { [%W edit -root -test %X %Y] } {
189	%W edit -root %X %Y
190	$this Toggle [%W nearest -root %X %Y]
191	break
192	}
193	}]]
194	bind $itk_component(legend) <Enter> { focus %W }
195	$itk_component(legend) bind Entry <Control-KeyRelease-a> \
196	[itcl::code $this SelectAll]
197	$itk_component(legend) bind Entry <KeyRelease-Return> \
198	+[itcl::code $this Toggle focus]
199	$itk_component(legend) bind Entry <Escape> \
200	"$itk_component(legend) selection clearall"
201	$itk_component(legend) configure -selectcommand \
202	[itcl::code $this Check]
203
204	itk_component add editor {
205	Rappture::Editor $itk_interior.editor \
206	-activatecommand [itcl::code $this Editor activate] \
207	-validatecommand [itcl::code $this Editor validate] \
208	-applycommand [itcl::code $this Editor apply]
209	}
210	set _lastColorIndex [llength $_autocolors]
211	Check
212	eval itk_initialize $args
213	}
214
215	# ----------------------------------------------------------------------
216	# DESTRUCTOR
217	# ----------------------------------------------------------------------
218	itcl::body Rappture::XyLegend::destructor {} {
219	foreach node [$_tree children root] {
220	$_tree delete $node
221	}
222	if { $_diff != "" } {
223	catch { $_graph marker delete $_diff }
224	}
225	}
226
227	itcl::body Rappture::XyLegend::Add { elem label {flags ""} } {
228	set hide [$_graph element cget $elem -hide]
229	set im [image create photo]
230	$_graph legend icon $elem $im
231	set data(show) $hide
232	set data(delete) [expr { $flags == "-delete" }]
233	set node [$_tree insert root -at 0 -label $elem -data [array get data]]
234	$itk_component(legend) entry configure $node -label $label -icon $im \
235	-activeicon $im
236	update idletasks
237	return $node
238	}
239
240	# ----------------------------------------------------------------------
241	# USAGE: reset
242	#
243	# Clients use this to add a curve to the plot. The optional <settings>
244	# are used to configure the plot. Allowed settings are -color,
245	# -brightness, -width, -linestyle and -raise.
246	# ----------------------------------------------------------------------
247	itcl::body Rappture::XyLegend::reset { list } {
248	foreach node [$_tree children root] {
249	$_tree delete $node
250	}
251	foreach elem $list {
252	if {[catch {$_graph element cget $elem -label} label] == 0} {
253	if {$label eq ""} {
254	set label $elem
255	}
256	Add $elem $label
257	}
258	}
259	$itk_component(legend) open -recurse root
260	Check
261	}
262
263	itcl::body Rappture::XyLegend::Hide { args } {
264	if { $args == "" } {
265	set nodes [$itk_component(legend) curselection]
266	} else {
267	set nodes $args
268	}
269	foreach node $nodes {
270	set elem [$_tree label $node]
271	if { ![$_graph element exists $elem] } {
272	continue
273	}
274	$_graph element configure $elem -hide yes
275	$_tree set $node "show" 1
276	}
277	}
278
279	itcl::body Rappture::XyLegend::Show { args } {
280	if { $args == "" } {
281	set nodes [$itk_component(legend) curselection]
282	} else {
283	set nodes $args
284	}
285	foreach node $nodes {
286	set elem [$_tree label $node]
287	if { ![$_graph element exists $elem] } {
288	continue
289	}
290	$_graph element configure $elem -hide no
291	$_tree set $node "show" 0
292	}
293	}
294
295	itcl::body Rappture::XyLegend::Toggle { args } {
296	if { $args == "" } {
297	set nodes [$itk_component(legend) curselection]
298	} else {
299	set nodes $args
300	}
301	foreach node $nodes {
302	set elem [$_tree label $node]
303	if { ![$_graph element exists $elem] } {
304	continue
305	}
306	set hide [$_graph element cget $elem -hide]
307	set hide [expr $hide==0]
308	$_tree set $node "show" $hide
309	$_graph element configure $elem -hide $hide
310	}
311	}
312
313	itcl::body Rappture::XyLegend::Raise { args } {
314	if { $args == "" } {
315	set nodes [$itk_component(legend) curselection]
316	} else {
317	set nodes $args
318	}
319	set elements {}
320	foreach node $nodes {
321	set elem [$_tree label $node]
322	set found($elem) 1
323	set elements [linsert $elements 0 $elem]
324	}
325	foreach elem $elements {
326	$_tree move [$_tree index $elem] 0 -at 0
327	}
328	set list {}
329	foreach elem [$_graph element show] {
330	if { [info exists found($elem)] } {
331	continue
332	}
333	lappend list $elem
334	}
335	$_graph element show [concat $list $elements]
336	}
337
338	itcl::body Rappture::XyLegend::Lower { args } {
339	if { $args == "" } {
340	set nodes [$itk_component(legend) curselection]
341	} else {
342	set nodes $args
343	}
344	set elements {}
345	foreach node $nodes {
346	set elem [$_tree label $node]
347	set found($elem) 1
348	set elements [linsert $elements 0 $elem]
349	}
350	set pos [$_tree degree 0]
351
352	foreach elem $elements {
353	incr pos -1
354	$_tree move [$_tree index $elem] 0 -at $pos
355	}
356
357	set list {}
358	foreach elem [$_graph element show] {
359	if { [info exists found($elem)] } {
360	continue
361	}
362	lappend list $elem
363	}
364	$_graph element show [concat $elements $list]
365	}
366
367	itcl::body Rappture::XyLegend::Delete { args } {
368	if { $args == "" } {
369	set nodes [$itk_component(legend) curselection]
370	} else {
371	set nodes $args
372	}
373	set elements {}
374	set delnodes {}
375	foreach node $nodes {
376	if { ![$_tree get $node "delete" 0] } {
377	continue
378	}
379	set elem [$_tree label $node]
380	lappend elements $elem
381	lappend delnodes $node
382	if { $_diff != "" && [info exists _diffelements($elem)] } {
383	$_graph marker delete $_diff
384	array unset _diffelements
385	set _diff ""
386	}
387	}
388	if { [llength $delnodes] > 0 } {
389	eval $_tree delete $delnodes
390	}
391	$itk_component(legend) selection clearall
392	eval $_graph element delete $elements
393	}
394
395	itcl::body Rappture::XyLegend::Check {} {
396	set nodes [$itk_component(legend) curselection]
397	foreach n { hide show toggle raise lower
398	rename average difference delete recolor } {
399	$itk_component(controls).$n configure -state disabled
400	}
401	foreach node $nodes {
402	if { [$_tree get $node "delete" 0] } {
403	$itk_component(controls).delete configure -state normal
404	break
405	}
406	}
407	if { [$_tree degree 0] > 1 && [llength $nodes] > 0 } {
408	foreach n { raise lower } {
409	$itk_component(controls).$n configure -state normal
410	}
411	}
412	switch -- [llength $nodes] {
413	0 {
414	}
415	1 {
416	foreach n { hide show toggle rename recolor } {
417	$itk_component(controls).$n configure -state normal
418	}
419	}
420	2 {
421	foreach n { hide show toggle difference average recolor } {
422	$itk_component(controls).$n configure -state normal
423	}
424	}
425	default {
426	foreach n { hide show toggle average recolor } {
427	$itk_component(controls).$n configure -state normal
428	}
429	}
430	}
431	}
432
433	itcl::body Rappture::XyLegend::GetData { elem what } {
434	set y [$_graph element cget $elem $what]
435	if { [blt::vector names $y] == $y } {
436	set y [$y range 0 end]
437	}
438	return $y
439	}
440
441	itcl::body Rappture::XyLegend::Average {} {
442	set nodes [$itk_component(legend) curselection]
443	if { $nodes == "" } {
444	return
445	}
446	set elements {}
447	set sum [blt::vector create \#auto -command ""]
448
449	set xcoords [blt::vector create \#auto -command ""]
450	set ycoords [blt::vector create \#auto -command ""]
451
452	blt::busy hold $itk_component(hull)
453	update
454	# Step 1. Get the x-values for each curve, then sort them to get the
455	# unique values.
456
457	set labels {}
458	foreach node $nodes {
459	set elem [$_tree label $node]
460	set label [$_graph element cget $elem -label]
461	$xcoords append [GetData $elem -x]
462	set elements [linsert $elements 0 $elem]
463	set labels [linsert $labels 0 $label]
464	}
465	# Sort the abscissas keeping unique values.
466	$xcoords sort -uniq
467
468	# Step 2. Now for each curve, generate a cubic spline of that curve
469	# and interpolate to get the corresponding y-values for each
470	# abscissa. Normally the abscissa are the same, so we're
471	# interpolation the knots.
472
473	set x [blt::vector create \#auto -command ""]
474	set y [blt::vector create \#auto -command ""]
475	$sum length [$xcoords length]
476
477	foreach node $nodes {
478	set elem [$_tree label $node]
479	$x set [GetData $elem -x]
480	$y set [GetData $elem -y]
481	blt::spline natural $x $y $xcoords $ycoords
482
483	# Sum the interpolated y-coordinate values.
484	$sum expr "$sum + $ycoords"
485	}
486	blt::vector destroy $x $y
487
488	# Get the average
489	$sum expr "$sum / [llength $elements]"
490
491	# Step 3. Create a new curve which is the average. Append it to the
492	# the end.
493
494	set count 0
495	while {[$_graph element exists avg$count] } {
496	incr count
497	}
498	set labels [lsort -dictionary $labels]
499	set name "avg$count"
500	set label "Avg. [join $labels ,]"
501
502	# Don't use the vector because we don't know when it will be cleaned up.
503
504	if { $_lastColorIndex == 0 } {
505	set _lastColorIndex [llength $_autocolors]
506	}
507	incr _lastColorIndex -1
508	set color [lindex $_autocolors $_lastColorIndex]
509	$_graph element create $name -label $label -x [$xcoords range 0 end]\
510	-y [$sum range 0 end] -symbol scross -pixels 3 -color $color
511	blt::vector destroy $xcoords $ycoords $sum
512	set node [Add $name $label -delete]
513	Raise $node
514	blt::busy forget $itk_component(hull)
515	}
516
517	itcl::body Rappture::XyLegend::Difference {} {
518
519	if { $_diff != "" } {
520	$_graph marker delete $_diff
521	set _diff ""
522	}
523	set nodes [$itk_component(legend) curselection]
524	set elem1 [$_tree label [lindex $nodes 0]]
525	set elem2 [$_tree label [lindex $nodes 1]]
526	if { [info exists _diffelements($elem1)] &&
527	[info exists _diffelements($elem2)] } {
528	array unset _diffelements; # Toggle the difference.
529	return;
530	}
531	array unset _diffelements
532	set x [blt::vector create \#auto -command ""]
533	set y [blt::vector create \#auto -command ""]
534	set m [blt::vector create \#auto -command ""]
535
536	$x append [GetData $elem1 -x]
537	$y append [GetData $elem1 -y]
538	$x sort -reverse $y
539	$x append [GetData $elem2 -x]
540	$y append [GetData $elem2 -y]
541	$m merge $x $y
542	set _diff [$_graph marker create polygon \
543	-coords [$m range 0 end] \
544	-element $elem1 \
545	-stipple dot1 \
546	-outline "" -fill "#cd69c9"]
547	blt::vector destroy $m $x $y
548	set _diffelements($elem1) 1
549	set _diffelements($elem2) 1
550	}
551
552
553	itcl::body Rappture::XyLegend::UnmapHidden {} {
554	$_graph configure -unmaphiddenelements $_unmapHidden
555	}
556
557	itcl::body Rappture::XyLegend::SelectAll { } {
558	foreach node [$_tree children 0] {
559	$itk_component(legend) selection set $node
560	}
561	}
562
563	itcl::body Rappture::XyLegend::Rename {} {
564	Editor popup
565	}
566
567	# ----------------------------------------------------------------------
568	# USAGE: Editor popup
569	# USAGE: Editor activate
570	# USAGE: Editor validate <value>
571	# USAGE: Editor apply <value>
572	# USAGE: Editor menu <rootx> <rooty>
573	#
574	# Used internally to handle the various functions of the pop-up
575	# editor for the value of this gauge.
576	# ----------------------------------------------------------------------
577	itcl::body Rappture::XyLegend::Editor {option args} {
578	switch -- $option {
579	popup {
580	$itk_component(editor) activate
581	}
582	activate {
583	set _rename [$itk_component(legend) curselection]
584	if { $_rename == "" } {
585	return;
586	}
587	set label [$itk_component(legend) entry cget $_rename -label]
588	foreach { l r w h } [$itk_component(legend) bbox $_rename] break
589	set info(text) $label
590	set info(x) [expr $l + [winfo rootx $itk_component(legend)]]
591	set info(y) [expr $r + [winfo rooty $itk_component(legend)]]
592	set info(w) $w
593	set info(h) $h
594	return [array get info]
595	}
596	validate {
597	if {[llength $args] != 1} {
598	error "wrong # args: should be \"editor validate value\""
599	}
600	}
601	apply {
602	if {[llength $args] != 1} {
603	error "wrong # args: should be \"editor apply value\""
604	}
605	set label [lindex $args 0]
606	$itk_component(legend) entry configure $_rename -label $label
607	set elem [$_tree label $_rename]
608	$_graph element configure $elem -label $label
609	}
610	menu {
611	eval tk_popup $itk_component(emenu) $args
612	}
613	default {
614	error "bad option \"$option\": should be popup, activate, validate, apply, and menu"
615	}
616	}
617	}
618
619	itcl::body Rappture::XyLegend::Recolor {} {
620	set nodes [$itk_component(legend) curselection]
621	if { $nodes == "" } {
622	return
623	}
624	foreach node $nodes {
625	set elem [$_tree label $node]
626	if { $_lastColorIndex == 0 } {
627	set _lastColorIndex [llength $_autocolors]
628	}
629	incr _lastColorIndex -1
630	set color [lindex $_autocolors $_lastColorIndex]
631	$_graph element configure $elem -color $color
632	set im [$itk_component(legend) entry cget $node -icon]
633	$_graph legend icon $elem $im
634	}
635	}

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

Download in other formats: