Context Navigation

source: branches/blt4/gui/scripts/xylegend.tcl @ 1648

Last change on this file since 1648 was 1646, checked in by gah, 15 years ago

File size: 17.2 KB

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

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

Download in other formats: