Context Navigation

source: trunk/gui/scripts/deviceViewer1D.tcl @ 924

Last change on this file since 924 was 782, checked in by mmc, 17 years ago

Fixed the layout of controls so that large items like <note> and
<structure> will take up as much space as possible.

Added "package require Img" to device viewer, so it can recognize
embedded images in formats like png that are not usually supported
in Tcl/Tk?.

File size: 29.7 KB

Line
1	# ----------------------------------------------------------------------
2	# COMPONENT: deviceViewer1D - visualizer for 1D device geometries
3	#
4	# This widget is a simple visualizer for 1D devices. It takes the
5	# Rappture XML representation for a 1D device and draws various
6	# facets of the data. Each facet shows the physical layout along
7	# with some other quantity. The "Electrical" facet shows electrical
8	# contacts. The "Doping" facet shows the doping profile, and so
9	# forth.
10	# ======================================================================
11	# AUTHOR: Michael McLennan, Purdue University
12	# Copyright (c) 2004-2005 Purdue Research Foundation
13	#
14	# See the file "license.terms" for information on usage and
15	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
16	# ======================================================================
17	package require Itk
18	package require Img
19	package require BLT
20
21	option add *DeviceViewer1D.padding 4 widgetDefault
22	option add *DeviceViewer1D.deviceSize 0.25i widgetDefault
23	option add *DeviceViewer1D.deviceOutline black widgetDefault
24	option add DeviceViewer1Dgraph.width 3i widgetDefault
25	option add DeviceViewer1Dgraph.height 2i widgetDefault
26
27	itcl::class Rappture::DeviceViewer1D {
28	inherit itk::Widget
29
30	itk_option define -device device Device ""
31
32	constructor {owner args} { # defined below }
33	destructor { # defined below }
34
35	public method add {dataobj {settings ""}}
36	public method get {}
37	public method delete {args}
38	public method parameters {title args} { # do nothing }
39
40	public method controls {option args}
41	public method download {option args}
42
43	protected method _loadDevice {}
44	protected method _loadParameters {frame path}
45	protected method _changeTabs {}
46	protected method _fixSize {}
47	protected method _fixAxes {}
48	protected method _align {}
49
50	protected method _marker {option {name ""} {path ""}}
51
52	protected method _controlCreate {container libObj path}
53	protected method _controlSet {widget libObj path}
54
55	private variable _owner "" ;# thing managing this control
56	private variable _dlist "" ;# list of dataobj objects
57	private variable _dobj2raise ;# maps dataobj => raise flag
58	private variable _device "" ;# XML library with <structure>
59	private variable _tab2fields ;# maps tab name => list of fields
60	private variable _field2parm ;# maps field path => parameter name
61	private variable _units "" ;# units for field being edited
62	private variable _marker ;# marker currently being edited
63	}
64
65	itk::usual DeviceViewer1D {
66	}
67
68	# ----------------------------------------------------------------------
69	# CONSTRUCTOR
70	# ----------------------------------------------------------------------
71	itcl::body Rappture::DeviceViewer1D::constructor {owner args} {
72	set _owner $owner
73
74	pack propagate $itk_component(hull) no
75
76	itk_component add tabs {
77	blt::tabset $itk_interior.tabs -borderwidth 0 -relief flat \
78	-side bottom -tearoff 0 \
79	-selectcommand [itcl::code $this _changeTabs]
80	} {
81	keep -activebackground -activeforeground
82	keep -background -cursor -font
83	rename -highlightbackground -background background Background
84	keep -highlightcolor -highlightthickness
85	keep -tabbackground -tabforeground
86	rename -selectbackground -background background Background
87	rename -selectforeground -foreground foreground Foreground
88	}
89	pack $itk_component(tabs) -expand yes -fill both
90
91	itk_component add -protected inner {
92	frame $itk_component(tabs).inner
93	}
94
95	itk_component add top {
96	frame $itk_component(inner).top
97	}
98	pack $itk_component(top) -fill x
99
100	itk_component add layout {
101	Rappture::DeviceLayout1D $itk_component(inner).layout
102	}
103	pack $itk_component(layout) -side top -fill x -pady 4
104
105	itk_component add graph {
106	blt::graph $itk_component(inner).graph \
107	-highlightthickness 0 -plotpadx 0 -plotpady 0
108	} {
109	keep -background -foreground -cursor -font
110	}
111	pack $itk_component(graph) -expand yes -fill both
112	$itk_component(graph) legend configure -hide yes
113
114	bind $itk_component(graph) <Configure> "
115	[list after cancel [list catch [itcl::code $this _align]]]
116	[list after 100 [list catch [itcl::code $this _align]]]
117	"
118
119	itk_component add geditor {
120	Rappture::Editor $itk_component(graph).editor \
121	-activatecommand [itcl::code $this _marker activate] \
122	-validatecommand [itcl::code $this _marker validate] \
123	-applycommand [itcl::code $this _marker apply]
124	}
125
126	itk_component add devcntls {
127	Rappture::Notebook $itk_component(inner).devcntls
128	}
129	pack $itk_component(devcntls) -side bottom -fill x
130
131	eval itk_initialize $args
132
133	after cancel [list catch [itcl::code $this _fixSize]]
134	after idle [list catch [itcl::code $this _fixSize]]
135	}
136
137	# ----------------------------------------------------------------------
138	# DESTRUCTOR
139	# ----------------------------------------------------------------------
140	itcl::body Rappture::DeviceViewer1D::destructor {} {
141	set _device ""
142	foreach name [array names _tab2fields] {
143	eval itcl::delete object $_tab2fields($name)
144	}
145	after cancel [list catch [itcl::code $this _fixAxes]]
146	after cancel [list catch [itcl::code $this _align]]
147	after cancel [list catch [itcl::code $this _loadDevice]]
148	}
149
150	# ----------------------------------------------------------------------
151	# USAGE: add <dataobj> ?<settings>?
152	#
153	# Clients use this to add a data object to the plot. The optional
154	# <settings> are used to configure the plot. Allowed settings are
155	# -color, -brightness, -width, -linestyle, and -raise. Only
156	# -brightness and -raise do anything.
157	# ----------------------------------------------------------------------
158	itcl::body Rappture::DeviceViewer1D::add {dataobj {settings ""}} {
159	array set params {
160	-color auto
161	-brightness 0
162	-width 1
163	-raise 0
164	-linestyle solid
165	-description ""
166	-param ""
167	}
168	foreach {opt val} $settings {
169	if {![info exists params($opt)]} {
170	error "bad settings \"$opt\": should be [join [lsort [array names params]] {, }]"
171	}
172	set params($opt) $val
173	}
174
175	set pos [lsearch -exact $dataobj $_dlist]
176
177	if {$pos < 0} {
178	if {![Rappture::library isvalid $dataobj]} {
179	error "bad value \"$dataobj\": should be Rappture::library object"
180	}
181
182	lappend _dlist $dataobj
183	set _dobj2raise($dataobj) $params(-raise)
184
185	after cancel [list catch [itcl::code $this _loadDevice]]
186	after idle [list catch [itcl::code $this _loadDevice]]
187	}
188	}
189
190	# ----------------------------------------------------------------------
191	# USAGE: get
192	#
193	# Clients use this to query the list of objects being plotted, in
194	# order from bottom to top of this result.
195	# ----------------------------------------------------------------------
196	itcl::body Rappture::DeviceViewer1D::get {} {
197	# put the dataobj list in order according to -raise options
198	set dlist $_dlist
199	foreach obj $dlist {
200	if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
201	set i [lsearch -exact $dlist $obj]
202	if {$i >= 0} {
203	set dlist [lreplace $dlist $i $i]
204	lappend dlist $obj
205	}
206	}
207	}
208	return $dlist
209	}
210
211	# ----------------------------------------------------------------------
212	# USAGE: delete ?<dataobj> <dataobj> ...?
213	#
214	# Clients use this to delete a dataobj from the plot. If no dataobjs
215	# are specified, then all dataobjs are deleted.
216	# ----------------------------------------------------------------------
217	itcl::body Rappture::DeviceViewer1D::delete {args} {
218	if {[llength $args] == 0} {
219	set args $_dlist
220	}
221
222	# delete all specified dataobjs
223	set changed 0
224	foreach dataobj $args {
225	set pos [lsearch -exact $_dlist $dataobj]
226	if {$pos >= 0} {
227	set _dlist [lreplace $_dlist $pos $pos]
228	catch {unset _dobj2raise($dataobj)}
229	set changed 1
230	}
231	}
232
233	# if anything changed, then rebuild the plot
234	if {$changed} {
235	after cancel [list catch [itcl::code $this _loadDevice]]
236	after idle [list catch [itcl::code $this _loadDevice]]
237	}
238	}
239
240	# ----------------------------------------------------------------------
241	# USAGE: controls insert <pos> <xmlobj> <path>
242	#
243	# Clients use this to add a control to the internal panels of this
244	# widget. Such controls are usually placed at the top of the widget,
245	# but if possible, they are integrated directly onto the device
246	# layout or the field area.
247	# ----------------------------------------------------------------------
248	itcl::body Rappture::DeviceViewer1D::controls {option args} {
249	switch -- $option {
250	insert {
251	if {[llength $args] != 3} {
252	error "wrong # args: should be \"controls insert pos xmlobj path\""
253	}
254	set pos [lindex $args 0]
255	set xmlobj [lindex $args 1]
256	set path [lindex $args 2]
257	if {[string match structure.parameters $path]} {
258	} elseif {[string match structure.components* $path]} {
259	$itk_component(layout) controls insert $pos $xmlobj $path
260	}
261	}
262	default {
263	error "bad option \"$option\": should be insert"
264	}
265	}
266	}
267
268
269	# ----------------------------------------------------------------------
270	# USAGE: download coming
271	# USAGE: download controls <downloadCommand>
272	# USAGE: download now
273	#
274	# Clients use this method to create a downloadable representation
275	# of the plot. Returns a list of the form {ext string}, where
276	# "ext" is the file extension (indicating the type of data) and
277	# "string" is the data itself.
278	# ----------------------------------------------------------------------
279	itcl::body Rappture::DeviceViewer1D::download {option args} {
280	switch $option {
281	coming {
282	# nothing to do
283	}
284	controls {
285	# no controls for this download yet
286	return ""
287	}
288	now {
289	return "" ;# not implemented yet!
290	}
291	default {
292	error "bad option \"$option\": should be coming, controls, now"
293	}
294	}
295	}
296
297	# ----------------------------------------------------------------------
298	# USAGE: _loadDevice
299	#
300	# Used internally to search for fields and create corresponding
301	# tabs whenever a device is installed into this viewer.
302	# ----------------------------------------------------------------------
303	itcl::body Rappture::DeviceViewer1D::_loadDevice {} {
304	set _device [lindex [get] end]
305
306	#
307	# Release any info left over from the last device.
308	#
309	foreach name [array names _tab2fields] {
310	eval itcl::delete object $_tab2fields($name)
311	}
312	catch {unset _tab2fields}
313	catch {unset _field2parm}
314
315	if {[winfo exists $itk_component(top).cntls]} {
316	$itk_component(top).cntls delete 0 end
317	}
318
319	#
320	# Scan through the current device and extract the list of
321	# fields. Create a tab for each field.
322	#
323	if {$_device != ""} {
324	foreach nn [$_device children fields] {
325	set name [$_device get fields.$nn.about.label]
326	if {$name == ""} {
327	set name $nn
328	}
329
330	set fobj [Rappture::Field ::#auto $_device fields.$nn]
331	lappend _tab2fields($name) $fobj
332	}
333	}
334	set tabs [lsort [array names _tab2fields]]
335
336	if {[$itk_component(tabs) size] > 0} {
337	$itk_component(tabs) delete 0 end
338	}
339
340	if {[llength $tabs] <= 0} {
341	#
342	# No fields? Then we don't need to bother with tabs.
343	# Just pack the inner frame directly. If there are no
344	# fields, get rid of the graph.
345	#
346	pack $itk_component(inner) -expand yes -fill both
347	if {[llength $tabs] > 0} {
348	pack $itk_component(graph) -expand yes -fill both
349	} else {
350	pack forget $itk_component(graph)
351	$itk_component(layout) configure -leftmargin 0 -rightmargin 0
352	}
353	} else {
354	#
355	# Two or more fields? Then create a tab for each field
356	# and select the first one by default. Make sure the
357	# graph is packed.
358	#
359	pack forget $itk_component(inner)
360	pack $itk_component(graph) -expand yes -fill both
361
362	foreach name $tabs {
363	$itk_component(tabs) insert end $name \
364	-activebackground $itk_option(-background)
365	}
366	$itk_component(tabs) select 0
367	}
368
369	#
370	# Scan through and look for any parameters in the <structure>.
371	# Register any parameters associated with fields, so we can
372	# add them as active controls whenever we install new fields.
373	# Create controls for any remaining parameters, so the user
374	# can see that there's something to adjust.
375	#
376	if {$_device != ""} {
377	_loadParameters $itk_component(top) parameters
378	}
379
380	#
381	# Install the first tab
382	#
383	_changeTabs
384
385	#
386	# Fix the right margin of the graph so that it has enough room
387	# to display the right-hand edge of the device.
388	#
389	$itk_component(graph) configure \
390	-rightmargin [$itk_component(layout) extents bar3D]
391
392	after cancel [list catch [itcl::code $this _fixSize]]
393	after idle [list catch [itcl::code $this _fixSize]]
394	}
395
396	# ----------------------------------------------------------------------
397	# USAGE: _loadParameters <frame> <path>
398	#
399	# Used internally in _loadDevice to load child parameters at the
400	# specified <path> into the <frame>. If any of the children are
401	# groups, then this is called recursively to fill in the group
402	# children.
403	# ----------------------------------------------------------------------
404	itcl::body Rappture::DeviceViewer1D::_loadParameters {frame path} {
405	foreach cname [$_device children $path] {
406	set handled 0
407	set type [$_device element -as type $path.$cname]
408	if {$type == "about"} {
409	continue
410	}
411	if {$type == "number"} {
412	set name [$_device element -as id $path.$cname]
413
414	# look for a field that uses this parameter
415	set found ""
416	foreach fname [$_device children fields] {
417	foreach comp [$_device children fields.$fname] {
418	set v [$_device get fields.$fname.$comp.constant]
419	if {[string equal $v $name]} {
420	set found "fields.$fname.$comp"
421	break
422	}
423	}
424	if {"" != $found} break
425	}
426
427	if {"" != $found} {
428	set _field2parm($found) $name
429	set handled 1
430	}
431	}
432
433	#
434	# Any parameter that was not handled above should be handled
435	# here, by adding it to a control panel above the device
436	# layout area.
437	#
438	if {!$handled} {
439	if {![winfo exists $frame.cntls]} {
440	Rappture::Controls $frame.cntls $_owner
441	pack $frame.cntls -expand yes -fill both
442	}
443	$frame.cntls insert end $path.$cname
444
445	#
446	# If this is a group, then we must add its children
447	# recursively.
448	#
449	if {$type == "group"} {
450	set gr [$frame.cntls control -value end]
451	_loadParameters [$gr component inner] $path.$cname
452	}
453	}
454	}
455	}
456
457	# ----------------------------------------------------------------------
458	# USAGE: _changeTabs
459	#
460	# Used internally to change the field being displayed whenever a new
461	# tab is selected.
462	# ----------------------------------------------------------------------
463	itcl::body Rappture::DeviceViewer1D::_changeTabs {} {
464	set graph $itk_component(graph)
465
466	#
467	# Figure out which tab is selected and make the inner frame
468	# visible in that tab.
469	#
470	set i [$itk_component(tabs) index select]
471	if {$i != ""} {
472	set name [$itk_component(tabs) get $i]
473	$itk_component(tabs) tab configure $name \
474	-window $itk_component(inner) -fill both
475	} else {
476	set name [lindex [array names _tab2fields] 0]
477	}
478
479	#
480	# Update the graph to show the current field.
481	#
482	eval $graph element delete [$graph element names]
483	eval $graph marker delete [$graph marker names]
484
485	foreach {zmin zmax} [$itk_component(layout) limits] { break }
486	if {$zmin != "" && $zmin < $zmax} {
487	$graph axis configure x -min $zmin -max $zmax
488	}
489
490	if {$_device != ""} {
491	set units [$_device get units]
492	if {$units != "arbitrary"} {
493	$graph axis configure x -hide no -title "Position ($units)"
494	} else {
495	$graph axis configure x -hide yes
496	}
497	} else {
498	$graph axis configure x -hide no -title "Position"
499	}
500
501	# turn on auto limits
502	$graph axis configure y -min "" -max ""
503
504	set flist ""
505	if {[info exists _tab2fields($name)]} {
506	set flist $_tab2fields($name)
507	}
508
509	set n 0
510	foreach fobj $flist {
511	catch {unset hints}
512	array set hints [$fobj hints]
513
514	if {[info exists hints(units)]} {
515	set _units $hints(units)
516	$graph axis configure y -title "$name ($hints(units))"
517	} else {
518	set _units ""
519	$graph axis configure y -title $name
520	}
521
522	if {[info exists hints(scale)]
523	&& [string match log* $hints(scale)]} {
524	$graph axis configure y -logscale yes
525	} else {
526	$graph axis configure y -logscale no
527	}
528
529	foreach comp [$fobj components] {
530	# can only handle 1D meshes here
531	if {[$fobj components -dimensions $comp] != "1D"} {
532	continue
533	}
534
535	set elem "elem[incr n]"
536	set xv [$fobj mesh $comp]
537	set yv [$fobj values $comp]
538
539	$graph element create $elem -x $xv -y $yv \
540	-color black -symbol "" -linewidth 2
541
542	if {[info exists hints(color)]} {
543	$graph element configure $elem -color $hints(color)
544	}
545
546	foreach {path x y val} [$fobj controls get $comp] {
547	if {$path != ""} {
548	set id "control[incr n]"
549	$graph marker create text -coords [list $x $y] \
550	-text $val -anchor s -name $id -background ""
551	$graph marker bind $id <Enter> \
552	[itcl::code $this _marker enter $id]
553	$graph marker bind $id <Leave> \
554	[itcl::code $this _marker leave $id]
555	$graph marker bind $id <ButtonPress> \
556	[itcl::code $this _marker edit $id $fobj/$path]
557	}
558	}
559	}
560	}
561
562	# let the widget settle, then fix the axes to "nice" values
563	after cancel [list catch [itcl::code $this _fixAxes]]
564	after 100 [list catch [itcl::code $this _fixAxes]]
565	}
566
567	# ----------------------------------------------------------------------
568	# USAGE: _fixSize
569	#
570	# Used internally to fix the overall size of this widget based on
571	# the various parts inside. Sets the requested width/height of the
572	# widget so that it is big enough to display the device and its
573	# fields.
574	# ----------------------------------------------------------------------
575	itcl::body Rappture::DeviceViewer1D::_fixSize {} {
576	update idletasks
577	set w [winfo reqwidth $itk_component(tabs)]
578	set h [winfo reqheight $itk_component(tabs)]
579	component hull configure -width $w -height $h
580	}
581
582	# ----------------------------------------------------------------------
583	# USAGE: _fixAxes
584	#
585	# Used internally to adjust the y-axis limits of the graph to "nice"
586	# values, so that any control marker associated with the value,
587	# for example, remains on screen.
588	# ----------------------------------------------------------------------
589	itcl::body Rappture::DeviceViewer1D::_fixAxes {} {
590	set graph $itk_component(graph)
591	if {![winfo ismapped $graph]} {
592	after cancel [list catch [itcl::code $this _fixAxes]]
593	after 100 [list catch [itcl::code $this _fixAxes]]
594	return
595	}
596
597	#
598	# HACK ALERT!
599	# Use this code to fix up the y-axis limits for the BLT graph.
600	# The auto-limits don't always work well. We want them to be
601	# set to a "nice" number slightly above or below the min/max
602	# limits.
603	#
604	set log [$graph axis cget y -logscale]
605	$graph axis configure y -min "" -max ""
606	foreach {min max} [$graph axis limits y] { break }
607
608	if {$log} {
609	set min [expr {0.9*$min}]
610	set max [expr {1.1*$max}]
611	} else {
612	if {$min > 0} {
613	set min [expr {0.95*$min}]
614	} else {
615	set min [expr {1.05*$min}]
616	}
617	if {$max > 0} {
618	set max [expr {1.05*$max}]
619	} else {
620	set max [expr {0.95*$max}]
621	}
622	}
623
624	# bump up the max so that it's big enough to show control markers
625	set fnt $itk_option(-font)
626	set h [expr {[font metrics $fnt -linespace] + 5}]
627	foreach mname [$graph marker names] {
628	set xy [$graph marker cget $mname -coord]
629	foreach {x y} [eval $graph transform $xy] { break }
630	set y [expr {$y-$h}] ;# find top of text in pixels
631	foreach {x y} [eval $graph invtransform [list 0 $y]] { break }
632	if {$y > $max} { set max $y }
633	}
634
635	if {$log} {
636	set min [expr {pow(10.0,floor(log10($min)))}]
637	set max [expr {pow(10.0,ceil(log10($max)))}]
638	} else {
639	set min [expr {0.1floor(10$min)}]
640	set max [expr {0.1ceil(10$max)}]
641	}
642
643	$graph axis configure y -min $min -max $max
644
645	after cancel [list catch [itcl::code $this _align]]
646	after 100 [list catch [itcl::code $this _align]]
647	}
648
649	# ----------------------------------------------------------------------
650	# USAGE: _align
651	#
652	# Used internally to align the margins of the device layout and the
653	# graph, so that two areas line up.
654	# ----------------------------------------------------------------------
655	itcl::body Rappture::DeviceViewer1D::_align {} {
656	set graph $itk_component(graph)
657
658	#
659	# Set the left/right margins of the layout so that it aligns
660	# with the graph. Set the right margin of the graph so it
661	# it is big enough to show the 3D edge of the device that
662	# hangs over on the right-hand side.
663	#
664	update
665	foreach {xmin xmax} [$graph axis limits x] { break }
666	set lm [$graph xaxis transform $xmin]
667	$itk_component(layout) configure -leftmargin $lm
668
669	set w [winfo width $graph]
670	set rm [expr {$w-[$graph xaxis transform $xmax]}]
671	$itk_component(layout) configure -rightmargin $rm
672	}
673
674	# ----------------------------------------------------------------------
675	# USAGE: _marker enter <name>
676	# USAGE: _marker leave <name>
677	# USAGE: _marker edit <name> <path>
678	# USAGE: _marker activate
679	# USAGE: _marker validate <value>
680	# USAGE: _marker apply <value>
681	#
682	# Used internally to manipulate the control markers draw on the
683	# graph for a field.
684	# ----------------------------------------------------------------------
685	itcl::body Rappture::DeviceViewer1D::_marker {option {name ""} {path ""}} {
686	switch -- $option {
687	enter {
688	$itk_component(graph) marker configure $name -background #e5e5e5
689	#
690	# BE CAREFUL: Need an update here to force the graph to
691	# refresh itself or else a subsequent click on the
692	# marker will ignore the text that was recently changed,
693	# and fail to generate a <ButtonPress> event!
694	#
695	update idletasks
696	}
697	leave {
698	$itk_component(graph) marker configure $name -background ""
699	#
700	# BE CAREFUL: Need an update here to force the graph to
701	# refresh itself or else a subsequent click on the
702	# marker will ignore the text that was recently changed,
703	# and fail to generate a <ButtonPress> event!
704	#
705	update idletasks
706	}
707	edit {
708	set _marker(name) $name
709	set _marker(fobj) [lindex [split $path /] 0]
710	set _marker(path) [lindex [split $path /] 1]
711	$itk_component(geditor) activate
712	}
713	activate {
714	set g $itk_component(graph)
715	set val [$g marker cget $_marker(name) -text]
716	foreach {x y} [$g marker cget $_marker(name) -coords] { break }
717	foreach {x y} [$g transform $x $y] { break }
718	set x [expr {$x + [winfo rootx $g] - 4}]
719	set y [expr {$y + [winfo rooty $g] - 5}]
720
721	set fnt $itk_option(-font)
722	set h [expr {[font metrics $fnt -linespace] + 2}]
723	set w [expr {[font measure $fnt $val] + 5}]
724
725	return [list text $val \
726	x [expr {$x-$w/2}] \
727	y [expr {$y-$h}] \
728	w $w \
729	h $h]
730	}
731	validate {
732	if {$_units != ""} {
733	if {[catch {Rappture::Units::convert $name \
734	-context $_units -to $_units} result] != 0} {
735	if {[regexp {^bad.*: +(.)(.+)} $result match first tail]
736	\|\| [regexp {(.)(.+)} $result match first tail]} {
737	set result "[string toupper $first]$tail"
738	}
739	bell
740	Rappture::Tooltip::cue $itk_component(geditor) $result
741	return 0
742	}
743	}
744	if {[catch {$_marker(fobj) controls validate $_marker(path) $name} result]} {
745	bell
746	Rappture::Tooltip::cue $itk_component(geditor) $result
747	return 0
748	}
749	return 1
750	}
751	apply {
752	if {$_units != ""} {
753	catch {Rappture::Units::convert $name \
754	-context $_units -to $_units} value
755	} else {
756	set value $name
757	}
758
759	$_marker(fobj) controls put $_marker(path) $value
760	$_owner changed $_marker(path)
761	event generate $itk_component(hull) <<Edit>>
762
763	_changeTabs
764	}
765	}
766	}
767
768	# ----------------------------------------------------------------------
769	# USAGE: _controlCreate <container> <libObj> <path>
770	#
771	# Used internally to create a gauge widget and pack it into the
772	# given <container>. When the gauge is set, it updates the value
773	# for the <path> in the <libObj>.
774	# ----------------------------------------------------------------------
775	itcl::body Rappture::DeviceViewer1D::_controlCreate {container libObj path} {
776	set presets ""
777	foreach pre [$libObj children -type preset $path] {
778	lappend presets \
779	[$libObj get $path.$pre.value] \
780	[$libObj get $path.$pre.label]
781	}
782
783	set type Rappture::Gauge
784	set units [$libObj get $path.units]
785	if {$units != ""} {
786	set desc [Rappture::Units::description $units]
787	if {[string match temperature* $desc]} {
788	set type Rappture::TemperatureGauge
789	}
790	}
791
792	set counter 0
793	set w "$container.gauge[incr counter]"
794	while {[winfo exists $w]} {
795	set w "$container.gauge[incr counter]"
796	}
797
798	# create the widget
799	$type $w -units $units -presets $presets
800	pack $w -side top -anchor w
801	bind $w <<Value>> [itcl::code $this _controlSet $w $libObj $path]
802
803	set min [$libObj get $path.min]
804	if {"" != $min} { $w configure -minvalue $min }
805
806	set max [$libObj get $path.max]
807	if {"" != $max} { $w configure -maxvalue $max }
808
809	set str [$libObj get $path.default]
810	if {$str != ""} { $w value $str }
811
812	if {$type == "Rappture::Gauge" && "" != $min && "" != $max} {
813	set color [$libObj get $path.color]
814	if {$color == ""} {
815	set color blue
816	}
817	if {$units != ""} {
818	set min [Rappture::Units::convert $min -to $units -units off]
819	set max [Rappture::Units::convert $max -to $units -units off]
820	}
821	$w configure -spectrum [Rappture::Spectrum ::#auto [list \
822	$min white $max $color] -units $units]
823	}
824
825	set str [$libObj get $path.label]
826	if {$str != ""} {
827	set help [$libObj get $path.help]
828	if {"" != $help} {
829	append str "\n$help"
830	}
831	if {$units != ""} {
832	set desc [Rappture::Units::description $units]
833	append str "\n(units of $desc)"
834	}
835	Rappture::Tooltip::for $w $str
836	}
837
838	set str [$libObj get $path.icon]
839	if {$str != ""} {
840	$w configure -image [image create photo -data $str]
841	}
842	}
843
844	# ----------------------------------------------------------------------
845	# USAGE: _controlSet <widget> <libObj> <path>
846	#
847	# Invoked automatically whenever an internal control changes value.
848	# Queries the new value for the control and assigns the value to the
849	# given <path> on the XML object <libObj>.
850	# ----------------------------------------------------------------------
851	itcl::body Rappture::DeviceViewer1D::_controlSet {widget libObj path} {
852	set newval [$widget value]
853	$libObj put $path.current $newval
854	event generate $itk_component(hull) <<Edit>>
855	}
856
857	# ----------------------------------------------------------------------
858	# CONFIGURATION OPTION: -device
859	#
860	# Set to the Rappture::Library object representing the device being
861	# displayed in the viewer. If set to "", the viewer is cleared to
862	# display nothing.
863	# ----------------------------------------------------------------------
864	itcl::configbody Rappture::DeviceViewer1D::device {
865	if {$itk_option(-device) != ""} {
866	if {![Rappture::library isvalid $itk_option(-device)]} {
867	error "bad value \"$itk_option(-device)\": should be Rappture::Library"
868	}
869	}
870
871	delete
872	if {"" != $itk_option(-device)} {
873	add $itk_option(-device)
874	}
875	_loadDevice
876	}

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

Download in other formats: