Context Navigation

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

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

File size: 17.6 KB

Line
1
2	proc lsave { file values } {
3	set f [open $file "w"]
4	puts $f $values
5	close $f
6	}
7
8	# ----------------------------------------------------------------------
9	# COMPONENT: xylegend - X/Y plot legend.
10	#
11	# This widget is a legend for an X/Y plot, meant to view line graphs produced
12	# as output from the run of a Rappture tool. Use the "add" and
13	# "delete" methods to control the curves showing on the plot.
14	# ======================================================================
15	# AUTHOR: Michael McLennan, Purdue University
16	# Copyright (c) 2004-2005 Purdue Research Foundation
17	#
18	# See the file "license.terms" for information on usage and
19	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
20	# ======================================================================
21	package require Itk
22	package require BLT
23
24	option add *Xylegend.font \
25	--helvetica-medium-r-normal--8-* widgetDefault
26
27	option add *Xylegend.Button.font \
28	--helvetica-medium-r-normal--9-* widgetDefault
29
30	itcl::class ::Rappture::XyLegend {
31	inherit itk::Widget
32
33	private variable _autocolors {
34	#0000cd
35	#cd0000
36	#00cd00
37	#3a5fcd
38	#cdcd00
39	#cd1076
40	#009acd
41	#00c5cd
42	#a2b5cd
43	#7ac5cd
44	#66cdaa
45	#a2cd5a
46	#cd9b9b
47	#cdba96
48	#cd3333
49	#cd6600
50	#cd8c95
51	#cd00cd
52	#9a32cd
53	#6ca6cd
54	#9ac0cd
55	#9bcd9b
56	#00cd66
57	#cdc673
58	#cdad00
59	#cd5555
60	#cd853f
61	#cd7054
62	#cd5b45
63	#cd6889
64	#cd69c9
65	#551a8b
66	}
67	private variable _lastColorIndex ""
68	private variable _dispatcher "" ;# dispatcher for !events
69	private variable _graph ""
70	private variable _tree ""
71	private variable _diff ""; # Polygon marker used for difference.
72	private variable _rename ""; # Node selected to be renamed.
73	private variable _diffelements
74
75	constructor {args} { graph }
76	destructor {}
77
78	public method reset {}
79
80	private method Add { elem label {flags ""}}
81	private method Average {}
82	private method Check {}
83	private method Delete { args }
84	private method Difference {}
85	private method Editor { option args }
86	private method GetData { elem what }
87	private method Hide { args }
88	private method Lower { args }
89	private method Raise { args }
90	private method Recolor {}
91	private method Rename {}
92	private method SelectAll {}
93	private method Show { args }
94	private method Toggle { args }
95	}
96
97	itk::usual XyLegend {
98	keep -background -foreground -cursor
99	}
100
101	itk::usual TreeView {
102	keep -foreground -cursor
103	}
104	itk::usual Scrollset {
105	}
106
107	blt::bitmap define dot1 {
108	#define dot1_width 8
109	#define dot1_height 8
110	static unsigned char dot1_bits[] = {
111	0x55, 0xaa, 0x55, 0xaa, 0x55, 0xaa, 0x55, 0xaa};
112	}
113
114	# ----------------------------------------------------------------------
115	# CONSTRUCTOR
116	# ----------------------------------------------------------------------
117	itcl::body Rappture::XyLegend::constructor { graph args } {
118	option add hull.width hull.height
119	pack propagate $itk_component(hull) no
120	itk_component add scrollbars {
121	blt::scrollset $itk_interior.scrl \
122	-xscrollbar $itk_interior.scrl.xs \
123	-yscrollbar $itk_interior.scrl.ys \
124	-window $itk_interior.scrl.legend \
125	-height 100
126	}
127
128	blt::tk::scrollbar $itk_interior.scrl.xs
129	blt::tk::scrollbar $itk_interior.scrl.ys
130	set _tree [blt::tree create]
131	itk_component add legend {
132	blt::treeview $itk_component(scrollbars).legend -linewidth 0 \
133	-bg white -selectmode multiple \
134	-highlightthickness 0 \
135	-tree $_tree \
136	-font "Arial 9" \
137	-flat yes -separator /
138	}
139	$itk_component(legend) column insert 0 "show" \
140	-text "" -weight 0.0 -pad 0 -borderwidth 0
141	$itk_component(legend) style checkbox "check" -showvalue no \
142	-onvalue 0 -offvalue 1
143	$itk_component(legend) column configure "treeView" -justify left \
144	-weight 1.0 -text "" -pad 0 -borderwidth 0 -edit no
145	$itk_component(legend) column configure "show" -style "check" -pad {0 0} \
146	-edit yes
147	set m $itk_component(hull).mb.menu
148	blt::combobutton $itk_component(hull).mb -text "Operations" \
149	-icon [Rappture::icon wrench] \
150	-menu $m -activerelief raised -relief flat
151
152	itk_component add controls {
153	blt::combomenu $m \
154	-yscrollbar $m.ys \
155	-xscrollbar $m.xs
156	}
157	blt::tk::scrollbar $m.xs
158	blt::tk::scrollbar $m.ys
159
160	$m add -text "Hide" -command [itcl::code $this Hide]
161	$m add -text "Show" -command [itcl::code $this Show]
162	$m add -text "Toggle" -command [itcl::code $this Toggle]
163	$m add -type separator
164	$m add -text "Lower" -command [itcl::code $this Lower]
165	$m add -text "Raise" -command [itcl::code $this Raise]
166	$m add -type separator
167	$m add -text "Average" -command [itcl::code $this Average]
168	$m add -text "Difference" -command [itcl::code $this Difference]
169	$m add -type separator
170	$m add -text "Recolor" -command [itcl::code $this Recolor]
171	$m add -text "Rename" -command [itcl::code $this Rename]
172	$m add -text "Delete" -command [itcl::code $this Delete]
173
174	set _graph $graph
175	set cmd [itcl::code $this Toggle current]
176	$itk_component(legend) bind CheckBoxStyle <ButtonRelease-1> \
177	[itcl::code [subst -nocommands {
178	if { [%W edit -root -test %X %Y] } {
179	%W edit -root %X %Y
180	$this Toggle [%W nearest -root %X %Y]
181	break
182	}
183	}]]
184	bind $itk_component(legend) <Enter> { focus %W }
185	$itk_component(legend) bind Entry <Control-KeyRelease-a> \
186	[itcl::code $this SelectAll]
187	$itk_component(legend) bind Entry <KeyRelease-Return> \
188	+[itcl::code $this Toggle focus]
189	$itk_component(legend) bind Entry <Escape> \
190	"$itk_component(legend) selection clearall"
191	$itk_component(legend) configure -selectcommand \
192	[itcl::code $this Check]
193
194	itk_component add editor {
195	Rappture::Editor $itk_interior.editor \
196	-activatecommand [itcl::code $this Editor activate] \
197	-validatecommand [itcl::code $this Editor validate] \
198	-applycommand [itcl::code $this Editor apply]
199	}
200	set _lastColorIndex [llength $_autocolors]
201	blt::table $itk_interior \
202	0,0 $itk_interior.mb -anchor w \
203	1,0 $itk_component(scrollbars) -fill both
204	blt::table configure $itk_interior r0 -resize none
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 picture]
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	update idletasks
230	return $node
231	}
232
233	# ----------------------------------------------------------------------
234	# USAGE: reset <curve> ?<settings>?
235	#
236	# Clients use this to add a curve to the plot. The optional <settings>
237	# are used to configure the plot. Allowed settings are -color,
238	# -brightness, -width, -linestyle and -raise.
239	# ----------------------------------------------------------------------
240	itcl::body Rappture::XyLegend::reset {} {
241	foreach node [$_tree children root] {
242	$_tree delete $node
243	}
244	foreach elem [$_graph element show] {
245	set label [$_graph element cget $elem -label]
246	if { $label == "" } {
247	set label $elem
248	}
249	Add $elem $label
250	}
251	$itk_component(legend) open -recurse root
252	Check
253	}
254
255	itcl::body Rappture::XyLegend::Hide { args } {
256	if { $args == "" } {
257	set nodes [$itk_component(legend) curselection]
258	} else {
259	set nodes $args
260	}
261	foreach node $nodes {
262	set elem [$_tree label $node]
263	if { ![$_graph element exists $elem] } {
264	continue
265	}
266	$_graph element configure $elem -hide yes
267	$_tree set $node "show" 1
268	}
269	}
270
271	itcl::body Rappture::XyLegend::Show { args } {
272	if { $args == "" } {
273	set nodes [$itk_component(legend) curselection]
274	} else {
275	set nodes $args
276	}
277	foreach node $nodes {
278	set elem [$_tree label $node]
279	if { ![$_graph element exists $elem] } {
280	continue
281	}
282	$_graph element configure $elem -hide no
283	$_tree set $node "show" 0
284	}
285	}
286
287	itcl::body Rappture::XyLegend::Toggle { args } {
288	if { $args == "" } {
289	set nodes [$itk_component(legend) curselection]
290	} else {
291	set nodes $args
292	}
293	foreach node $nodes {
294	set elem [$_tree label $node]
295	if { ![$_graph element exists $elem] } {
296	continue
297	}
298	set hide [$_graph element cget $elem -hide]
299	set hide [expr $hide==0]
300	$_tree set $node "show" $hide
301	$_graph element configure $elem -hide $hide
302	}
303	}
304
305	itcl::body Rappture::XyLegend::Raise { args } {
306	if { $args == "" } {
307	set nodes [$itk_component(legend) curselection]
308	} else {
309	set nodes $args
310	}
311	set elements {}
312	foreach node $nodes {
313	set elem [$_tree label $node]
314	set found($elem) 1
315	set elements [linsert $elements 0 $elem]
316	}
317	foreach elem $elements {
318	$_tree move [$_tree index $elem] 0 -at 0
319	}
320	set list {}
321	foreach elem [$_graph element show] {
322	if { [info exists found($elem)] } {
323	continue
324	}
325	lappend list $elem
326	}
327	$_graph element show [concat $list $elements]
328	}
329
330	itcl::body Rappture::XyLegend::Lower { args } {
331	if { $args == "" } {
332	set nodes [$itk_component(legend) curselection]
333	} else {
334	set nodes $args
335	}
336	set elements {}
337	foreach node $nodes {
338	set elem [$_tree label $node]
339	set found($elem) 1
340	set elements [linsert $elements 0 $elem]
341	}
342	set pos [$_tree degree 0]
343
344	foreach elem $elements {
345	incr pos -1
346	$_tree move [$_tree index $elem] 0 -at $pos
347	}
348
349	set list {}
350	foreach elem [$_graph element show] {
351	if { [info exists found($elem)] } {
352	continue
353	}
354	lappend list $elem
355	}
356	$_graph element show [concat $elements $list]
357	}
358
359	itcl::body Rappture::XyLegend::Delete { args } {
360	if { $args == "" } {
361	set nodes [$itk_component(legend) curselection]
362	} else {
363	set nodes $args
364	}
365	set elements {}
366	set delnodes {}
367	foreach node $nodes {
368	if { ![$_tree get $node "delete" 0] } {
369	continue
370	}
371	set elem [$_tree label $node]
372	lappend elements $elem
373	lappend delnodes $node
374	if { $_diff != "" && [info exists _diffelements($elem)] } {
375	$_graph marker delete $_diff
376	array unset _diffelements
377	set _diff ""
378	}
379	}
380	if { [llength $delnodes] > 0 } {
381	eval $_tree delete $delnodes
382	}
383	$itk_component(legend) selection clearall
384	eval $_graph element delete $elements
385	}
386
387	itcl::body Rappture::XyLegend::Check {} {
388	set nodes [$itk_component(legend) curselection]
389	foreach n { Hide Show Toggle Raise Lower Rename Average Difference
390	Delete Recolor } {
391	$itk_component(controls) item configure $n -state disabled
392	}
393	foreach node $nodes {
394	if { [$_tree get $node "delete" 0] } {
395	$itk_component(controls) item configure delete -state normal
396	break
397	}
398	}
399	if { [$_tree degree 0] > 1 && [llength $nodes] > 0 } {
400	foreach n { Raise Lower } {
401	$itk_component(controls) item configure $n -state normal
402	}
403	}
404	switch -- [llength $nodes] {
405	0 {
406	}
407	1 {
408	foreach n { Hide Show Toggle Rename Recolor } {
409	$itk_component(controls) item configure $n -state normal
410	}
411	}
412	2 {
413	foreach n { Hide Show Toggle Difference Average Recolor } {
414	$itk_component(controls) item configure $n -state normal
415	}
416	}
417	default {
418	foreach n { Hide Show Toggle Average Recolor } {
419	$itk_component(controls) item configure $n -state normal
420	}
421	}
422	}
423	}
424
425	itcl::body Rappture::XyLegend::GetData { elem axis } {
426	set data [$_graph element cget $elem $axis]
427	switch [llength $data] {
428	1 {
429	# Vector name
430	set vector $data
431	if { [blt::vector names $vector] == $vector } {
432	return [$vector range 0 end]
433	}
434	}
435	2 {
436	# Table and column name
437	foreach {table column} $data break
438	if { [blt::datatable names $table] == $table } {
439	set data [$table column values $column]
440	$table export csv -file $table.csv
441	lsave $table [$table column get -labels $column]
442	return $data
443	}
444	}
445	}
446	# Otherwise assume it's a list of numbers.
447	return $data
448	}
449
450	itcl::body Rappture::XyLegend::Average {} {
451	set nodes [$itk_component(legend) curselection]
452	if { $nodes == "" } {
453	return
454	}
455	set elements {}
456	set sum [blt::vector create \#auto -command ""]
457
458	set xcoords [blt::vector create \#auto -command ""]
459	set ycoords [blt::vector create \#auto -command ""]
460
461	blt::busy hold $itk_component(hull)
462	update
463	# Step 1. Get the x-values for each curve, then sort them to get the
464	# unique values.
465
466	set labels {}
467	foreach node $nodes {
468	set elem [$_tree label $node]
469	set label [$_graph element cget $elem -label]
470	$xcoords append [GetData $elem -x]
471	set elements [linsert $elements 0 $elem]
472	set labels [linsert $labels 0 $label]
473	}
474	# Sort the abscissas keeping unique values.
475	$xcoords sort -uniq
476
477	# Step 2. Now for each curve, generate a cubic spline of that curve
478	# and interpolate to get the corresponding y-values for each
479	# abscissa. Normally the abscissa are the same, so we're
480	# interpolation the knots.
481
482	set x [blt::vector create \#auto -command ""]
483	set y [blt::vector create \#auto -command ""]
484	$sum length [$xcoords length]
485
486	foreach node $nodes {
487	set elem [$_tree label $node]
488	$x set [GetData $elem -x]
489	$y set [GetData $elem -y]
490	blt::spline natural $x $y $xcoords $ycoords
491
492	# Sum the interpolated y-coordinate values.
493	$sum expr "$sum + $ycoords"
494	}
495	blt::vector destroy $x $y
496
497	# Get the average
498	$sum expr "$sum / [llength $elements]"
499
500	# Step 3. Create a new curve which is the average. Append it to the
501	# the end.
502
503	set count 0
504	while {[$_graph element exists avg$count] } {
505	incr count
506	}
507	set labels [lsort -dictionary $labels]
508	set name "avg$count"
509	set label "Avg. [join $labels ,]"
510
511	# Don't use the vector because we don't know when it will be cleaned up.
512
513	if { $_lastColorIndex == 0 } {
514	set _lastColorIndex [llength $_autocolors]
515	}
516	incr _lastColorIndex -1
517	set color [lindex $_autocolors $_lastColorIndex]
518	$_graph element create $name -label $label -x [$xcoords range 0 end]\
519	-y [$sum range 0 end] -symbol scross -pixels 3 -color $color
520	blt::vector destroy $xcoords $ycoords $sum
521	set node [Add $name $label -delete]
522	Raise $node
523	blt::busy forget $itk_component(hull)
524	}
525
526	itcl::body Rappture::XyLegend::Difference {} {
527
528	if { $_diff != "" } {
529	$_graph marker delete $_diff
530	set _diff ""
531	}
532	set nodes [$itk_component(legend) curselection]
533	set elem1 [$_tree label [lindex $nodes 0]]
534	set elem2 [$_tree label [lindex $nodes 1]]
535	if { [info exists _diffelements($elem1)] &&
536	[info exists _diffelements($elem2)] } {
537	array unset _diffelements; # Toggle the difference.
538	return;
539	}
540	array unset _diffelements
541	set x [blt::vector create \#auto -command ""]
542	set y [blt::vector create \#auto -command ""]
543	set m [blt::vector create \#auto -command ""]
544
545	$x append [GetData $elem1 -x]
546	$y append [GetData $elem1 -y]
547	$x sort -reverse $y
548	$x append [GetData $elem2 -x]
549	$y append [GetData $elem2 -y]
550	$m merge $x $y
551	set _diff [$_graph marker create polygon \
552	-coords [$m range 0 end] \
553	-element $elem1 \
554	-stipple dot1 \
555	-outline "" -fill "#cd69c9"]
556	blt::vector destroy $m $x $y
557	set _diffelements($elem1) 1
558	set _diffelements($elem2) 1
559	}
560
561
562	itcl::body Rappture::XyLegend::Recolor {} {
563	set nodes [$itk_component(legend) curselection]
564	if { $nodes == "" } {
565	return
566	}
567	foreach node $nodes {
568	set elem [$_tree label $node]
569	if { $_lastColorIndex == 0 } {
570	set _lastColorIndex [llength $_autocolors]
571	}
572	incr _lastColorIndex -1
573	set color [lindex $_autocolors $_lastColorIndex]
574	$_graph element configure $elem -color $color
575	set im [$itk_component(legend) entry cget $node -icon]
576	$_graph legend icon $elem $im
577	}
578	}
579
580	itcl::body Rappture::XyLegend::SelectAll { } {
581	foreach node [$_tree children 0] {
582	$itk_component(legend) selection set $node
583	}
584	}
585
586	itcl::body Rappture::XyLegend::Rename {} {
587	Editor popup
588	}
589
590	# ----------------------------------------------------------------------
591	# USAGE: Editor popup
592	# USAGE: Editor activate
593	# USAGE: Editor validate <value>
594	# USAGE: Editor apply <value>
595	# USAGE: Editor menu <rootx> <rooty>
596	#
597	# Used internally to handle the various functions of the pop-up
598	# editor for the value of this gauge.
599	# ----------------------------------------------------------------------
600	itcl::body Rappture::XyLegend::Editor {option args} {
601	switch -- $option {
602	popup {
603	$itk_component(editor) activate
604	}
605	activate {
606	set _rename [$itk_component(legend) curselection]
607	if { $_rename == "" } {
608	return;
609	}
610	set label [$itk_component(legend) entry cget $_rename -label]
611	foreach { l r w h } [$itk_component(legend) bbox $_rename] break
612	set info(text) $label
613	set info(x) [expr $l + [winfo rootx $itk_component(legend)]]
614	set info(y) [expr $r + [winfo rooty $itk_component(legend)]]
615	set info(w) $w
616	set info(h) $h
617	return [array get info]
618	}
619	validate {
620	if {[llength $args] != 1} {
621	error "wrong # args: should be \"editor validate value\""
622	}
623	}
624	apply {
625	if {[llength $args] != 1} {
626	error "wrong # args: should be \"editor apply value\""
627	}
628	set label [lindex $args 0]
629	$itk_component(legend) entry configure $_rename -label $label
630	set elem [$_tree label $_rename]
631	$_graph element configure $elem -label $label
632	}
633	menu {
634	eval tk_popup $itk_component(emenu) $args
635	}
636	default {
637	error "bad option \"$option\": should be popup, activate, validate, apply, and menu"
638	}
639	}
640	}

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

Download in other formats: