Context Navigation

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

Last change on this file since 1677 was 1677, checked in by gah, 14 years ago

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

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

Download in other formats: