Context Navigation

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

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

File size: 17.5 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	foreach {name col} [$graph_ element cget $elem $what] break
432	if { [blt::vector names $name] == $name } {
433	set y [$name range 0 end]
434	} elseif { [blt::datatable names $name] == $name } {
435	set y [$name column values $col]
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	if { [catch {
481	blt::spline natural $x $y $xcoords $ycoords
482	}] != 0 } {
483	}
484	# Sum the interpolated y-coordinate values.
485	$sum expr "$sum + $ycoords"
486	}
487	blt::vector destroy $x $y
488
489	# Get the average
490	$sum expr "$sum / [llength $elements]"
491
492	# Step 3. Create a new curve which is the average. Append it to the
493	# the end.
494
495	set count 0
496	while {[$graph_ element exists avg$count] } {
497	incr count
498	}
499	set labels [lsort -dictionary $labels]
500	set name "avg$count"
501	set label "Avg. [join $labels ,]"
502
503	# Don't use the vector because we don't know when it will be cleaned up.
504
505	if { $lastColorIndex_ == 0 } {
506	set lastColorIndex_ [llength $autocolors_]
507	}
508	incr lastColorIndex_ -1
509	set color [lindex $autocolors_ $lastColorIndex_]
510	$graph_ element create $name -label $label -x [$xcoords range 0 end]\
511	-y [$sum range 0 end] -symbol scross -pixels 3 -color $color
512	blt::vector destroy $xcoords $ycoords $sum
513	set node [Add $name $label -delete]
514	Raise $node
515	blt::busy forget $itk_component(hull)
516	}
517
518	itcl::body Rappture::XyLegend::Difference {} {
519
520	if { $diff_ != "" } {
521	$graph_ marker delete $diff_
522	set diff_ ""
523	}
524	set nodes [$itk_component(legend) curselection]
525	set elem1 [$_tree label [lindex $nodes 0]]
526	set elem2 [$_tree label [lindex $nodes 1]]
527	if { [info exists diffelements_($elem1)] &&
528	[info exists diffelements_($elem2)] } {
529	array unset diffelements_; # Toggle the difference.
530	return;
531	}
532	array unset diffelements_
533	set x [blt::vector create \#auto -command ""]
534	set y [blt::vector create \#auto -command ""]
535	set m [blt::vector create \#auto -command ""]
536
537	$x append [GetData $elem1 -x]
538	$y append [GetData $elem1 -y]
539	$x sort -reverse $y
540	$x append [GetData $elem2 -x]
541	$y append [GetData $elem2 -y]
542	$m merge $x $y
543	set diff_ [$graph_ marker create polygon \
544	-coords [$m range 0 end] \
545	-element $elem1 \
546	-stipple dot1 \
547	-outline "" -fill "#cd69c9"]
548	blt::vector destroy $m $x $y
549	set diffelements_($elem1) 1
550	set diffelements_($elem2) 1
551	}
552
553
554	itcl::body Rappture::XyLegend::Recolor {} {
555	set nodes [$itk_component(legend) curselection]
556	if { $nodes == "" } {
557	return
558	}
559	foreach node $nodes {
560	set elem [$_tree label $node]
561	if { $lastColorIndex_ == 0 } {
562	set lastColorIndex_ [llength $autocolors_]
563	}
564	incr lastColorIndex_ -1
565	set color [lindex $autocolors_ $lastColorIndex_]
566	$graph_ element configure $elem -color $color
567	set im [$itk_component(legend) entry cget $node -icon]
568	$graph_ legend icon $elem $im
569	}
570	}
571
572	itcl::body Rappture::XyLegend::SelectAll { } {
573	foreach node [$_tree children 0] {
574	$itk_component(legend) selection set $node
575	}
576	}
577
578	itcl::body Rappture::XyLegend::Rename {} {
579	Editor popup
580	}
581
582	# ----------------------------------------------------------------------
583	# USAGE: Editor popup
584	# USAGE: Editor activate
585	# USAGE: Editor validate <value>
586	# USAGE: Editor apply <value>
587	# USAGE: Editor menu <rootx> <rooty>
588	#
589	# Used internally to handle the various functions of the pop-up
590	# editor for the value of this gauge.
591	# ----------------------------------------------------------------------
592	itcl::body Rappture::XyLegend::Editor {option args} {
593	switch -- $option {
594	popup {
595	$itk_component(editor) activate
596	}
597	activate {
598	set rename_ [$itk_component(legend) curselection]
599	if { $rename_ == "" } {
600	return;
601	}
602	set label [$itk_component(legend) entry cget $rename_ -label]
603	foreach { l r w h } [$itk_component(legend) bbox $rename_] break
604	set info(text) $label
605	set info(x) [expr $l + [winfo rootx $itk_component(legend)]]
606	set info(y) [expr $r + [winfo rooty $itk_component(legend)]]
607	set info(w) $w
608	set info(h) $h
609	return [array get info]
610	}
611	validate {
612	if {[llength $args] != 1} {
613	error "wrong # args: should be \"editor validate value\""
614	}
615	}
616	apply {
617	if {[llength $args] != 1} {
618	error "wrong # args: should be \"editor apply value\""
619	}
620	set label [lindex $args 0]
621	$itk_component(legend) entry configure $rename_ -label $label
622	set elem [$_tree label $rename_]
623	$graph_ element configure $elem -label $label
624	}
625	menu {
626	eval tk_popup $itk_component(emenu) $args
627	}
628	default {
629	error "bad option \"$option\": should be popup, activate, validate, apply, and menu"
630	}
631	}
632	}

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

Download in other formats: