Context Navigation

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

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

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

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

Download in other formats: