Context Navigation

xylegend.tcl @ 6480

Last change on this file since 6480 was 5659, checked in by ldelgass, 9 years ago
whitespace
File size: 19.4 KB

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

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

Context Navigation

source: trunk/gui/scripts/xylegend.tcl @ 6480

Download in other formats: