Context Navigation

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

Last change on this file since 2652 was 1943, checked in by gah, 14 years ago
add unit cell to molvisviewer
File size: 19.2 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 {graph args} {}
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 elem [$_tree label $node]
296	if { ![$_graph element exists $elem] } {
297	continue
298	}
299	set hide [$_graph element cget $elem -hide]
300	set hide [expr $hide==0]
301	$_tree set $node "show" $hide
302	$_graph element configure $elem -hide $hide
303	}
304	}
305
306	itcl::body Rappture::XyLegend::Raise { args } {
307	if { $args == "" } {
308	set nodes [$itk_component(legend) curselection]
309	} else {
310	set nodes $args
311	}
312	set elements {}
313	foreach node $nodes {
314	set elem [$_tree label $node]
315	set found($elem) 1
316	set elements [linsert $elements 0 $elem]
317	}
318	foreach elem $elements {
319	$_tree move [$_tree index $elem] 0 -at 0
320	}
321	set list {}
322	foreach elem [$_graph element show] {
323	if { [info exists found($elem)] } {
324	continue
325	}
326	lappend list $elem
327	}
328	$_graph element show [concat $list $elements]
329	}
330
331	itcl::body Rappture::XyLegend::Lower { args } {
332	if { $args == "" } {
333	set nodes [$itk_component(legend) curselection]
334	} else {
335	set nodes $args
336	}
337	set elements {}
338	foreach node $nodes {
339	set elem [$_tree label $node]
340	set found($elem) 1
341	set elements [linsert $elements 0 $elem]
342	}
343	set pos [$_tree degree 0]
344
345	foreach elem $elements {
346	incr pos -1
347	$_tree move [$_tree index $elem] 0 -at $pos
348	}
349
350	set list {}
351	foreach elem [$_graph element show] {
352	if { [info exists found($elem)] } {
353	continue
354	}
355	lappend list $elem
356	}
357	$_graph element show [concat $elements $list]
358	}
359
360	itcl::body Rappture::XyLegend::Delete { args } {
361	if { $args == "" } {
362	set nodes [$itk_component(legend) curselection]
363	} else {
364	set nodes $args
365	}
366	set elements {}
367	set delnodes {}
368	foreach node $nodes {
369	if { ![$_tree get $node "delete" 0] } {
370	continue
371	}
372	set elem [$_tree label $node]
373	lappend elements $elem
374	lappend delnodes $node
375	if { $_diff != "" && [info exists _diffelements($elem)] } {
376	$_graph marker delete $_diff
377	array unset _diffelements
378	set _diff ""
379	}
380	}
381	if { [llength $delnodes] > 0 } {
382	eval $_tree delete $delnodes
383	}
384	$itk_component(legend) selection clearall
385	eval $_graph element delete $elements
386	}
387
388	itcl::body Rappture::XyLegend::Check {} {
389	set nodes [$itk_component(legend) curselection]
390	foreach n { hide show toggle raise lower
391	rename average difference delete recolor } {
392	$itk_component(controls).$n configure -state disabled
393	}
394	foreach node $nodes {
395	if { [$_tree get $node "delete" 0] } {
396	$itk_component(controls).delete configure -state normal
397	break
398	}
399	}
400	if { [$_tree degree 0] > 1 && [llength $nodes] > 0 } {
401	foreach n { raise lower } {
402	$itk_component(controls).$n configure -state normal
403	}
404	}
405	switch -- [llength $nodes] {
406	0 {
407	}
408	1 {
409	foreach n { hide show toggle rename recolor } {
410	$itk_component(controls).$n configure -state normal
411	}
412	}
413	2 {
414	foreach n { hide show toggle difference average recolor } {
415	$itk_component(controls).$n configure -state normal
416	}
417	}
418	default {
419	foreach n { hide show toggle average recolor } {
420	$itk_component(controls).$n configure -state normal
421	}
422	}
423	}
424	}
425
426	itcl::body Rappture::XyLegend::GetData { elem what } {
427	set y [$_graph element cget $elem $what]
428	if { [blt::vector names $y] == $y } {
429	set y [$y range 0 end]
430	}
431	return $y
432	}
433
434	itcl::body Rappture::XyLegend::Average {} {
435	set nodes [$itk_component(legend) curselection]
436	if { $nodes == "" } {
437	return
438	}
439	set elements {}
440	set sum [blt::vector create \#auto -command ""]
441
442	set xcoords [blt::vector create \#auto -command ""]
443	set ycoords [blt::vector create \#auto -command ""]
444
445	blt::busy hold $itk_component(hull)
446	update
447	# Step 1. Get the x-values for each curve, then sort them to get the
448	# unique values.
449
450	foreach node $nodes {
451	set elem [$_tree label $node]
452	$xcoords append [GetData $elem -x]
453	set elements [linsert $elements 0 $elem]
454	}
455	# Sort the abscissas keeping unique values.
456	$xcoords sort -uniq
457
458	# Step 2. Now for each curve, generate a cubic spline of that curve
459	# and interpolate to get the corresponding y-values for each
460	# abscissa. Normally the abscissa are the same, so we're
461	# interpolation the knots.
462
463	set x [blt::vector create \#auto -command ""]
464	set y [blt::vector create \#auto -command ""]
465	$sum length [$xcoords length]
466
467	foreach node $nodes {
468	set elem [$_tree label $node]
469	$x set [GetData $elem -x]
470	$y set [GetData $elem -y]
471	blt::spline natural $x $y $xcoords $ycoords
472
473	# Sum the interpolated y-coordinate values.
474	$sum expr "$sum + $ycoords"
475	}
476	blt::vector destroy $x $y
477
478	# Get the average
479	$sum expr "$sum / [llength $elements]"
480
481	# Step 3. Create a new curve which is the average. Append it to the
482	# the end.
483
484	set count 0
485	while {[$_graph element exists avg$count] } {
486	incr count
487	}
488	set elements [lsort -dictionary $elements]
489	set name "avg$count"
490	set label "Avg. [join $elements ,]"
491
492	# Don't use the vector because we don't know when it will be cleaned up.
493
494	if { $_lastColorIndex == 0 } {
495	set _lastColorIndex [llength $_autocolors]
496	}
497	incr _lastColorIndex -1
498	set color [lindex $_autocolors $_lastColorIndex]
499	$_graph element create $name -label $label -x [$xcoords range 0 end]\
500	-y [$sum range 0 end] -symbol scross -pixels 3 -color $color
501	blt::vector destroy $xcoords $ycoords $sum
502	set node [Add $name $label -delete]
503	Raise $node
504	blt::busy forget $itk_component(hull)
505	}
506
507	itcl::body Rappture::XyLegend::Difference {} {
508
509	if { $_diff != "" } {
510	$_graph marker delete $_diff
511	set _diff ""
512	}
513	set nodes [$itk_component(legend) curselection]
514	set elem1 [$_tree label [lindex $nodes 0]]
515	set elem2 [$_tree label [lindex $nodes 1]]
516	if { [info exists _diffelements($elem1)] &&
517	[info exists _diffelements($elem2)] } {
518	array unset _diffelements; # Toggle the difference.
519	return;
520	}
521	array unset _diffelements
522	set x [blt::vector create \#auto -command ""]
523	set y [blt::vector create \#auto -command ""]
524	set m [blt::vector create \#auto -command ""]
525
526	$x append [GetData $elem1 -x]
527	$y append [GetData $elem1 -y]
528	$x sort -reverse $y
529	$x append [GetData $elem2 -x]
530	$y append [GetData $elem2 -y]
531	$m merge $x $y
532	set _diff [$_graph marker create polygon \
533	-coords [$m range 0 end] \
534	-element $elem1 \
535	-stipple dot1 \
536	-outline "" -fill "#cd69c9"]
537	blt::vector destroy $m $x $y
538	set _diffelements($elem1) 1
539	set _diffelements($elem2) 1
540	}
541
542
543	itcl::body Rappture::XyLegend::Recolor {} {
544	set nodes [$itk_component(legend) curselection]
545	if { $nodes == "" } {
546	return
547	}
548	foreach node $nodes {
549	set elem [$_tree label $node]
550	if { $_lastColorIndex == 0 } {
551	set _lastColorIndex [llength $_autocolors]
552	}
553	incr _lastColorIndex -1
554	set color [lindex $_autocolors $_lastColorIndex]
555	$_graph element configure $elem -color $color
556	set im [$itk_component(legend) entry cget $node -icon]
557	$_graph legend icon $elem $im
558	}
559	}
560
561	itcl::body Rappture::XyLegend::SelectAll { } {
562	foreach node [$_tree children 0] {
563	$itk_component(legend) selection set $node
564	}
565	}
566
567	itcl::body Rappture::XyLegend::Rename {} {
568	Editor popup
569	}
570
571	# ----------------------------------------------------------------------
572	# USAGE: Editor popup
573	# USAGE: Editor activate
574	# USAGE: Editor validate <value>
575	# USAGE: Editor apply <value>
576	# USAGE: Editor menu <rootx> <rooty>
577	#
578	# Used internally to handle the various functions of the pop-up
579	# editor for the value of this gauge.
580	# ----------------------------------------------------------------------
581	itcl::body Rappture::XyLegend::Editor {option args} {
582	switch -- $option {
583	popup {
584	$itk_component(editor) activate
585	}
586	activate {
587	set _rename [$itk_component(legend) curselection]
588	if { $_rename == "" } {
589	return;
590	}
591	set label [$itk_component(legend) entry cget $_rename -label]
592	foreach { l r w h } [$itk_component(legend) bbox $_rename] break
593	set info(text) $label
594	set info(x) [expr $l + [winfo rootx $itk_component(legend)]]
595	set info(y) [expr $r + [winfo rooty $itk_component(legend)]]
596	set info(w) $w
597	set info(h) $h
598	return [array get info]
599	}
600	validate {
601	if {[llength $args] != 1} {
602	error "wrong # args: should be \"editor validate value\""
603	}
604	}
605	apply {
606	if {[llength $args] != 1} {
607	error "wrong # args: should be \"editor apply value\""
608	}
609	set label [lindex $args 0]
610	$itk_component(legend) entry configure $_rename -label $label
611	set elem [$_tree label $_rename]
612	$_graph element configure $elem -label $label
613	}
614	menu {
615	eval tk_popup $itk_component(emenu) $args
616	}
617	default {
618	error "bad option \"$option\": should be popup, activate, validate, apply, and menu"
619	}
620	}
621	}

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

Download in other formats: