Context Navigation

source: branches/1.3/gui/scripts/deviceViewer1D.tcl @ 4918

Last change on this file since 4918 was 3844, checked in by ldelgass, 11 years ago
Sync with trunk. Branch now differs only from trunk by r3722 (branch is version 1.3, trunk is version 1.4)
File size: 29.9 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	array set params $settings
170
171	set pos [lsearch -exact $_dlist $dataobj]
172
173	if {$pos < 0} {
174	if {![Rappture::library isvalid $dataobj]} {
175	error "bad value \"$dataobj\": should be Rappture::library object"
176	}
177
178	lappend _dlist $dataobj
179	set _dobj2raise($dataobj) $params(-raise)
180
181	after cancel [list catch [itcl::code $this _loadDevice]]
182	after idle [list catch [itcl::code $this _loadDevice]]
183	}
184	}
185
186	# ----------------------------------------------------------------------
187	# USAGE: get
188	#
189	# Clients use this to query the list of objects being plotted, in
190	# order from bottom to top of this result.
191	# ----------------------------------------------------------------------
192	itcl::body Rappture::DeviceViewer1D::get {} {
193	# put the dataobj list in order according to -raise options
194	set dlist $_dlist
195	foreach obj $dlist {
196	if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
197	set i [lsearch -exact $dlist $obj]
198	if {$i >= 0} {
199	set dlist [lreplace $dlist $i $i]
200	lappend dlist $obj
201	}
202	}
203	}
204	return $dlist
205	}
206
207	# ----------------------------------------------------------------------
208	# USAGE: delete ?<dataobj> <dataobj> ...?
209	#
210	# Clients use this to delete a dataobj from the plot. If no dataobjs
211	# are specified, then all dataobjs are deleted.
212	# ----------------------------------------------------------------------
213	itcl::body Rappture::DeviceViewer1D::delete {args} {
214	if {[llength $args] == 0} {
215	set args $_dlist
216	}
217
218	# delete all specified dataobjs
219	set changed 0
220	foreach dataobj $args {
221	set pos [lsearch -exact $_dlist $dataobj]
222	if {$pos >= 0} {
223	set _dlist [lreplace $_dlist $pos $pos]
224	catch {unset _dobj2raise($dataobj)}
225	set changed 1
226	}
227	}
228
229	# if anything changed, then rebuild the plot
230	if {$changed} {
231	after cancel [list catch [itcl::code $this _loadDevice]]
232	after idle [list catch [itcl::code $this _loadDevice]]
233	}
234	}
235
236	# ----------------------------------------------------------------------
237	# USAGE: controls insert <pos> <xmlobj> <path>
238	#
239	# Clients use this to add a control to the internal panels of this
240	# widget. Such controls are usually placed at the top of the widget,
241	# but if possible, they are integrated directly onto the device
242	# layout or the field area.
243	# ----------------------------------------------------------------------
244	itcl::body Rappture::DeviceViewer1D::controls {option args} {
245	switch -- $option {
246	insert {
247	if {[llength $args] != 3} {
248	error "wrong # args: should be \"controls insert pos xmlobj path\""
249	}
250	set pos [lindex $args 0]
251	set xmlobj [lindex $args 1]
252	set path [lindex $args 2]
253	if {[string match structure.parameters $path]} {
254	} elseif {[string match structure.components* $path]} {
255	$itk_component(layout) controls insert $pos $xmlobj $path
256	}
257	}
258	default {
259	error "bad option \"$option\": should be insert"
260	}
261	}
262	}
263
264
265	# ----------------------------------------------------------------------
266	# USAGE: download coming
267	# USAGE: download controls <downloadCommand>
268	# USAGE: download now
269	#
270	# Clients use this method to create a downloadable representation
271	# of the plot. Returns a list of the form {ext string}, where
272	# "ext" is the file extension (indicating the type of data) and
273	# "string" is the data itself.
274	# ----------------------------------------------------------------------
275	itcl::body Rappture::DeviceViewer1D::download {option args} {
276	switch $option {
277	coming {
278	# nothing to do
279	}
280	controls {
281	# no controls for this download yet
282	return ""
283	}
284	now {
285	return "" ;# not implemented yet!
286	}
287	default {
288	error "bad option \"$option\": should be coming, controls, now"
289	}
290	}
291	}
292
293	# ----------------------------------------------------------------------
294	# USAGE: _loadDevice
295	#
296	# Used internally to search for fields and create corresponding
297	# tabs whenever a device is installed into this viewer.
298	# ----------------------------------------------------------------------
299	itcl::body Rappture::DeviceViewer1D::_loadDevice {} {
300	set _device [lindex [get] end]
301
302	#
303	# Release any info left over from the last device.
304	#
305	foreach name [array names _tab2fields] {
306	eval itcl::delete object $_tab2fields($name)
307	}
308	catch {unset _tab2fields}
309	catch {unset _field2parm}
310
311	if {[winfo exists $itk_component(top).cntls]} {
312	$itk_component(top).cntls delete 0 end
313	}
314
315	#
316	# Scan through the current device and extract the list of
317	# fields. Create a tab for each field.
318	#
319	if {$_device != ""} {
320	foreach nn [$_device children fields] {
321	set name [$_device get fields.$nn.about.label]
322	if {$name == ""} {
323	set name $nn
324	}
325
326	set fobj [Rappture::Field ::#auto $_device fields.$nn]
327	lappend _tab2fields($name) $fobj
328	}
329	}
330	set tabs [lsort [array names _tab2fields]]
331
332	if {[$itk_component(tabs) size] > 0} {
333	$itk_component(tabs) delete 0 end
334	}
335
336	if {[llength $tabs] <= 0} {
337	#
338	# No fields? Then we don't need to bother with tabs.
339	# Just pack the inner frame directly. If there are no
340	# fields, get rid of the graph.
341	#
342	pack $itk_component(inner) -expand yes -fill both
343	if {[llength $tabs] > 0} {
344	pack $itk_component(graph) -expand yes -fill both
345	} else {
346	pack forget $itk_component(graph)
347	$itk_component(layout) configure -leftmargin 0 -rightmargin 0
348	}
349	} else {
350	#
351	# Two or more fields? Then create a tab for each field
352	# and select the first one by default. Make sure the
353	# graph is packed.
354	#
355	pack forget $itk_component(inner)
356	pack $itk_component(graph) -expand yes -fill both
357
358	foreach name $tabs {
359	$itk_component(tabs) insert end $name \
360	-activebackground $itk_option(-background)
361	}
362	$itk_component(tabs) select 0
363	}
364
365	#
366	# Scan through and look for any parameters in the <structure>.
367	# Register any parameters associated with fields, so we can
368	# add them as active controls whenever we install new fields.
369	# Create controls for any remaining parameters, so the user
370	# can see that there's something to adjust.
371	#
372	if {$_device != ""} {
373	_loadParameters $itk_component(top) parameters
374	}
375
376	#
377	# Install the first tab
378	#
379	_changeTabs
380
381	#
382	# Fix the right margin of the graph so that it has enough room
383	# to display the right-hand edge of the device.
384	#
385	$itk_component(graph) configure \
386	-rightmargin [$itk_component(layout) extents bar3D]
387
388	after cancel [list catch [itcl::code $this _fixSize]]
389	after idle [list catch [itcl::code $this _fixSize]]
390	}
391
392	# ----------------------------------------------------------------------
393	# USAGE: _loadParameters <frame> <path>
394	#
395	# Used internally in _loadDevice to load child parameters at the
396	# specified <path> into the <frame>. If any of the children are
397	# groups, then this is called recursively to fill in the group
398	# children.
399	# ----------------------------------------------------------------------
400	itcl::body Rappture::DeviceViewer1D::_loadParameters {frame path} {
401	foreach cname [$_device children $path] {
402	set handled 0
403	set type [$_device element -as type $path.$cname]
404	if {$type == "about"} {
405	continue
406	}
407	if {$type == "number"} {
408	set name [$_device element -as id $path.$cname]
409
410	# look for a field that uses this parameter
411	set found ""
412	foreach fname [$_device children fields] {
413	foreach comp [$_device children fields.$fname] {
414	set v [$_device get fields.$fname.$comp.constant]
415	if {[string equal $v $name]} {
416	set found "fields.$fname.$comp"
417	break
418	}
419	}
420	if {"" != $found} break
421	}
422
423	if {"" != $found} {
424	set _field2parm($found) $name
425	set handled 1
426	}
427	}
428
429	#
430	# Any parameter that was not handled above should be handled
431	# here, by adding it to a control panel above the device
432	# layout area.
433	#
434	if {!$handled} {
435	if {![winfo exists $frame.cntls]} {
436	Rappture::Controls $frame.cntls $_owner
437	pack $frame.cntls -expand yes -fill both
438	}
439	$frame.cntls insert end $path.$cname
440
441	#
442	# If this is a group, then we must add its children
443	# recursively.
444	#
445	if {$type == "group"} {
446	set gr [$frame.cntls control -value end]
447	_loadParameters [$gr component inner] $path.$cname
448	}
449	}
450	}
451	}
452
453	# ----------------------------------------------------------------------
454	# USAGE: _changeTabs ?-user\|-program?
455	#
456	# Used internally to change the field being displayed whenever a new
457	# tab is selected.
458	# ----------------------------------------------------------------------
459	itcl::body Rappture::DeviceViewer1D::_changeTabs {{why -program}} {
460	set graph $itk_component(graph)
461
462	#
463	# Figure out which tab is selected and make the inner frame
464	# visible in that tab.
465	#
466	set i [$itk_component(tabs) index select]
467	if {$i != ""} {
468	set name [$itk_component(tabs) get $i]
469	$itk_component(tabs) tab configure $name \
470	-window $itk_component(inner) -fill both
471	} else {
472	set name [lindex [array names _tab2fields] 0]
473	}
474
475	if {$why eq "-user"} {
476	Rappture::Logger::log device1D -field $name
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	$graph axis configure x -checklimits no
501
502	# turn on auto limits
503	$graph axis configure y -min "" -max "" -checklimits no
504
505	set flist ""
506	if {[info exists _tab2fields($name)]} {
507	set flist $_tab2fields($name)
508	}
509
510	set n 0
511	foreach fobj $flist {
512	catch {unset hints}
513	array set hints [$fobj hints]
514
515	if {[info exists hints(units)]} {
516	set _units $hints(units)
517	$graph axis configure y -title "$name ($hints(units))"
518	} else {
519	set _units ""
520	$graph axis configure y -title $name
521	}
522
523	if {[info exists hints(scale)]
524	&& [string match log* $hints(scale)]} {
525	$graph axis configure y -logscale yes
526	} else {
527	$graph axis configure y -logscale no
528	}
529
530	foreach comp [$fobj components] {
531	# can only handle 1D meshes here
532	if {[$fobj components -dimensions $comp] != "1D"} {
533	continue
534	}
535
536	set elem "elem[incr n]"
537	set xv [$fobj mesh $comp]
538	set yv [$fobj values $comp]
539
540	$graph element create $elem -x $xv -y $yv \
541	-color black -symbol "" -linewidth 2
542
543	if {[info exists hints(color)]} {
544	$graph element configure $elem -color $hints(color)
545	}
546
547	foreach {path x y val} [$fobj controls get $comp] {
548	if {$path != ""} {
549	set id "control[incr n]"
550	$graph marker create text -coords [list $x $y] \
551	-text $val -anchor s -name $id -background ""
552	$graph marker bind $id <Enter> \
553	[itcl::code $this _marker enter $id]
554	$graph marker bind $id <Leave> \
555	[itcl::code $this _marker leave $id]
556	$graph marker bind $id <ButtonPress> \
557	[itcl::code $this _marker edit $id $fobj/$path]
558	}
559	}
560	}
561	}
562
563	# let the widget settle, then fix the axes to "nice" values
564	after cancel [list catch [itcl::code $this _fixAxes]]
565	after 100 [list catch [itcl::code $this _fixAxes]]
566	}
567
568	# ----------------------------------------------------------------------
569	# USAGE: _fixSize
570	#
571	# Used internally to fix the overall size of this widget based on
572	# the various parts inside. Sets the requested width/height of the
573	# widget so that it is big enough to display the device and its
574	# fields.
575	# ----------------------------------------------------------------------
576	itcl::body Rappture::DeviceViewer1D::_fixSize {} {
577	update idletasks
578	set w [winfo reqwidth $itk_component(tabs)]
579	set h [winfo reqheight $itk_component(tabs)]
580	component hull configure -width $w -height $h
581	}
582
583	# ----------------------------------------------------------------------
584	# USAGE: _fixAxes
585	#
586	# Used internally to adjust the y-axis limits of the graph to "nice"
587	# values, so that any control marker associated with the value,
588	# for example, remains on screen.
589	# ----------------------------------------------------------------------
590	itcl::body Rappture::DeviceViewer1D::_fixAxes {} {
591	set graph $itk_component(graph)
592	if {![winfo ismapped $graph]} {
593	after cancel [list catch [itcl::code $this _fixAxes]]
594	after 100 [list catch [itcl::code $this _fixAxes]]
595	return
596	}
597
598	#
599	# HACK ALERT!
600	# Use this code to fix up the y-axis limits for the BLT graph.
601	# The auto-limits don't always work well. We want them to be
602	# set to a "nice" number slightly above or below the min/max
603	# limits.
604	#
605	set log [$graph axis cget y -logscale]
606	$graph axis configure y -min "" -max ""
607	foreach {min max} [$graph axis limits y] { break }
608
609	if {$log} {
610	set min [expr {0.9*$min}]
611	set max [expr {1.1*$max}]
612	} else {
613	if {$min > 0} {
614	set min [expr {0.95*$min}]
615	} else {
616	set min [expr {1.05*$min}]
617	}
618	if {$max > 0} {
619	set max [expr {1.05*$max}]
620	} else {
621	set max [expr {0.95*$max}]
622	}
623	}
624
625	# bump up the max so that it's big enough to show control markers
626	set fnt $itk_option(-font)
627	set h [expr {[font metrics $fnt -linespace] + 5}]
628	foreach mname [$graph marker names] {
629	set xy [$graph marker cget $mname -coord]
630	foreach {x y} [eval $graph transform $xy] { break }
631	set y [expr {$y-$h}] ;# find top of text in pixels
632	foreach {x y} [eval $graph invtransform [list 0 $y]] { break }
633	if {$y > $max} { set max $y }
634	}
635
636	if {$log} {
637	set min [expr {pow(10.0,floor(log10($min)))}]
638	set max [expr {pow(10.0,ceil(log10($max)))}]
639	} else {
640	set min [expr {0.1floor(10$min)}]
641	set max [expr {0.1ceil(10$max)}]
642	}
643
644	$graph axis configure y -min $min -max $max
645
646	after cancel [list catch [itcl::code $this _align]]
647	after 100 [list catch [itcl::code $this _align]]
648	}
649
650	# ----------------------------------------------------------------------
651	# USAGE: _align
652	#
653	# Used internally to align the margins of the device layout and the
654	# graph, so that two areas line up.
655	# ----------------------------------------------------------------------
656	itcl::body Rappture::DeviceViewer1D::_align {} {
657	set graph $itk_component(graph)
658
659	#
660	# Set the left/right margins of the layout so that it aligns
661	# with the graph. Set the right margin of the graph so it
662	# it is big enough to show the 3D edge of the device that
663	# hangs over on the right-hand side.
664	#
665	update
666	foreach {xmin xmax} [$graph axis limits x] { break }
667	set lm [$graph xaxis transform $xmin]
668	$itk_component(layout) configure -leftmargin $lm
669
670	set w [winfo width $graph]
671	set rm [expr {$w-[$graph xaxis transform $xmax]}]
672	$itk_component(layout) configure -rightmargin $rm
673	}
674
675	# ----------------------------------------------------------------------
676	# USAGE: _marker enter <name>
677	# USAGE: _marker leave <name>
678	# USAGE: _marker edit <name> <path>
679	# USAGE: _marker activate
680	# USAGE: _marker validate <value>
681	# USAGE: _marker apply <value>
682	#
683	# Used internally to manipulate the control markers draw on the
684	# graph for a field.
685	# ----------------------------------------------------------------------
686	itcl::body Rappture::DeviceViewer1D::_marker {option {name ""} {path ""}} {
687	switch -- $option {
688	enter {
689	$itk_component(graph) marker configure $name -background #e5e5e5
690	#
691	# BE CAREFUL: Need an update here to force the graph to
692	# refresh itself or else a subsequent click on the
693	# marker will ignore the text that was recently changed,
694	# and fail to generate a <ButtonPress> event!
695	#
696	update idletasks
697	}
698	leave {
699	$itk_component(graph) marker configure $name -background ""
700	#
701	# BE CAREFUL: Need an update here to force the graph to
702	# refresh itself or else a subsequent click on the
703	# marker will ignore the text that was recently changed,
704	# and fail to generate a <ButtonPress> event!
705	#
706	update idletasks
707	}
708	edit {
709	set _marker(name) $name
710	set _marker(fobj) [lindex [split $path /] 0]
711	set _marker(path) [lindex [split $path /] 1]
712	$itk_component(geditor) activate
713	}
714	activate {
715	set g $itk_component(graph)
716	set val [$g marker cget $_marker(name) -text]
717	foreach {x y} [$g marker cget $_marker(name) -coords] { break }
718	foreach {x y} [$g transform $x $y] { break }
719	set x [expr {$x + [winfo rootx $g] - 4}]
720	set y [expr {$y + [winfo rooty $g] - 5}]
721
722	set fnt $itk_option(-font)
723	set h [expr {[font metrics $fnt -linespace] + 2}]
724	set w [expr {[font measure $fnt $val] + 5}]
725
726	return [list text $val \
727	x [expr {$x-$w/2}] \
728	y [expr {$y-$h}] \
729	w $w \
730	h $h]
731	}
732	validate {
733	if {$_units != ""} {
734	if {[catch {Rappture::Units::convert $name \
735	-context $_units -to $_units} result] != 0} {
736	if {[regexp {^bad.*: +(.)(.+)} $result match first tail]
737	\|\| [regexp {(.)(.+)} $result match first tail]} {
738	set result "[string toupper $first]$tail"
739	}
740	bell
741	Rappture::Tooltip::cue $itk_component(geditor) $result
742	Rappture::Logger::log warning $_marker(path) $result
743	return 0
744	}
745	}
746	if {[catch {$_marker(fobj) controls validate $_marker(path) $name} result]} {
747	bell
748	Rappture::Tooltip::cue $itk_component(geditor) $result
749	Rappture::Logger::log warning $_marker(path) $result
750	return 0
751	}
752	return 1
753	}
754	apply {
755	if {$_units != ""} {
756	catch {Rappture::Units::convert $name \
757	-context $_units -to $_units} value
758	} else {
759	set value $name
760	}
761
762	$_marker(fobj) controls put $_marker(path) $value
763	$_owner changed $_marker(path)
764	event generate $itk_component(hull) <<Edit>>
765	Rappture::Logger::log input $_marker(path) $value
766
767	_changeTabs
768	}
769	}
770	}
771
772	# ----------------------------------------------------------------------
773	# USAGE: _controlCreate <container> <libObj> <path>
774	#
775	# Used internally to create a gauge widget and pack it into the
776	# given <container>. When the gauge is set, it updates the value
777	# for the <path> in the <libObj>.
778	# ----------------------------------------------------------------------
779	itcl::body Rappture::DeviceViewer1D::_controlCreate {container libObj path} {
780	set presets ""
781	foreach pre [$libObj children -type preset $path] {
782	lappend presets \
783	[$libObj get $path.$pre.value] \
784	[$libObj get $path.$pre.label]
785	}
786
787	set type Rappture::Gauge
788	set units [$libObj get $path.units]
789	if {$units != ""} {
790	set desc [Rappture::Units::description $units]
791	if {[string match temperature* $desc]} {
792	set type Rappture::TemperatureGauge
793	}
794	}
795
796	set counter 0
797	set w "$container.gauge[incr counter]"
798	while {[winfo exists $w]} {
799	set w "$container.gauge[incr counter]"
800	}
801
802	# create the widget
803	$type $w -units $units -presets $presets -log $path
804	pack $w -side top -anchor w
805	bind $w <<Value>> [itcl::code $this _controlSet $w $libObj $path]
806
807	set min [$libObj get $path.min]
808	if {"" != $min} { $w configure -minvalue $min }
809
810	set max [$libObj get $path.max]
811	if {"" != $max} { $w configure -maxvalue $max }
812
813	set str [$libObj get $path.default]
814	if {$str != ""} { $w value $str }
815
816	if {$type == "Rappture::Gauge" && "" != $min && "" != $max} {
817	set color [$libObj get $path.color]
818	if {$color == ""} {
819	set color blue
820	}
821	if {$units != ""} {
822	set min [Rappture::Units::convert $min -to $units -units off]
823	set max [Rappture::Units::convert $max -to $units -units off]
824	}
825	$w configure -spectrum [Rappture::Spectrum ::#auto [list \
826	$min white $max $color] -units $units]
827	}
828
829	set str [$libObj get $path.label]
830	if {$str != ""} {
831	set help [$libObj get $path.help]
832	if {"" != $help} {
833	append str "\n$help"
834	}
835	if {$units != ""} {
836	set desc [Rappture::Units::description $units]
837	append str "\n(units of $desc)"
838	}
839	Rappture::Tooltip::for $w $str
840	}
841
842	set str [$libObj get $path.icon]
843	if {$str != ""} {
844	$w configure -image [image create photo -data $str]
845	}
846	}
847
848	# ----------------------------------------------------------------------
849	# USAGE: _controlSet <widget> <libObj> <path>
850	#
851	# Invoked automatically whenever an internal control changes value.
852	# Queries the new value for the control and assigns the value to the
853	# given <path> on the XML object <libObj>.
854	# ----------------------------------------------------------------------
855	itcl::body Rappture::DeviceViewer1D::_controlSet {widget libObj path} {
856	set newval [$widget value]
857	$libObj put $path.current $newval
858	event generate $itk_component(hull) <<Edit>>
859	}
860
861	# ----------------------------------------------------------------------
862	# CONFIGURATION OPTION: -device
863	#
864	# Set to the Rappture::Library object representing the device being
865	# displayed in the viewer. If set to "", the viewer is cleared to
866	# display nothing.
867	# ----------------------------------------------------------------------
868	itcl::configbody Rappture::DeviceViewer1D::device {
869	if {$itk_option(-device) != ""} {
870	if {![Rappture::library isvalid $itk_option(-device)]} {
871	error "bad value \"$itk_option(-device)\": should be Rappture::Library"
872	}
873	}
874
875	delete
876	if {"" != $itk_option(-device)} {
877	add $itk_option(-device)
878	}
879	_loadDevice
880	}

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

Download in other formats: