Context Navigation

source: branches/blt4/gui/scripts/drawingentry.tcl @ 2988

Last change on this file since 2988 was 2988, checked in by gah, 12 years ago
additions for drawing entry
File size: 24.2 KB

Line
1
2	# ----------------------------------------------------------------------
3	# COMPONENT: DrawingEntry - widget for entering numeric values
4	#
5	# This widget represents a <number> entry on a control panel.
6	# It is used to enter numeric values.
7	# ======================================================================
8	# AUTHOR: Michael McLennan, Purdue University
9	# Copyright (c) 2004-2005 Purdue Research Foundation
10	#
11	# See the file "license.terms" for information on usage and
12	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13	# ======================================================================
14	package require Itk
15
16	itcl::class Rappture::DrawingEntry {
17	inherit itk::Widget
18	itk_option define -state state State "normal"
19
20	private variable _canvasHeight 0
21	private variable _canvasWidth 0
22	private variable _cname2controls
23	private variable _cname2id
24	private variable _cname2image
25	private variable _drawingHeight 0
26	private variable _drawingWidth 0
27	private variable _owner
28	private variable _path
29	private variable _showing ""
30	private variable _xAspect 0
31	private variable _xMin 0
32	private variable _xOffset 0
33	private variable _xScale 1.0
34	private variable _yAspect 0
35	private variable _yMin 0
36	private variable _yOffset 0
37	private variable _yScale 1.0
38
39	constructor {owner path args} { # defined below }
40
41	public method value { args }
42	public method label {}
43	public method tooltip {}
44
45	private method AdjustDrawingArea { xAspect yAspect }
46	private method Highlight { tag }
47	private method ParseDescription {}
48	private method ParseGrid { cpath cname }
49	private method ParseHotspot { cpath cname }
50	private method ParseLine { cpath cname }
51	private method ParseOval { cpath cname }
52	private method ParsePicture { cpath cname }
53	private method ParsePolygon { cpath cname }
54	private method ParseRectangle { cpath cname }
55	private method ParseScreenCoordinates { values }
56	private method ParseBackground {}
57	private method ParseSubstitutions {}
58	private method ParseText { cpath cname }
59	private method Redraw {}
60	private method ScreenCoords { coords }
61	private method ScreenX { x }
62	private method ScreenY { y }
63	private method Activate { tag }
64	private method Deactivate { tag }
65	private method Invoke { name x y }
66	}
67
68	itk::usual DrawingEntry {
69	keep -cursor -font
70	keep -foreground -background
71	keep -textbackground
72	keep -selectbackground -selectforeground -selectborderwidth
73	}
74
75	# ----------------------------------------------------------------------
76	# CONSTRUCTOR
77	# ----------------------------------------------------------------------
78	itcl::body Rappture::DrawingEntry::constructor {owner path args} {
79	if {[catch {$owner isa Rappture::ControlOwner} valid] != 0 \|\| !$valid} {
80	error "bad object \"$owner\": should be Rappture::ControlOwner"
81	}
82	set _path $path
83	set _owner $owner
84	#
85	# Display the current drawing.
86	#
87	itk_component add drawing {
88	canvas $itk_interior.canvas -background white -relief sunken -bd 1
89	} {
90	ignore -background
91	}
92	pack $itk_component(drawing) -expand yes -fill both
93	bind $itk_component(drawing) <Configure> [itcl::code $this Redraw]
94	Redraw
95	eval itk_initialize $args
96	}
97
98	# ----------------------------------------------------------------------
99	# USAGE: label
100	#
101	# Clients use this to query the label associated with this widget.
102	# Reaches into the XML and pulls out the appropriate label string.
103	# ----------------------------------------------------------------------
104	itcl::body Rappture::DrawingEntry::label {} {
105	return ""
106	set label [$_owner xml get $_path.about.label]
107	if {"" == $label} {
108	set label "Drawing"
109	}
110	return $label
111	}
112
113	# ----------------------------------------------------------------------
114	# USAGE: tooltip
115	#
116	# Clients use this to query the tooltip associated with this widget.
117	# Reaches into the XML and pulls out the appropriate description
118	# string. Returns the string that should be used with the
119	# Rappture::Tooltip facility.
120	# ----------------------------------------------------------------------
121	itcl::body Rappture::DrawingEntry::tooltip {} {
122	return ""
123	set str [$_owner xml get $_path.about.description]
124	return [string trim $str]
125	}
126
127	# ----------------------------------------------------------------------
128	# CONFIGURATION OPTION: -state
129	# ----------------------------------------------------------------------
130	itcl::configbody Rappture::DrawingEntry::state {
131	set valid {normal disabled}
132	if {[lsearch -exact $valid $itk_option(-state)] < 0} {
133	error "bad value \"$itk_option(-state)\": should be [join $valid {, }]"
134	}
135	}
136
137	itcl::body Rappture::DrawingEntry::Redraw {} {
138	# Remove exists canvas items and hints
139	$itk_component(drawing) delete all
140	# Delete any images that we created.
141	foreach name [array names _cname2image] {
142	image delete $_cname2image($name)
143	}
144	# Recompute the size of the canvas/drawing area
145	set _canvasWidth [winfo width $itk_component(drawing)]
146	if { $_canvasWidth < 2 } {
147	set _canvasWidth [winfo reqwidth $itk_component(drawing)]
148	}
149	set _canvasHeight [winfo height $itk_component(drawing)]
150	if { $_canvasHeight < 2 } {
151	set _canvasHeight [winfo reqheight $itk_component(drawing)]
152	}
153	set _drawingWidth $_canvasWidth
154	set _drawingHeight $_canvasHeight
155	set _xOffset 0
156	set _yOffset 0
157	ParseDescription
158	}
159
160	#
161	# ParseDescription --
162	#
163	itcl::body Rappture::DrawingEntry::ParseDescription {} {
164	#puts stderr "ParseDescription owner=$_owner path=$_path"
165	ParseBackground
166	ParseSubstitutions
167	foreach cname [$_owner xml children $_path.components] {
168	switch -glob -- $cname {
169	"line*" {
170	ParseLine $_path.components.$cname $cname
171	}
172	"grid*" {
173	ParseGrid $_path.components.$cname $cname
174	}
175	"text*" {
176	ParseText $_path.components.$cname $cname
177	}
178	"picture*" {
179	ParsePicture $_path.components.$cname $cname
180	}
181	"rectangle*" {
182	ParseRectangle $_path.components.$cname $cname
183	}
184	"oval*" {
185	ParseOval $_path.components.$cname $cname
186	}
187	"polygon*" {
188	ParsePolygon $_path.components.$cname $cname
189	}
190	"hotspot*" {
191	ParseHotspot $_path.components.$cname $cname
192	}
193	}
194	}
195	}
196
197	#
198	# ParseGrid --
199	#
200	itcl::body Rappture::DrawingEntry::ParseGrid { cpath cname } {
201	#puts stderr "ParseGrid owner=$_owner cpath=$cpath"
202	array set attr2option {
203	"linewidth" "-width"
204	"arrow" "-arrow"
205	"dash" "-dash"
206	"color" "-fill"
207	}
208	# Set default options first and then let tool.xml override them.
209	array set options {
210	-arrow none
211	-width 0
212	-fill black
213	-dash ""
214	}
215	# Coords
216	set xcoords [$_owner xml get $cpath.xcoords]
217	set xcoords [string trim $xcoords]
218	set ycoords [$_owner xml get $cpath.ycoords]
219	set ycoords [string trim $ycoords]
220	if { $ycoords == "" } {
221	set ycoords "0 1"
222	set ymax 1
223	set ymin 0
224	} else {
225	set list {}
226	set ymax -10000
227	set ymin 10000
228	foreach c $ycoords {
229	set y [ScreenY $c]
230	if { $y > $ymax } {
231	set ymax $y
232	}
233	if { $y < $ymin } {
234	set ymin $y
235	}
236	lappend list $y
237	}
238	set ycoords $list
239	}
240	if { $xcoords == "" } {
241	set xcoords "0 1"
242	set xmax 1
243	set xmin 0
244	} else {
245	set list {}
246	set xmax -10000
247	set xmin 10000
248	foreach c $xcoords {
249	set x [ScreenX $c]
250	if { $x > $xmax } {
251	set xmax $x
252	}
253	if { $x < $xmin } {
254	set xmin $x
255	}
256	lappend list $x
257	}
258	set xcoords $list
259	}
260	#puts stderr "ParseGrid owner=$_owner cpath=$cpath xcoords=$xcoords ycoords=$ycoords"
261	set list {}
262	foreach attr [$_owner xml children $cpath] {
263	if { [info exists attr2option($attr)] } {
264	set option $attr2option($attr)
265	set value [$_owner xml get $cpath.$attr]
266	set options($option) $value
267	}
268	}
269	set options(-tags) $cname
270	foreach y $ycoords {
271	lappend ids \
272	[eval $itk_component(drawing) create line $xmin $y $xmax $y \
273	[array get options]]
274	}
275	foreach x $xcoords {
276	lappend ids \
277	[eval $itk_component(drawing) create line $x $ymin $x $ymax \
278	[array get options]]
279	}
280	set _cname2id($cname) $ids
281	}
282
283	#
284	# ParseHotspot --
285	#
286	itcl::body Rappture::DrawingEntry::ParseHotspot { cpath cname } {
287	array set attr2option {
288	"color" "-fill"
289	"anchor" "-anchor"
290	}
291	#puts stderr "ParseHotspot owner=$_owner cpath=$cpath"
292	# Set default options first and then let tool.xml override them.
293	array set options {
294	-fill red
295	-anchor c
296	}
297	array unset _cname2controls $cname
298	foreach attr [$_owner xml children $cpath] {
299	if { [info exists attr2option($attr)] } {
300	set option $attr2option($attr)
301	set value [$_owner xml get $cpath.$attr]
302	set options($option) $value
303	} elseif { [string match "controls*" $attr] } {
304	set value [$_owner xml get $cpath.$attr]
305	lappend _cname2controls($cname) $value
306	}
307	}
308	# Coordinates
309	set coords [$_owner xml get $cpath.coords]
310	set coords [ScreenCoords $coords]
311	if { $coords == "" } {
312	set coords "0 0 1 1"
313	}
314	set c $itk_component(drawing)
315	set img [image create picture -file ~/Resize-Handle.png]
316	foreach { x1 y1 } $coords break
317	set id [$itk_component(drawing) create image $x1 $y1]
318	array unset options -fill
319	set options(-tags) $cname
320	set options(-image) $img
321	eval $c itemconfigure $id [array get options]
322	set _cname2id($cname) $id
323	set _cname2image($cname) $img
324	#$c bind $id <Enter> [itcl::code $this Activate $cname]
325	#$c bind $id <Leave> [itcl::code $this Deactivate $cname]
326	#$c bind $id <ButtonPress-1> [itcl::code $this Depress $cname]
327	$c bind $id <ButtonRelease-1> [itcl::code $this Invoke $cname $x1 $y1]
328	}
329
330	#
331	# ParseLine --
332	#
333	itcl::body Rappture::DrawingEntry::ParseLine { cpath cname } {
334	array set attr2option {
335	"linewidth" "-width"
336	"arrow" "-arrow"
337	"dash" "-dash"
338	"color" "-fill"
339	}
340	# Set default options first and then let tool.xml override them.
341	array set options {
342	-arrow none
343	-width 0
344	-fill black
345	-dash ""
346	}
347	# Coords
348	set coords {}
349	set coords [$_owner xml get $cpath.coords]
350	set coords [string trim $coords]
351	if { $coords == "" } {
352	set coords "0 0"
353	} else {
354	set coords [ScreenCoords $coords]
355	}
356	#puts stderr "ParseLine owner=$_owner cpath=$cpath coords=$coords"
357	set list {}
358	foreach attr [$_owner xml children $cpath] {
359	if { [info exists attr2option($attr)] } {
360	set option $attr2option($attr)
361	set value [$_owner xml get $cpath.$attr]
362	set options($option) $value
363	}
364	}
365	set options(-tags) $cname
366	set id [eval $itk_component(drawing) create line $coords]
367	set _cname2id($cname) $id
368	eval $itk_component(drawing) itemconfigure $id [array get options]
369	}
370
371	#
372	# ParseOval --
373	#
374	itcl::body Rappture::DrawingEntry::ParseOval { cpath cname } {
375	array set attr2option {
376	"outline" "-outline"
377	"fill" "-fill"
378	"linewidth" "-linewidth"
379	}
380	#puts stderr "ParseOval owner=$_owner cpath=$cpath"
381
382	# Set default options first and then let tool.xml override them.
383	array set options {
384	-fill blue
385	-linewidth 1
386	-outline black
387	}
388	foreach attr [$_owner xml children $cpath] {
389	if { [info exists attr2option($attr)] } {
390	set option $attr2option($attr)
391	set value [$_owner xml get $cpath.$attr]
392	set options($option) $value
393	}
394	}
395	# Coordinates
396	set coords {}
397	set coords [$_owner xml get $cpath.coords]
398	set coords [string trim $coords]
399	if { $coords == "" } {
400	set coords "0 0 1 1"
401	}
402	foreach { x1 y1 x2 y2 } [ScreenCoords $coords] break
403	set id [eval $itk_component(drawing) create oval $coords]
404	set _cname2id($cname) $id
405	}
406
407	#
408	# ParsePicture --
409	#
410	itcl::body Rappture::DrawingEntry::ParsePicture { cpath cname } {
411	array set attr2option {
412	"anchor" "-anchor"
413	}
414	#puts stderr "ParsePicture owner=$_owner cpath=$cpath"
415	# Set default options first and then let tool.xml override them.
416	array set options {
417	-anchor nw
418	}
419	foreach attr [$_owner xml children $cpath] {
420	if { [info exists attr2option($attr)] } {
421	set option $attr2option($attr)
422	set value [$_owner xml get $cpath.$attr]
423	set options($option) $value
424	}
425	}
426	# Coordinates
427	set coords {}
428	set coords [$_owner xml get $cpath.coords]
429	set coords [ScreenCoords $coords]
430	if { [llength $coords] == 2 } {
431	foreach { x1 y1 } $coords break
432	set w [$_owner xml get $cpath.width]
433	if { $w == "" \|\| ![string is number $w] \|\| $w <= 0.0 } {
434	set width [expr [image width $img] / 4]
435	} else {
436	set width [expr [ScreenX $w] - [ScreenX 0]]
437	}
438	set h [$_owner xml get $cpath.height]
439	if { $h == "" \|\| ![string is number $h] \|\| $h <= 0.0 } {
440	set height [expr [image height $img] / 4]
441	} else {
442	set height [expr [ScreenY $h] - [ScreenY 0]]
443	}
444	if { $width != [image width $img] \|\| $height != [image height $img] } {
445	set dst [image create picture -width $width -height $height]
446	$dst resample $img -filter box
447	image delete $img
448	set img $dst
449	}
450	} elseif { [llength $coords] == 4 } {
451	foreach { x1 y1 x2 y2 } $coords break
452	if { $x1 > $x2 } {
453	set tmp $x1
454	set x1 $x2
455	set x2 $tmp
456	}
457	if { $y1 > $y2 } {
458	set tmp $x1
459	set x1 $x2
460	set x2 $tmp
461	}
462	set width [expr $x2 - $x1 + 1]
463	set height [expr $x2 - $x1 + 1]
464	if { $width != [image width $img] \|\| $height != [image height $img] } {
465	set dst [image create picture -width $width -height $height]
466	$dst resample $img -filter box
467	image delete $img
468	set img $dst
469	}
470	} else {
471	set width [expr [image width $img] / 4]
472	set height [expr [image height $img] / 4]
473	set dst [image create picture -width $width -height $height]
474	$dst resample $img -filter box
475	image delete $img
476	set img $dst
477	set x1 0
478	set y1 0
479	}
480	set contents [$_owner xml get $cpath.contents]
481	if { [string compare -length 5 $contents "file:"] } {
482	set fileName [string range $contents 5 end]
483	set img [image create picture -file $fileName]
484	} elseif { [string compare -length 5 $contents "http:"] } {
485	puts stderr "don't know how to handle http"
486	} else {
487	set img [image create picture -data $contents]
488	}
489	set options(-tags) $cname
490	set options(-image) $img
491	set id [eval $itk_component(drawing) create oval $coords]
492	set _cname2image($cname) $img
493	set _cname2id($cname) $id
494	eval $itk_component(drawing) itemconfigure $id [array get options]
495	}
496
497
498	itcl::body Rappture::DrawingEntry::ParsePolygon { cpath cname } {
499	array set attr2option {
500	"linewidth" "-width"
501	"arrow" "-arrow"
502	"color" "-fill"
503	}
504	# Set default options first and then let tool.xml override them.
505	array set options {
506	-arrow none
507	-width 0
508	-fill black
509	}
510	# Coords
511	set coords {}
512	set coords [$_owner xml get $cpath.coords]
513	set coords [string trim $coords]
514	if { $coords == "" } {
515	set coords "0 0"
516	} else {
517	set coords [ScreenCoords $coords]
518	}
519	set x1 [lindex $coords 0]
520	set y1 [lindex $coords 1]
521	lappend coords $x1 $y1
522	#puts stderr "ParsePolygon owner=$_owner cpath=$cpath coords=$coords"
523	set list {}
524	foreach attr [$_owner xml children $cpath] {
525	if { [info exists attr2option($attr)] } {
526	set option $attr2option($attr)
527	set value [$_owner xml get $cpath.$attr]
528	set options($option) $value
529	}
530	}
531	set options(-tags) $cname
532	set id [eval $itk_component(drawing) create polygon $coords]
533	set _cname2id($cname) $id
534	eval $itk_component(drawing) itemconfigure $id [array get options]
535	}
536
537	#
538	# ParseRectangle --
539	#
540	itcl::body Rappture::DrawingEntry::ParseRectangle { cpath cname } {
541	array set attr2option {
542	"outline" "-outline"
543	"fill" "-fill"
544	"linewidth" "-linewidth"
545	}
546	#puts stderr "ParseRectangle owner=$_owner cpath=$cpath"
547
548	# Set default options first and then let tool.xml override them.
549	array set options {
550	-fill blue
551	-linewidth 1
552	-outline black
553	}
554	foreach attr [$_owner xml children $cpath] {
555	if { [info exists attr2option($attr)] } {
556	set option $attr2option($attr)
557	set value [$_owner xml get $cpath.$attr]
558	set options($option) $value
559	}
560	}
561	# Coordinates
562	set coords {}
563	set coords [$_owner xml get $cpath.coords]
564	set coords [string trim $coords]
565	if { $coords == "" } {
566	set coords "0 0 1 1"
567	}
568	foreach { x1 y1 x2 y2 } [ScreenCoords $coords] break
569	set id [eval $itk_component(drawing) create rectangle $coords]
570	set _cname2id($cname) $id
571	}
572
573	#
574	# ParseText --
575	#
576	itcl::body Rappture::DrawingEntry::ParseText { cpath cname } {
577	array set attr2option {
578	"font" "-font"
579	"color" "-fill"
580	"text" "-text"
581	"anchor" "-anchor"
582	}
583	#puts stderr "ParseText owner=$_owner cpath=$cpath"
584
585	# Set default options first and then let tool.xml override them.
586	array set options {
587	-font {Arial 8}
588	-text {}
589	-fill black
590	-anchor c
591	}
592	foreach attr [$_owner xml children $cpath] {
593	if { [info exists attr2option($attr)] } {
594	set option $attr2option($attr)
595	set value [$_owner xml get $cpath.$attr]
596	set options($option) $value
597	}
598	}
599	# Coords
600	set coords {}
601	set coords [$_owner xml get $cpath.coords]
602	set coords [string trim $coords]
603	if { $coords == "" } {
604	set coords "0 0"
605	} else {
606	set coords [ScreenCoords $coords]
607	}
608	set options(-tags) $cname
609	set id [eval $itk_component(drawing) create text $coords]
610	set _cname2id($cname) $id
611	eval $itk_component(drawing) itemconfigure $id [array get options]
612	}
613
614
615	itcl::body Rappture::DrawingEntry::ScreenX { x } {
616	set norm [expr ($x - $_xMin) * $_xScale]
617	set x [expr int($norm * $_drawingWidth) + $_xOffset]
618	return $x
619	}
620
621	itcl::body Rappture::DrawingEntry::ScreenY { y } {
622	set norm [expr ($y - $_yMin) * $_yScale]
623	set y [expr int($norm * $_drawingHeight) + $_yOffset]
624	return $y
625	}
626
627	itcl::body Rappture::DrawingEntry::ScreenCoords { coords } {
628	set list {}
629	foreach {x y} $coords {
630	lappend list [ScreenX $x] [ScreenY $y]
631	}
632	return $list
633	}
634
635	itcl::body Rappture::DrawingEntry::AdjustDrawingArea { xAspect yAspect } {
636	set _drawingWidth $_canvasWidth
637	set _drawingHeight $_canvasHeight
638	if { $xAspect <= 0 \|\| $yAspect <= 0 } {
639	return
640	}
641	set current [expr double($_canvasWidth) / double($_canvasHeight)]
642	set wanted [expr double($xAspect) / double($yAspect)]
643	if { $current > $wanted } {
644	set sw [ expr int($_canvasWidth * $wanted)]
645	if { $sw < 1 } {
646	set sw 1
647	}
648	set _xOffset [expr $_canvasWidth - $sw]
649	set _drawingWidth $sw
650	} else {
651	set sh [expr int($_canvaseHeight / $wanted)]
652	if { $sh < 1 } {
653	set sh 1
654	}
655	set _xOffset [expr $_canvasHeight - $sh]
656	set _drawingHeight $sh
657	}
658	}
659
660	#
661	# <background>
662	# <!-- background color of the drawing canvas (default white) -->
663	# <color>black</color>
664	# <!-- coordinate system: x0 y0 ?at screenx screeny? x1 y1
665	# ?at screenx screeny?
666	# The screenx/screeny values are optional, so you can also say
667	# something like "-.1 0 1.1 1" as you had in your example.
668	# This lets you put the origin at a specific point on screen,
669	# and also define the directions of the axes. We still compute
670	# the overall bounding box. In the example below, the bounding
671	# box goes from -1,1 in the upper-left corner to 1,-1 in the
672	# lower right.
673	# -->
674	# <coordinates>0 0 at 50% 50% 1 1 at 100% 100%</coordinates>
675
676	# <!-- aspect ratio: scales coordinate system so that pixels may not
677	# be square. A coordinate system like the one above implies a
678	# square drawing area, since x and y both go from -1 to 1. But
679	# if you set the aspect to 2:1, you'll get something twice as
680	# wide as it is tall. This effectively says that x goes from
681	# -1 to 1 in a certain distance, but y goes from -1 to 1 in half
682	# that screen distance. Default is whatever aspect is defined
683	# by the coordinates. If x goes 0-3 and y goes 0-1, then the
684	# drawing (without any other aspect ratio) would be 3x wide and
685	# 1x tall. The aspect ratio could be used to force it to be
686	# square instead by setting "1 1" instead. In that case, x goes
687	# 0-3 over the width, and y goes 0-1 over the same screen distance
688	# along the height.
689	# -->
690	# <aspect>2 1</aspect>
691	# </background>
692	#
693
694	itcl::body Rappture::DrawingEntry::ParseScreenCoordinates { values } {
695	set len [llength $values]
696	if { $len == 4 } {
697	if { [scan $values "%g %g %g %g" x1 y1 x2 y2] != 4 } {
698	error "bad coordinates specification \"$values\""
699	}
700	set _xScale [expr 1.0 / ($x2 - $x1)]
701	set _yScale [expr 1.0 / ($y2 - $y1)]
702	set _xMin $x1
703	set _yMin $y1
704	} elseif { $len == 10 } {
705	if { [scan $values "%g %g %s %d%% %d%% %g %g %s %d%% %d%%" \
706	sx1 sy1 at1 x1 y1 sx2 sy2 at2 x2 y2] != 10 } {
707	error "bad coordinates specification \"$values\""
708	}
709	if { $at1 != "at" \|\| $at2 != "at" } {
710	error "bad coordinates specification \"$values\""
711	}
712	set x1 [expr $x1 / 100.0]
713	set x2 [expr $x2 / 100.0]
714	set y1 [expr $y1 / 100.0]
715	set y2 [expr $y2 / 100.0]
716	set _xScale [expr ($sx2 - $sx1) / ($x2 - $x1)]
717	set _yScale [expr ($sy2 - $sy2) / ($y2 - $y2)]
718	set _xMin $x1
719	set _yMin $y1
720	}
721	}
722
723	itcl::body Rappture::DrawingEntry::ParseBackground {} {
724	foreach elem [$_owner xml children $_path.background] {
725	switch -glob -- $elem {
726	"color*" {
727	# Background color of the drawing canvas (default white)
728	set value [$_owner xml get $_path.background.$elem]
729	$itk_component(drawing) configure -background $value
730	}
731	"aspect*" {
732	set value [$_owner xml get $_path.background.$elem]
733	foreach { xAspect yAspect } $value break
734	AdjustDrawingArea $xAspect $yAspect
735	}
736	"coordinates*" {
737	set value [$_owner xml get $_path.background.$elem]
738	ParseScreenCoordinates $value
739	}
740	}
741	}
742	}
743
744	itcl::body Rappture::DrawingEntry::ParseSubstitutions {} {
745	foreach var [$_owner xml children $_path.substitutions] {
746	if { ![string match "variable*" $var] } {
747	continue
748	}
749	set varPath $_path.substitutions.$var
750	foreach elem [$_owner xml children $varPath] {
751	set map ""
752	set name ""
753	set path ""
754	switch -glob -- $elem {
755	# Background color of the drawing canvas (default white)
756	"name*" {
757	set name [$_owner xml get $varPath.$elem]
758	}
759	"path*" {
760	set path [$_owner xml get $varPath.$elem]
761	}
762	"map*" {
763	set from [$_owner xml get $varPath.$elem.from]
764	set to [$_owner xml get $varPath.$elem.to]
765	if { $from == "" \|\| $to == "" } {
766	puts stderr "empty translation in map table \"$varPath\""
767	}
768	lappend map $from $to
769	}
770	}
771	if { $name == "" } {
772	puts stderr \
773	"no name defined for substituion variable \"$varPath\""
774	continue
775	}
776	if { [info exists _name2path($name)] } {
777	puts stderr \
778	"substitution variable \"$name\" already defined"
779	continue
780	}
781	set _name2path($name) $path
782	if { $path == "" } {
783	puts stderr \
784	"no path defined for substituion variable \"$varPath\""
785	continue
786	}
787	set _name2map($name) $map
788	}
789	}
790	}
791
792	#
793	# Invoke --
794	#
795	itcl::body Rappture::DrawingEntry::Invoke { cname x y } {
796	set controls $_cname2controls($cname)
797	if { [llength $controls] == 0 } {
798	puts stderr "no controls defined for $cname"
799	return
800	}
801	# Build a popup with the designated controls
802	set popup .drawingentrypopup
803	if { ![winfo exists $popup] } {
804	# Create a popup for the print dialog
805	Rappture::Balloon $popup -title "Change values..."
806	set inner [$popup component inner]
807	Rappture::DrawingControls $inner.controls $_owner \
808	-deactivatecommand [list $popup deactivate]
809	pack $inner.controls -fill both -expand yes
810	} else {
811	set inner [$popup component inner]
812	$inner.controls delete all
813	}
814	foreach path $controls {
815	$inner.controls add $path
816	}
817	update
818	# Activate the popup and call for the output.
819	incr x [winfo rootx $itk_component(drawing)]
820	incr y [winfo rooty $itk_component(drawing)]
821
822	$popup activate @$x,$y above
823	}
824
825
826	# ----------------------------------------------------------------------
827	# USAGE: value ?-check? ?<newval>?
828	#
829	# Clients use this to query/set the value for this widget. With
830	# no args, it returns the current value for the widget. If the
831	# <newval> is specified, it sets the value of the widget and
832	# sends a <<Value>> event. If the -check flag is included, the
833	# new value is not actually applied, but just checked for correctness.
834	# ----------------------------------------------------------------------
835	itcl::body Rappture::DrawingEntry::value {args} {
836	# drawing entries have no value
837	return ""
838	}

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

Download in other formats: