Context Navigation

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

Last change on this file since 1710 was 1710, 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	itk::usual Scrollset {
98	}
99
100	blt::bitmap define dot1 {
101	#define dot1_width 8
102	#define dot1_height 8
103	static unsigned char dot1_bits[] = {
104	0x55, 0xaa, 0x55, 0xaa, 0x55, 0xaa, 0x55, 0xaa};
105	}
106
107	# ----------------------------------------------------------------------
108	# CONSTRUCTOR
109	# ----------------------------------------------------------------------
110	itcl::body Rappture::XyLegend::constructor { graph args } {
111	option add hull.width hull.height
112	pack propagate $itk_component(hull) no
113	itk_component add scrollbars {
114	blt::scrollset $itk_interior.scrl \
115	-xscrollbar $itk_interior.scrl.xs \
116	-yscrollbar $itk_interior.scrl.ys \
117	-window $itk_interior.scrl.legend \
118	-height 100
119	}
120
121	blt::tk::scrollbar $itk_interior.scrl.xs
122	blt::tk::scrollbar $itk_interior.scrl.ys
123	set _tree [blt::tree create]
124	itk_component add legend {
125	blt::treeview $itk_component(scrollbars).legend -linewidth 0 \
126	-bg white -selectmode multiple \
127	-highlightthickness 0 \
128	-tree $_tree \
129	-font "Arial 9" \
130	-flat yes -separator /
131	}
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	$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.delete -column 1 -row 3 -sticky w
178	grid $controls.recolor -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 picture]
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	update idletasks
235	return $node
236	}
237
238	# ----------------------------------------------------------------------
239	# USAGE: reset <curve> ?<settings>?
240	#
241	# Clients use this to add a curve to the plot. The optional <settings>
242	# are used to configure the plot. Allowed settings are -color,
243	# -brightness, -width, -linestyle and -raise.
244	# ----------------------------------------------------------------------
245	itcl::body Rappture::XyLegend::reset {} {
246	foreach node [$_tree children root] {
247	$_tree delete $node
248	}
249	foreach elem [$graph_ element show] {
250	set label [$graph_ element cget $elem -label]
251	if { $label == "" } {
252	set label $elem
253	}
254	Add $elem $label
255	}
256	$itk_component(legend) open -recurse root
257	Check
258	}
259
260	itcl::body Rappture::XyLegend::Hide { args } {
261	if { $args == "" } {
262	set nodes [$itk_component(legend) curselection]
263	} else {
264	set nodes $args
265	}
266	foreach node $nodes {
267	set elem [$_tree label $node]
268	if { ![$graph_ element exists $elem] } {
269	continue
270	}
271	$graph_ element configure $elem -hide yes
272	$_tree set $node "show" 1
273	}
274	}
275
276	itcl::body Rappture::XyLegend::Show { args } {
277	if { $args == "" } {
278	set nodes [$itk_component(legend) curselection]
279	} else {
280	set nodes $args
281	}
282	foreach node $nodes {
283	set elem [$_tree label $node]
284	if { ![$graph_ element exists $elem] } {
285	continue
286	}
287	$graph_ element configure $elem -hide no
288	$_tree set $node "show" 0
289	}
290	}
291
292	itcl::body Rappture::XyLegend::Toggle { args } {
293	if { $args == "" } {
294	set nodes [$itk_component(legend) curselection]
295	} else {
296	set nodes $args
297	}
298	foreach node $nodes {
299	set elem [$_tree label $node]
300	if { ![$graph_ element exists $elem] } {
301	continue
302	}
303	set hide [$graph_ element cget $elem -hide]
304	set hide [expr $hide==0]
305	$_tree set $node "show" $hide
306	$graph_ element configure $elem -hide $hide
307	}
308	}
309
310	itcl::body Rappture::XyLegend::Raise { args } {
311	if { $args == "" } {
312	set nodes [$itk_component(legend) curselection]
313	} else {
314	set nodes $args
315	}
316	set elements {}
317	foreach node $nodes {
318	set elem [$_tree label $node]
319	set found($elem) 1
320	set elements [linsert $elements 0 $elem]
321	}
322	foreach elem $elements {
323	$_tree move [$_tree index $elem] 0 -at 0
324	}
325	set list {}
326	foreach elem [$graph_ element show] {
327	if { [info exists found($elem)] } {
328	continue
329	}
330	lappend list $elem
331	}
332	$graph_ element show [concat $list $elements]
333	}
334
335	itcl::body Rappture::XyLegend::Lower { args } {
336	if { $args == "" } {
337	set nodes [$itk_component(legend) curselection]
338	} else {
339	set nodes $args
340	}
341	set elements {}
342	foreach node $nodes {
343	set elem [$_tree label $node]
344	set found($elem) 1
345	set elements [linsert $elements 0 $elem]
346	}
347	set pos [$_tree degree 0]
348
349	foreach elem $elements {
350	incr pos -1
351	$_tree move [$_tree index $elem] 0 -at $pos
352	}
353
354	set list {}
355	foreach elem [$graph_ element show] {
356	if { [info exists found($elem)] } {
357	continue
358	}
359	lappend list $elem
360	}
361	$graph_ element show [concat $elements $list]
362	}
363
364	itcl::body Rappture::XyLegend::Delete { args } {
365	if { $args == "" } {
366	set nodes [$itk_component(legend) curselection]
367	} else {
368	set nodes $args
369	}
370	set elements {}
371	set delnodes {}
372	foreach node $nodes {
373	if { ![$_tree get $node "delete" 0] } {
374	continue
375	}
376	set elem [$_tree label $node]
377	lappend elements $elem
378	lappend delnodes $node
379	if { $diff_ != "" && [info exists diffelements_($elem)] } {
380	$graph_ marker delete $diff_
381	array unset diffelements_
382	set diff_ ""
383	}
384	}
385	if { [llength $delnodes] > 0 } {
386	eval $_tree delete $delnodes
387	}
388	$itk_component(legend) selection clearall
389	eval $graph_ element delete $elements
390	}
391
392	itcl::body Rappture::XyLegend::Check {} {
393	set nodes [$itk_component(legend) curselection]
394	foreach n { hide show toggle raise lower
395	rename average difference delete recolor } {
396	$itk_component(controls).$n configure -state disabled
397	}
398	foreach node $nodes {
399	if { [$_tree get $node "delete" 0] } {
400	$itk_component(controls).delete configure -state normal
401	break
402	}
403	}
404	if { [$_tree degree 0] > 1 && [llength $nodes] > 0 } {
405	foreach n { raise lower } {
406	$itk_component(controls).$n configure -state normal
407	}
408	}
409	switch -- [llength $nodes] {
410	0 {
411	}
412	1 {
413	foreach n { hide show toggle rename recolor } {
414	$itk_component(controls).$n configure -state normal
415	}
416	}
417	2 {
418	foreach n { hide show toggle difference average recolor } {
419	$itk_component(controls).$n configure -state normal
420	}
421	}
422	default {
423	foreach n { hide show toggle average recolor } {
424	$itk_component(controls).$n configure -state normal
425	}
426	}
427	}
428	}
429
430	itcl::body Rappture::XyLegend::GetData { elem what } {
431	set y [$graph_ element cget $elem $what]
432	if { [blt::vector names $y] == $y } {
433	set y [$y range 0 end]
434	}
435	return $y
436	}
437
438	itcl::body Rappture::XyLegend::Average {} {
439	set nodes [$itk_component(legend) curselection]
440	if { $nodes == "" } {
441	return
442	}
443	set elements {}
444	set sum [blt::vector create \#auto -command ""]
445
446	set xcoords [blt::vector create \#auto -command ""]
447	set ycoords [blt::vector create \#auto -command ""]
448
449	blt::busy hold $itk_component(hull)
450	update
451	# Step 1. Get the x-values for each curve, then sort them to get the
452	# unique values.
453
454	set labels {}
455	foreach node $nodes {
456	set elem [$_tree label $node]
457	set label [$graph_ element cget $elem -label]
458	$xcoords append [GetData $elem -x]
459	set elements [linsert $elements 0 $elem]
460	set labels [linsert $labels 0 $label]
461	}
462	# Sort the abscissas keeping unique values.
463	$xcoords sort -uniq
464
465	# Step 2. Now for each curve, generate a cubic spline of that curve
466	# and interpolate to get the corresponding y-values for each
467	# abscissa. Normally the abscissa are the same, so we're
468	# interpolation the knots.
469
470	set x [blt::vector create \#auto -command ""]
471	set y [blt::vector create \#auto -command ""]
472	$sum length [$xcoords length]
473
474	foreach node $nodes {
475	set elem [$_tree label $node]
476	$x set [GetData $elem -x]
477	$y set [GetData $elem -y]
478	blt::spline natural $x $y $xcoords $ycoords
479
480	# Sum the interpolated y-coordinate values.
481	$sum expr "$sum + $ycoords"
482	}
483	blt::vector destroy $x $y
484
485	# Get the average
486	$sum expr "$sum / [llength $elements]"
487
488	# Step 3. Create a new curve which is the average. Append it to the
489	# the end.
490
491	set count 0
492	while {[$graph_ element exists avg$count] } {
493	incr count
494	}
495	set labels [lsort -dictionary $labels]
496	set name "avg$count"
497	set label "Avg. [join $labels ,]"
498
499	# Don't use the vector because we don't know when it will be cleaned up.
500
501	if { $lastColorIndex_ == 0 } {
502	set lastColorIndex_ [llength $autocolors_]
503	}
504	incr lastColorIndex_ -1
505	set color [lindex $autocolors_ $lastColorIndex_]
506	$graph_ element create $name -label $label -x [$xcoords range 0 end]\
507	-y [$sum range 0 end] -symbol scross -pixels 3 -color $color
508	blt::vector destroy $xcoords $ycoords $sum
509	set node [Add $name $label -delete]
510	Raise $node
511	blt::busy forget $itk_component(hull)
512	}
513
514	itcl::body Rappture::XyLegend::Difference {} {
515
516	if { $diff_ != "" } {
517	$graph_ marker delete $diff_
518	set diff_ ""
519	}
520	set nodes [$itk_component(legend) curselection]
521	set elem1 [$_tree label [lindex $nodes 0]]
522	set elem2 [$_tree label [lindex $nodes 1]]
523	if { [info exists diffelements_($elem1)] &&
524	[info exists diffelements_($elem2)] } {
525	array unset diffelements_; # Toggle the difference.
526	return;
527	}
528	array unset diffelements_
529	set x [blt::vector create \#auto -command ""]
530	set y [blt::vector create \#auto -command ""]
531	set m [blt::vector create \#auto -command ""]
532
533	$x append [GetData $elem1 -x]
534	$y append [GetData $elem1 -y]
535	$x sort -reverse $y
536	$x append [GetData $elem2 -x]
537	$y append [GetData $elem2 -y]
538	$m merge $x $y
539	set diff_ [$graph_ marker create polygon \
540	-coords [$m range 0 end] \
541	-element $elem1 \
542	-stipple dot1 \
543	-outline "" -fill "#cd69c9"]
544	blt::vector destroy $m $x $y
545	set diffelements_($elem1) 1
546	set diffelements_($elem2) 1
547	}
548
549
550	itcl::body Rappture::XyLegend::Recolor {} {
551	set nodes [$itk_component(legend) curselection]
552	if { $nodes == "" } {
553	return
554	}
555	foreach node $nodes {
556	set elem [$_tree label $node]
557	if { $lastColorIndex_ == 0 } {
558	set lastColorIndex_ [llength $autocolors_]
559	}
560	incr lastColorIndex_ -1
561	set color [lindex $autocolors_ $lastColorIndex_]
562	$graph_ element configure $elem -color $color
563	set im [$itk_component(legend) entry cget $node -icon]
564	$graph_ legend icon $elem $im
565	}
566	}
567
568	itcl::body Rappture::XyLegend::SelectAll { } {
569	foreach node [$_tree children 0] {
570	$itk_component(legend) selection set $node
571	}
572	}
573
574	itcl::body Rappture::XyLegend::Rename {} {
575	Editor popup
576	}
577
578	# ----------------------------------------------------------------------
579	# USAGE: Editor popup
580	# USAGE: Editor activate
581	# USAGE: Editor validate <value>
582	# USAGE: Editor apply <value>
583	# USAGE: Editor menu <rootx> <rooty>
584	#
585	# Used internally to handle the various functions of the pop-up
586	# editor for the value of this gauge.
587	# ----------------------------------------------------------------------
588	itcl::body Rappture::XyLegend::Editor {option args} {
589	switch -- $option {
590	popup {
591	$itk_component(editor) activate
592	}
593	activate {
594	set rename_ [$itk_component(legend) curselection]
595	if { $rename_ == "" } {
596	return;
597	}
598	set label [$itk_component(legend) entry cget $rename_ -label]
599	foreach { l r w h } [$itk_component(legend) bbox $rename_] break
600	set info(text) $label
601	set info(x) [expr $l + [winfo rootx $itk_component(legend)]]
602	set info(y) [expr $r + [winfo rooty $itk_component(legend)]]
603	set info(w) $w
604	set info(h) $h
605	return [array get info]
606	}
607	validate {
608	if {[llength $args] != 1} {
609	error "wrong # args: should be \"editor validate value\""
610	}
611	}
612	apply {
613	if {[llength $args] != 1} {
614	error "wrong # args: should be \"editor apply value\""
615	}
616	set label [lindex $args 0]
617	$itk_component(legend) entry configure $rename_ -label $label
618	set elem [$_tree label $rename_]
619	$graph_ element configure $elem -label $label
620	}
621	menu {
622	eval tk_popup $itk_component(emenu) $args
623	}
624	default {
625	error "bad option \"$option\": should be popup, activate, validate, apply, and menu"
626	}
627	}
628	}

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

Download in other formats: