Context Navigation

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

Last change on this file since 3394 was 3330, checked in by gah, 11 years ago
merge (by hand) with Rappture1.2 branch
File size: 30.1 KB

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

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

Download in other formats: