Context Navigation

source: trunk/gui/scripts/xylegend.tcl @ 1555

Last change on this file since 1555 was 1342, checked in by gah, 15 years ago
preliminary HQ output from molvisviewer; unexpand tabs; all jpeg generation at 100%
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 -background -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	-boxcolor grey50 -checkcolor black -activebackground grey90
131	$itk_component(legend) column configure "treeView" -justify left \
132	-weight 1.0 -text "" -pad 0 -borderwidth 0
133	$itk_component(legend) column configure "show" -style "check" -pad {0 0} \
134	-edit yes
135	itk_component add controls {
136	frame $itk_component(hull).controls -width 100 -relief sunken -bd 2
137	}
138	set controls $itk_component(controls)
139	grid $itk_component(controls) -column 0 -row 1 -sticky nsew
140	grid columnconfigure $itk_component(hull) 0 -weight 1
141	grid rowconfigure $itk_component(hull) 1 \
142	-minsize [winfo reqheight $itk_component(scrollbars)]
143	grid rowconfigure $itk_component(hull) 0 -weight 1
144	grid $itk_component(scrollbars) -column 0 -row 0 -sticky nsew
145	set commands {
146	hide ""
147	show ""
148	toggle ""
149	raise findup
150	lower finddn
151	average ""
152	difference ""
153	delete ""
154	rename ""
155	recolor ""
156	}
157	foreach { but icon} $commands {
158	set title [string totitle $but]
159	button $controls.$but -text $title \
160	-relief flat -pady 0 -padx 0 -font "Arial 9" \
161	-command [itcl::code $this $title] -overrelief flat \
162	-activebackground grey90
163	}
164	grid $controls.hide -column 0 -row 0 -sticky w
165	grid $controls.show -column 0 -row 1 -sticky w
166	grid $controls.toggle -column 0 -row 2 -sticky w
167	grid $controls.raise -column 0 -row 3 -sticky w
168	grid $controls.lower -column 0 -row 4 -sticky w
169	grid $controls.difference -column 1 -row 0 -sticky w
170	grid $controls.average -column 1 -row 1 -sticky w
171	grid $controls.rename -column 1 -row 2 -sticky w
172	grid $controls.delete -column 1 -row 3 -sticky w
173	grid $controls.recolor -column 1 -row 4 -sticky w
174
175	grid columnconfigure $controls 0 -weight 1
176	grid columnconfigure $controls 1 -weight 1
177
178	set graph_ $graph
179	set cmd [itcl::code $this Toggle current]
180	$itk_component(legend) bind CheckBoxStyle <ButtonRelease-1> \
181	[itcl::code [subst -nocommands {
182	if { [%W edit -root -test %X %Y] } {
183	%W edit -root %X %Y
184	$this Toggle [%W nearest -root %X %Y]
185	break
186	}
187	}]]
188	bind $itk_component(legend) <Enter> { focus %W }
189	$itk_component(legend) bind Entry <Control-KeyRelease-a> \
190	[itcl::code $this SelectAll]
191	$itk_component(legend) bind Entry <KeyRelease-Return> \
192	+[itcl::code $this Toggle focus]
193	$itk_component(legend) bind Entry <Escape> \
194	"$itk_component(legend) selection clearall"
195	$itk_component(legend) configure -selectcommand \
196	[itcl::code $this Check]
197
198	itk_component add editor {
199	Rappture::Editor $itk_interior.editor \
200	-activatecommand [itcl::code $this Editor activate] \
201	-validatecommand [itcl::code $this Editor validate] \
202	-applycommand [itcl::code $this Editor apply]
203	}
204	set lastColorIndex_ [llength $autocolors_]
205	Check
206	eval itk_initialize $args
207	}
208
209	# ----------------------------------------------------------------------
210	# DESTRUCTOR
211	# ----------------------------------------------------------------------
212	itcl::body Rappture::XyLegend::destructor {} {
213	foreach node [$tree_ children root] {
214	$tree_ delete $node
215	}
216	if { $diff_ != "" } {
217	catch { $graph_ marker delete $diff_ }
218	}
219	}
220
221	itcl::body Rappture::XyLegend::Add { elem label {flags ""} } {
222	set hide [$graph_ element cget $elem -hide]
223	set im [image create photo]
224	$graph_ legend icon $elem $im
225	set data(show) $hide
226	set data(delete) [expr { $flags == "-delete" }]
227	set node [$tree_ insert root -at 0 -label $elem -data [array get data]]
228	$itk_component(legend) entry configure $node -label $label -icon $im \
229	-activeicon $im
230	update idletasks
231	return $node
232	}
233
234	# ----------------------------------------------------------------------
235	# USAGE: reset <curve> ?<settings>?
236	#
237	# Clients use this to add a curve to the plot. The optional <settings>
238	# are used to configure the plot. Allowed settings are -color,
239	# -brightness, -width, -linestyle and -raise.
240	# ----------------------------------------------------------------------
241	itcl::body Rappture::XyLegend::reset {} {
242	foreach node [$tree_ children root] {
243	$tree_ delete $node
244	}
245	foreach elem [$graph_ element show] {
246	set label [$graph_ element cget $elem -label]
247	if { $label == "" } {
248	set label $elem
249	}
250	Add $elem $label
251	}
252	$itk_component(legend) open -recurse root
253	Check
254	}
255
256	itcl::body Rappture::XyLegend::Hide { args } {
257	if { $args == "" } {
258	set nodes [$itk_component(legend) curselection]
259	} else {
260	set nodes $args
261	}
262	foreach node $nodes {
263	set elem [$tree_ label $node]
264	if { ![$graph_ element exists $elem] } {
265	continue
266	}
267	$graph_ element configure $elem -hide yes
268	$tree_ set $node "show" 1
269	}
270	}
271
272	itcl::body Rappture::XyLegend::Show { args } {
273	if { $args == "" } {
274	set nodes [$itk_component(legend) curselection]
275	} else {
276	set nodes $args
277	}
278	foreach node $nodes {
279	set elem [$tree_ label $node]
280	if { ![$graph_ element exists $elem] } {
281	continue
282	}
283	$graph_ element configure $elem -hide no
284	$tree_ set $node "show" 0
285	}
286	}
287
288	itcl::body Rappture::XyLegend::Toggle { args } {
289	if { $args == "" } {
290	set nodes [$itk_component(legend) curselection]
291	} else {
292	set nodes $args
293	}
294	foreach node $nodes {
295	set node [$itk_component(legend) index $node]
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	foreach node $nodes {
452	set elem [$tree_ label $node]
453	$xcoords append [GetData $elem -x]
454	set elements [linsert $elements 0 $elem]
455	}
456	# Sort the abscissas keeping unique values.
457	$xcoords sort -uniq
458
459	# Step 2. Now for each curve, generate a cubic spline of that curve
460	# and interpolate to get the corresponding y-values for each
461	# abscissa. Normally the abscissa are the same, so we're
462	# interpolation the knots.
463
464	set x [blt::vector create \#auto -command ""]
465	set y [blt::vector create \#auto -command ""]
466	$sum length [$xcoords length]
467
468	foreach node $nodes {
469	set elem [$tree_ label $node]
470	$x set [GetData $elem -x]
471	$y set [GetData $elem -y]
472	blt::spline natural $x $y $xcoords $ycoords
473
474	# Sum the interpolated y-coordinate values.
475	$sum expr "$sum + $ycoords"
476	}
477	blt::vector destroy $x $y
478
479	# Get the average
480	$sum expr "$sum / [llength $elements]"
481
482	# Step 3. Create a new curve which is the average. Append it to the
483	# the end.
484
485	set count 0
486	while {[$graph_ element exists avg$count] } {
487	incr count
488	}
489	set elements [lsort -dictionary $elements]
490	set name "avg$count"
491	set label "Avg. [join $elements ,]"
492
493	# Don't use the vector because we don't know when it will be cleaned up.
494
495	if { $lastColorIndex_ == 0 } {
496	set lastColorIndex_ [llength $autocolors_]
497	}
498	incr lastColorIndex_ -1
499	set color [lindex $autocolors_ $lastColorIndex_]
500	$graph_ element create $name -label $label -x [$xcoords range 0 end]\
501	-y [$sum range 0 end] -symbol scross -pixels 3 -color $color
502	blt::vector destroy $xcoords $ycoords $sum
503	set node [Add $name $label -delete]
504	Raise $node
505	blt::busy forget $itk_component(hull)
506	}
507
508	itcl::body Rappture::XyLegend::Difference {} {
509
510	if { $diff_ != "" } {
511	$graph_ marker delete $diff_
512	set diff_ ""
513	}
514	set nodes [$itk_component(legend) curselection]
515	set elem1 [$tree_ label [lindex $nodes 0]]
516	set elem2 [$tree_ label [lindex $nodes 1]]
517	if { [info exists diffelements_($elem1)] &&
518	[info exists diffelements_($elem2)] } {
519	array unset diffelements_; # Toggle the difference.
520	return;
521	}
522	array unset diffelements_
523	set x [blt::vector create \#auto -command ""]
524	set y [blt::vector create \#auto -command ""]
525	set m [blt::vector create \#auto -command ""]
526
527	$x append [GetData $elem1 -x]
528	$y append [GetData $elem1 -y]
529	$x sort -reverse $y
530	$x append [GetData $elem2 -x]
531	$y append [GetData $elem2 -y]
532	$m merge $x $y
533	set diff_ [$graph_ marker create polygon \
534	-coords [$m range 0 end] \
535	-element $elem1 \
536	-stipple dot1 \
537	-outline "" -fill "#cd69c9"]
538	blt::vector destroy $m $x $y
539	set diffelements_($elem1) 1
540	set diffelements_($elem2) 1
541	}
542
543
544	itcl::body Rappture::XyLegend::Recolor {} {
545	set nodes [$itk_component(legend) curselection]
546	if { $nodes == "" } {
547	return
548	}
549	foreach node $nodes {
550	set elem [$tree_ label $node]
551	if { $lastColorIndex_ == 0 } {
552	set lastColorIndex_ [llength $autocolors_]
553	}
554	incr lastColorIndex_ -1
555	set color [lindex $autocolors_ $lastColorIndex_]
556	$graph_ element configure $elem -color $color
557	set im [$itk_component(legend) entry cget $node -icon]
558	$graph_ legend icon $elem $im
559	}
560	}
561
562	itcl::body Rappture::XyLegend::SelectAll { } {
563	foreach node [$tree_ children 0] {
564	$itk_component(legend) selection set $node
565	}
566	}
567
568	itcl::body Rappture::XyLegend::Rename {} {
569	Editor popup
570	}
571
572	# ----------------------------------------------------------------------
573	# USAGE: Editor popup
574	# USAGE: Editor activate
575	# USAGE: Editor validate <value>
576	# USAGE: Editor apply <value>
577	# USAGE: Editor menu <rootx> <rooty>
578	#
579	# Used internally to handle the various functions of the pop-up
580	# editor for the value of this gauge.
581	# ----------------------------------------------------------------------
582	itcl::body Rappture::XyLegend::Editor {option args} {
583	switch -- $option {
584	popup {
585	$itk_component(editor) activate
586	}
587	activate {
588	set rename_ [$itk_component(legend) curselection]
589	if { $rename_ == "" } {
590	return;
591	}
592	set label [$itk_component(legend) entry cget $rename_ -label]
593	foreach { l r w h } [$itk_component(legend) bbox $rename_] break
594	set info(text) $label
595	set info(x) [expr $l + [winfo rootx $itk_component(legend)]]
596	set info(y) [expr $r + [winfo rooty $itk_component(legend)]]
597	set info(w) $w
598	set info(h) $h
599	return [array get info]
600	}
601	validate {
602	if {[llength $args] != 1} {
603	error "wrong # args: should be \"editor validate value\""
604	}
605	}
606	apply {
607	if {[llength $args] != 1} {
608	error "wrong # args: should be \"editor apply value\""
609	}
610	set label [lindex $args 0]
611	$itk_component(legend) entry configure $rename_ -label $label
612	set elem [$tree_ label $rename_]
613	$graph_ element configure $elem -label $label
614	}
615	menu {
616	eval tk_popup $itk_component(emenu) $args
617	}
618	default {
619	error "bad option \"$option\": should be popup, activate, validate, apply, and menu"
620	}
621	}
622	}

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

Download in other formats: