Context Navigation

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

Last change on this file since 1141 was 1141, checked in by gah, 16 years ago
fixes for entry label editting
File size: 16.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 _dispatcher "" ;# dispatcher for !events
28	private variable graph_ ""
29	private variable tree_ ""
30	private variable diff_ ""
31	private variable focus_ ""
32	private variable diffelements_
33
34	constructor {args} { graph }
35	destructor {}
36
37	public method Activate {}
38	public method Average {}
39	public method Check {}
40	public method Deactivate {}
41	public method Delete { args }
42	public method Difference {}
43	public method Editor { option args }
44	public method Hide { args }
45	public method Lower { args }
46	public method Raise { args }
47	public method Rename {}
48	public method Show { args }
49	public method Toggle { args }
50	private method GetData { elem what }
51	private method Add { elem label {flags ""}}
52	private method SelectAll {}
53	}
54
55	itk::usual XyLegend {
56	keep -background -foreground -cursor
57	}
58
59	itk::usual TreeView {
60	keep -background -foreground -cursor
61	}
62
63	blt::bitmap define dot1 {
64	#define dot1_width 8
65	#define dot1_height 8
66	static unsigned char dot1_bits[] = {
67	0x55, 0xaa, 0x55, 0xaa, 0x55, 0xaa, 0x55, 0xaa};
68	}
69
70	# ----------------------------------------------------------------------
71	# CONSTRUCTOR
72	# ----------------------------------------------------------------------
73	itcl::body Rappture::XyLegend::constructor { graph args } {
74	option add hull.width hull.height
75	itk_component add scrollbars {
76	Rappture::Scroller $itk_interior.scrl \
77	-xscrollmode auto -yscrollmode auto
78	}
79	set tree_ [blt::tree create]
80	itk_component add legend {
81	blt::treeview $itk_component(scrollbars).legend -linewidth 0 \
82	-bg white -selectmode multiple -width 0 \
83	-highlightthickness 0 \
84	-tree $tree_ \
85	-font "Arial 9" \
86	-flat yes -separator /
87	}
88	$itk_component(scrollbars) contents $itk_component(legend)
89	$itk_component(legend) column insert 0 "show" \
90	-text "" -weight 0.0 -pad 0 -borderwidth 0
91	$itk_component(legend) style checkbox "check" -showvalue no \
92	-onvalue 0 -offvalue 1 \
93	-boxcolor grey50 -checkcolor black -activebackground grey90
94	$itk_component(legend) column configure "treeView" -justify left \
95	-weight 1.0 -text "" -pad 0 -borderwidth 0
96	$itk_component(legend) column configure "show" -style "check" -pad {0 0} \
97	-edit yes
98	itk_component add controls {
99	frame $itk_component(hull).controls -width 100 -relief sunken -bd 2
100	}
101	set controls $itk_component(controls)
102	grid $itk_component(controls) -column 0 -row 1 -sticky nsew
103	grid columnconfigure $itk_component(hull) 0 -weight 1
104	grid rowconfigure $itk_component(hull) 1 \
105	-minsize [winfo reqheight $itk_component(scrollbars)]
106	grid rowconfigure $itk_component(hull) 0 -weight 1
107	grid $itk_component(scrollbars) -column 0 -row 0 -sticky nsew
108	set commands {
109	hide ""
110	show ""
111	toggle ""
112	raise findup
113	lower finddn
114	average ""
115	difference ""
116	delete ""
117	rename ""
118	}
119	foreach { but icon} $commands {
120	set title [string totitle $but]
121	button $controls.$but -text $title \
122	-relief flat -pady 0 -padx 0 -font "Arial 9" \
123	-command [itcl::code $this $title] -overrelief flat \
124	-activebackground grey90
125	}
126	grid $controls.hide -column 0 -row 0 -sticky w
127	grid $controls.show -column 0 -row 1 -sticky w
128	grid $controls.toggle -column 0 -row 2 -sticky w
129	grid $controls.raise -column 0 -row 3 -sticky w
130	grid $controls.lower -column 0 -row 4 -sticky w
131	grid $controls.difference -column 1 -row 0 -sticky w
132	grid $controls.average -column 1 -row 1 -sticky w
133	grid $controls.rename -column 1 -row 2 -sticky w
134	grid $controls.delete -column 1 -row 3 -sticky w
135
136	grid columnconfigure $controls 0 -weight 1
137	grid columnconfigure $controls 1 -weight 1
138
139	set graph_ $graph
140	set cmd [itcl::code $this Toggle current]
141	$itk_component(legend) bind CheckBoxStyle <ButtonRelease-1> \
142	[itcl::code [subst -nocommands {
143	if { [%W edit -root -test %X %Y] } {
144	%W edit -root %X %Y
145	$this Toggle [%W nearest -root %X %Y]
146	break
147	}
148	}]]
149	bind $itk_component(legend) <Enter> { focus %W }
150	$itk_component(legend) bind Entry <Control-KeyRelease-a> \
151	[itcl::code $this SelectAll]
152	$itk_component(legend) bind Entry <KeyRelease-Return> \
153	+[itcl::code $this Toggle focus]
154	$itk_component(legend) bind Entry <Escape> \
155	"$itk_component(legend) selection clearall"
156	$itk_component(legend) configure -selectcommand \
157	[itcl::code $this Check]
158
159	itk_component add editor {
160	Rappture::Editor $itk_interior.editor \
161	-activatecommand [itcl::code $this Editor activate] \
162	-validatecommand [itcl::code $this Editor validate] \
163	-applycommand [itcl::code $this Editor apply]
164	}
165	Check
166	eval itk_initialize $args
167	}
168
169	# ----------------------------------------------------------------------
170	# DESTRUCTOR
171	# ----------------------------------------------------------------------
172	itcl::body Rappture::XyLegend::destructor {} {
173	Deactivate
174	}
175
176	itcl::body Rappture::XyLegend::Add { elem label {flags ""} } {
177	set hide [$graph_ element cget $elem -hide]
178	set im [image create photo]
179	$graph_ legend icon $elem $im
180	set data(show) $hide
181	set data(delete) [expr { $flags == "-delete" }]
182	set node [$tree_ insert root -at 0 -label $elem -data [array get data]]
183	$itk_component(legend) entry configure $node -label $label -icon $im \
184	-activeicon $im
185	return $node
186	}
187
188	# ----------------------------------------------------------------------
189	# USAGE: activate <curve> ?<settings>?
190	#
191	# Clients use this to add a curve to the plot. The optional <settings>
192	# are used to configure the plot. Allowed settings are -color,
193	# -brightness, -width, -linestyle and -raise.
194	# ----------------------------------------------------------------------
195	itcl::body Rappture::XyLegend::Activate {} {
196	foreach elem [$graph_ element show] {
197	set label [$graph_ element cget $elem -label]
198	if { $label == "" } {
199	set label $elem
200	}
201	Add $elem $label
202	}
203	$itk_component(legend) open -recurse root
204	}
205
206	itcl::body Rappture::XyLegend::Deactivate {} {
207	foreach node [$tree_ children root] {
208	$tree_ delete $node
209	}
210	}
211
212	itcl::body Rappture::XyLegend::Hide { args } {
213	if { $args == "" } {
214	set nodes [$itk_component(legend) curselection]
215	} else {
216	set nodes $args
217	}
218	foreach node $nodes {
219	set elem [$tree_ label $node]
220	if { ![$graph_ element exists $elem] } {
221	continue
222	}
223	$graph_ element configure $elem -hide yes
224	$tree_ set $node "show" 1
225	}
226	}
227
228	itcl::body Rappture::XyLegend::Show { args } {
229	if { $args == "" } {
230	set nodes [$itk_component(legend) curselection]
231	} else {
232	set nodes $args
233	}
234	foreach node $nodes {
235	set elem [$tree_ label $node]
236	if { ![$graph_ element exists $elem] } {
237	continue
238	}
239	$graph_ element configure $elem -hide no
240	$tree_ set $node "show" 0
241	}
242	}
243
244	itcl::body Rappture::XyLegend::Toggle { args } {
245	if { $args == "" } {
246	set nodes [$itk_component(legend) curselection]
247	} else {
248	set nodes $args
249	}
250	foreach node $nodes {
251	set node [$itk_component(legend) index $node]
252	set elem [$tree_ label $node]
253	if { ![$graph_ element exists $elem] } {
254	continue
255	}
256	set hide [$graph_ element cget $elem -hide]
257	set hide [expr $hide==0]
258	$tree_ set $node "show" $hide
259	$graph_ element configure $elem -hide $hide
260	}
261	}
262
263	itcl::body Rappture::XyLegend::Raise { args } {
264	if { $args == "" } {
265	set nodes [$itk_component(legend) curselection]
266	} else {
267	set nodes $args
268	}
269	set elements {}
270	foreach node $nodes {
271	set elem [$tree_ label $node]
272	set found($elem) 1
273	set elements [linsert $elements 0 $elem]
274	}
275	foreach elem $elements {
276	$tree_ move [$tree_ index $elem] 0 -at 0
277	}
278	set list {}
279	foreach elem [$graph_ element show] {
280	if { [info exists found($elem)] } {
281	continue
282	}
283	lappend list $elem
284	}
285	$graph_ element show [concat $list $elements]
286	}
287
288	itcl::body Rappture::XyLegend::Lower { args } {
289	if { $args == "" } {
290	set nodes [$itk_component(legend) curselection]
291	} else {
292	set nodes $args
293	}
294	set elements {}
295	foreach node $nodes {
296	set elem [$tree_ label $node]
297	set found($elem) 1
298	set elements [linsert $elements 0 $elem]
299	}
300	set pos [$tree_ degree 0]
301
302	foreach elem $elements {
303	incr pos -1
304	$tree_ move [$tree_ index $elem] 0 -at $pos
305	}
306
307	set list {}
308	foreach elem [$graph_ element show] {
309	if { [info exists found($elem)] } {
310	continue
311	}
312	lappend list $elem
313	}
314	$graph_ element show [concat $elements $list]
315	}
316
317	itcl::body Rappture::XyLegend::Delete { args } {
318	if { $args == "" } {
319	set nodes [$itk_component(legend) curselection]
320	} else {
321	set nodes $args
322	}
323	set elements {}
324	set delnodes {}
325	foreach node $nodes {
326	if { ![$tree_ get $node "delete" 0] } {
327	continue
328	}
329	set elem [$tree_ label $node]
330	lappend elements $elem
331	lappend delnodes $node
332	if { $diff_ != "" && [info exists diffelements_($elem)] } {
333	$graph_ marker delete $diff_
334	array unset diffelements_
335	set diff_ ""
336	}
337	}
338	if { [llength $delnodes] > 0 } {
339	eval $tree_ delete $delnodes
340	}
341	$itk_component(legend) selection clearall
342	eval $graph_ element delete $elements
343	}
344
345	itcl::body Rappture::XyLegend::Check {} {
346	set nodes [$itk_component(legend) curselection]
347	foreach n { hide show toggle raise lower
348	rename average difference delete } {
349	$itk_component(controls).$n configure -state disabled
350	}
351	foreach node $nodes {
352	if { [$tree_ get $node "delete" 0] } {
353	$itk_component(controls).delete configure -state normal
354	break
355	}
356	}
357	if { [$itk_component(legend) index focus] != -1 } {
358	$itk_component(controls).rename configure -state normal
359	}
360	if { [$tree_ degree 0] > 1 && [llength $nodes] > 0 } {
361	foreach n { raise lower } {
362	$itk_component(controls).$n configure -state normal
363	}
364	}
365	switch -- [llength $nodes] {
366	0 {
367	}
368	1 {
369	foreach n { hide show toggle } {
370	$itk_component(controls).$n configure -state normal
371	}
372	}
373	2 {
374	foreach n { hide show toggle difference average } {
375	$itk_component(controls).$n configure -state normal
376	}
377	}
378	default {
379	foreach n { hide show toggle average } {
380	$itk_component(controls).$n configure -state normal
381	}
382	}
383	}
384	}
385
386	itcl::body Rappture::XyLegend::GetData { elem what } {
387	set y [$graph_ element cget $elem $what]
388	if { [blt::vector names $y] == $y } {
389	set y [$y range 0 end]
390	}
391	return $y
392	}
393
394	itcl::body Rappture::XyLegend::Average {} {
395	set nodes [$itk_component(legend) curselection]
396	if { $nodes == "" } {
397	return
398	}
399	set elements {}
400	set sum [blt::vector create \#auto -command ""]
401
402	set xcoords [blt::vector create \#auto -command ""]
403	set ycoords [blt::vector create \#auto -command ""]
404
405	# Step 1. Get the x-values for each curve, then sort them to get the
406	# unique values.
407
408	foreach node $nodes {
409	set elem [$tree_ label $node]
410	$xcoords append [GetData $elem -x]
411	set elements [linsert $elements 0 $elem]
412	}
413	# Sort the abscissas keeping unique values.
414	$xcoords sort -uniq
415
416	# Step 2. Now for each curve, generate a cubic spline of that curve
417	# and interpolate to get the corresponding y-values for each
418	# abscissa. Normally the abscissa are the same, so we're
419	# interpolation the knots.
420
421	set x [blt::vector create \#auto -command ""]
422	set y [blt::vector create \#auto -command ""]
423	$sum length [$xcoords length]
424
425	foreach node $nodes {
426	set elem [$tree_ label $node]
427	$x set [GetData $elem -x]
428	$y set [GetData $elem -y]
429	blt::spline natural $x $y $xcoords $ycoords
430
431	# Sum the interpolated y-coordinate values.
432	$sum expr "$sum + $ycoords"
433	}
434	blt::vector destroy $x $y
435
436	# Get the average
437	$sum expr "$sum / [llength $elements]"
438
439	# Step 3. Create a new curve which is the average. Append it to the
440	# the end.
441
442	set count 0
443	while {[$graph_ element exists avg$count] } {
444	incr count
445	}
446	set elements [lsort -dictionary $elements]
447	set name "avg$count"
448	set label "Avg. [join $elements ,]"
449
450	# Don't use the vector because we don't know when it will be cleaned up.
451
452	$graph_ element create $name -label $label -x [$xcoords range 0 end]\
453	-y [$sum range 0 end] -symbol scross
454	blt::vector destroy $xcoords $ycoords $sum
455	set node [Add $name $label -delete]
456	Raise $node
457	}
458
459	itcl::body Rappture::XyLegend::Difference {} {
460
461	if { $diff_ != "" } {
462	$graph_ marker delete $diff_
463	set diff_ ""
464	}
465	set nodes [$itk_component(legend) curselection]
466	set elem1 [$tree_ label [lindex $nodes 0]]
467	set elem2 [$tree_ label [lindex $nodes 1]]
468	if { [info exists diffelements_($elem1)] &&
469	[info exists diffelements_($elem2)] } {
470	array unset diffelements_; # Toggle the difference.
471	return;
472	}
473	array unset diffelements_
474	set x [blt::vector create \#auto -command ""]
475	set y [blt::vector create \#auto -command ""]
476	set m [blt::vector create \#auto -command ""]
477
478	$x append [GetData $elem1 -x]
479	$y append [GetData $elem1 -y]
480	$x sort -reverse $y
481	$x append [GetData $elem2 -x]
482	$y append [GetData $elem2 -y]
483	$m merge $x $y
484	set diff_ [$graph_ marker create polygon \
485	-coords [$m range 0 end] \
486	-elem $elem1 \
487	-stipple dot1 \
488	-outline "" -fill blue4 ]
489	blt::vector destroy $m $x $y
490	set diffelements_($elem1) 1
491	set diffelements_($elem2) 1
492	}
493
494
495	itcl::body Rappture::XyLegend::SelectAll { } {
496	foreach node [$tree_ children 0] {
497	$itk_component(legend) selection set $node
498	}
499	}
500
501	itcl::body Rappture::XyLegend::Rename {} {
502	Editor popup
503	}
504
505	# ----------------------------------------------------------------------
506	# USAGE: Editor popup
507	# USAGE: Editor activate
508	# USAGE: Editor validate <value>
509	# USAGE: Editor apply <value>
510	# USAGE: Editor menu <rootx> <rooty>
511	#
512	# Used internally to handle the various functions of the pop-up
513	# editor for the value of this gauge.
514	# ----------------------------------------------------------------------
515	itcl::body Rappture::XyLegend::Editor {option args} {
516	switch -- $option {
517	popup {
518	$itk_component(editor) activate
519	}
520	activate {
521	set focus_ [$itk_component(legend) index focus]
522	if { $focus_ == "" } {
523	return;
524	}
525	set label [$itk_component(legend) entry cget $focus_ -label]
526	foreach { l r w h } [$itk_component(legend) bbox $focus_] break
527	set info(text) $label
528	set info(x) [expr $l + [winfo rootx $itk_component(legend)]]
529	set info(y) [expr $r + [winfo rooty $itk_component(legend)]]
530	set info(w) $w
531	set info(h) $h
532	return [array get info]
533	}
534	validate {
535	if {[llength $args] != 1} {
536	error "wrong # args: should be \"editor validate value\""
537	}
538	}
539	apply {
540	if {[llength $args] != 1} {
541	error "wrong # args: should be \"editor apply value\""
542	}
543	set label [lindex $args 0]
544	$itk_component(legend) entry configure $focus_ -label $label
545	set elem [$tree_ label $focus_]
546	$graph_ element configure $elem -label $label
547	}
548	menu {
549	eval tk_popup $itk_component(emenu) $args
550	}
551	default {
552	error "bad option \"$option\": should be popup, activate, validate, apply, and menu"
553	}
554	}
555	}

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

Download in other formats: