Context Navigation

field.tcl @ 738

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

Fixed a problem recently introduced with device structures on the
input side. app-rtd was having trouble changing the structure when
you changed devices via the loader.

Fix for support ticket #1631 'can't read "_axis(click-x)": no such
variable'. Added some code to guard against the case when release
gets called somehow before click.

Fix for support ticket #1688 'can't use empty string as operand of "-"'
Fix for support ticket #1689 'divide by zero'
Fix for support ticket #1707 'can't read "_dobj2cols(-energy)":
no such element in array'
All of these fixes had to do with the energy viewer, particularly
in the case where there was only 1 energy level, so the homo/lumo
levels could not be displayed.

Fix for support ticket #1704 'impossible limits (min 1.58489 >=
max 6.30957e-05)'
Added some code to guard against setting limits where min >= max.

File size: 24.0 KB

Line
1	# ----------------------------------------------------------------------
2	# COMPONENT: field - extracts data from an XML description of a field
3	#
4	# This object represents one field in an XML description of a device.
5	# It simplifies the process of extracting data vectors that represent
6	# the field.
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 Itcl
15	package require BLT
16
17	namespace eval Rappture { # forward declaration }
18
19	itcl::class Rappture::Field {
20	constructor {xmlobj path} { # defined below }
21	destructor { # defined below }
22
23	public method components {args}
24	public method mesh {{what -overall}}
25	public method values {{what -overall}}
26	public method limits {axis}
27	public method controls {option args}
28	public method hints {{key ""}}
29
30	protected method _build {}
31	protected method _getValue {expr}
32
33	private variable _xmlobj "" ;# ref to XML obj with device data
34
35	private variable _units "" ;# system of units for this field
36	private variable _limits ;# maps box name => {z0 z1} limits
37	private variable _zmax 0 ;# length of the device
38
39	private variable _field "" ;# lib obj representing this field
40	private variable _comp2dims ;# maps component name => dimensionality
41	private variable _comp2xy ;# maps component name => x,y vectors
42	private variable _comp2vtk ;# maps component name => vtkFloatArray
43	private variable _comp2dx ;# maps component name => OpenDX data
44	private variable _comp2style ;# maps component name => style settings
45	private variable _comp2cntls ;# maps component name => x,y control points
46
47	private common _counter 0 ;# counter for unique vector names
48	}
49
50	# ----------------------------------------------------------------------
51	# CONSTRUCTOR
52	# ----------------------------------------------------------------------
53	itcl::body Rappture::Field::constructor {xmlobj path} {
54	if {![Rappture::library isvalid $xmlobj]} {
55	error "bad value \"$xmlobj\": should be Rappture::library"
56	}
57	set _xmlobj $xmlobj
58	set _field [$xmlobj element -as object $path]
59	set _units [$_field get units]
60
61	set xunits [$xmlobj get units]
62	if {"" == $xunits \|\| "arbitrary" == $xunits} {
63	set xunits "um"
64	}
65
66	# determine the overall size of the device
67	set z0 [set z1 0]
68	foreach elem [$_xmlobj children components] {
69	switch -glob -- $elem {
70	box* {
71	if {![regexp {[0-9]$} $elem]} {
72	set elem "${elem}0"
73	}
74	set z0 [$_xmlobj get components.$elem.corner0]
75	set z0 [Rappture::Units::convert $z0 \
76	-context $xunits -to $xunits -units off]
77
78	set z1 [$_xmlobj get components.$elem.corner1]
79	set z1 [Rappture::Units::convert $z1 \
80	-context $xunits -to $xunits -units off]
81
82	set _limits($elem) [list $z0 $z1]
83	}
84	}
85	}
86	set _zmax $z1
87
88	# build up vectors for various components of the field
89	_build
90	}
91
92	# ----------------------------------------------------------------------
93	# DESTRUCTOR
94	# ----------------------------------------------------------------------
95	itcl::body Rappture::Field::destructor {} {
96	itcl::delete object $_field
97	# don't destroy the _xmlobj! we don't own it!
98
99	foreach name [array names _comp2xy] {
100	eval blt::vector destroy $_comp2xy($name)
101	}
102	foreach name [array names _comp2vtk] {
103	set mobj [lindex $_comp2vtk($name) 0]
104	set class [$mobj info class]
105	${class}::release $mobj
106
107	set fobj [lindex $_comp2vtk($name) 1]
108	rename $fobj ""
109	}
110	}
111
112	# ----------------------------------------------------------------------
113	# USAGE: components ?-name\|-dimensions\|-style? ?<pattern>?
114	#
115	# Returns a list of names or types for the various components of
116	# this field. If the optional glob-style <pattern> is specified,
117	# then it returns only the components with names matching the pattern.
118	# ----------------------------------------------------------------------
119	itcl::body Rappture::Field::components {args} {
120	Rappture::getopts args params {
121	flag what -name default
122	flag what -dimensions
123	flag what -style
124	}
125
126	set pattern *
127	if {[llength $args] > 0} {
128	set pattern [lindex $args 0]
129	set args [lrange $args 1 end]
130	}
131	if {[llength $args] > 0} {
132	error "wrong # args: should be \"components ?switches? ?pattern?\""
133	}
134
135	set rlist ""
136
137	# BE CAREFUL: return component names in proper order
138	foreach cname [$_field children -type component] {
139	if {[info exists _comp2dims($cname)]
140	&& [string match $pattern $cname]} {
141
142	switch -- $params(what) {
143	-name { lappend rlist $cname }
144	-dimensions { lappend rlist $_comp2dims($cname) }
145	-style { lappend rlist $_comp2style($cname) }
146	}
147	}
148	}
149	return $rlist
150	}
151
152	# ----------------------------------------------------------------------
153	# USAGE: mesh ?<name>?
154	#
155	# Returns a list {xvec yvec} for the specified field component <name>.
156	# If the name is not specified, then it returns the vectors for the
157	# overall field (sum of all components).
158	# ----------------------------------------------------------------------
159	itcl::body Rappture::Field::mesh {{what -overall}} {
160	if {$what == "-overall" \|\| $what == "component0"} {
161	set what [lindex [components -name] 0]
162	}
163	if {[info exists _comp2xy($what)]} {
164	return [lindex $_comp2xy($what) 0] ;# return xv
165	}
166	if {[info exists _comp2vtk($what)]} {
167	set mobj [lindex $_comp2vtk($what) 0]
168	return [$mobj mesh]
169	}
170	if {[info exists _comp2dx($what)]} {
171	return "" ;# no mesh -- it's embedded in the value data
172	}
173	error "bad option \"$what\": should be [join [lsort [array names _comp2dims]] {, }]"
174	}
175
176	# ----------------------------------------------------------------------
177	# USAGE: values ?<name>?
178	#
179	# Returns a list {xvec yvec} for the specified field component <name>.
180	# If the name is not specified, then it returns the vectors for the
181	# overall field (sum of all components).
182	# ----------------------------------------------------------------------
183	itcl::body Rappture::Field::values {{what -overall}} {
184	if {$what == "component0"} {
185	set what "component"
186	}
187	if {[info exists _comp2xy($what)]} {
188	return [lindex $_comp2xy($what) 1] ;# return yv
189	}
190	if {[info exists _comp2vtk($what)]} {
191	return [lindex $_comp2vtk($what) 1] ;# return vtkFloatArray
192	}
193	if {[info exists _comp2dx($what)]} {
194	return $_comp2dx($what) ;# return gzipped, base64-encoded DX data
195	}
196	error "bad option \"$what\": should be [join [lsort [array names _comp2dims]] {, }]"
197	}
198
199	# ----------------------------------------------------------------------
200	# USAGE: limits <axis>
201	#
202	# Returns a list {min max} representing the limits for the specified
203	# axis.
204	# ----------------------------------------------------------------------
205	itcl::body Rappture::Field::limits {which} {
206	set min ""
207	set max ""
208
209	blt::vector create tmp zero
210	foreach comp [array names _comp2dims] {
211	switch -- $_comp2dims($comp) {
212	1D {
213	switch -- $which {
214	x - xlin { set pos 0; set log 0; set axis xaxis }
215	xlog { set pos 0; set log 1; set axis xaxis }
216	y - ylin - v - vlin { set pos 1; set log 0; set axis yaxis }
217	ylog - vlog { set pos 1; set log 1; set axis yaxis }
218	default {
219	error "bad option \"$which\": should be x, xlin, xlog, y, ylin, ylog, v, vlin, vlog"
220	}
221	}
222
223	set vname [lindex $_comp2xy($comp) $pos]
224	$vname variable vec
225
226	if {$log} {
227	# on a log scale, use abs value and ignore 0's
228	$vname dup tmp
229	$vname dup zero
230	zero expr {tmp == 0} ;# find the 0's
231	tmp expr {abs(tmp)} ;# get the abs value
232	tmp expr {tmp + zero*max(tmp)} ;# replace 0's with abs max
233	set vmin [blt::vector expr min(tmp)]
234	set vmax [blt::vector expr max(tmp)]
235	} else {
236	set vmin $vec(min)
237	set vmax $vec(max)
238	}
239
240	if {"" == $min} {
241	set min $vmin
242	} elseif {$vmin < $min} {
243	set min $vmin
244	}
245	if {"" == $max} {
246	set max $vmax
247	} elseif {$vmax > $max} {
248	set max $vmax
249	}
250	}
251	2D - 3D {
252	if {[info exists _comp2vtk($comp)]} {
253	foreach {xv yv} $_comp2vtk($comp) break
254	switch -- $which {
255	x - xlin - xlog {
256	foreach {vmin vmax} [$xv limits x] break
257	set axis xaxis
258	}
259	y - ylin - ylog {
260	foreach {vmin vmax} [$xv limits y] break
261	set axis yaxis
262	}
263	z - zlin - zlog {
264	foreach {vmin vmax} [$xv limits z] break
265	set axis zaxis
266	}
267	v - vlin - vlog {
268	catch {unset style}
269	array set style $_comp2style($comp)
270	if {[info exists style(-min)] && [info exists style(-max)]} {
271	# This component has its own hard-coded
272	# min/max range. Ignore it for overall limits.
273	set vmin $min
274	set vmax $max
275	} else {
276	foreach {vmin vmax} [$yv GetRange] break
277	}
278	set axis vaxis
279	}
280	default {
281	error "bad option \"$which\": should be x, xlin, xlog, y, ylin, ylog, v, vlin, vlog"
282	}
283	}
284	} else {
285	set vmin 0 ;# HACK ALERT! must be OpenDX data
286	set vmax 1
287	set axis vaxis
288	}
289	}
290	}
291	if {"" == $min} {
292	set min $vmin
293	} elseif {$vmin < $min} {
294	set min $vmin
295	}
296	if {"" == $max} {
297	set max $vmax
298	} elseif {$vmax > $max} {
299	set max $vmax
300	}
301	}
302	blt::vector destroy tmp zero
303
304	set val [$_field get $axis.min]
305	if {"" != $val && "" != $min} {
306	if {$val > $min} {
307	# tool specified this min -- don't go any lower
308	set min $val
309	}
310	}
311
312	set val [$_field get $axis.max]
313	if {"" != $val && "" != $max} {
314	if {$val < $max} {
315	# tool specified this max -- don't go any higher
316	set max $val
317	}
318	}
319
320	return [list $min $max]
321	}
322
323	# ----------------------------------------------------------------------
324	# USAGE: controls get ?<name>?
325	# USAGE: controls validate <path> <value>
326	# USAGE: controls put <path> <value>
327	#
328	# Returns a list {path1 x1 y1 val1 path2 x2 y2 val2 ...} representing
329	# control points for the specified field component <name>.
330	# ----------------------------------------------------------------------
331	itcl::body Rappture::Field::controls {option args} {
332	switch -- $option {
333	get {
334	set what [lindex $args 0]
335	if {[info exists _comp2cntls($what)]} {
336	return $_comp2cntls($what)
337	}
338	return ""
339	}
340	validate {
341	set path [lindex $args 0]
342	set value [lindex $args 1]
343	set units [$_xmlobj get $path.units]
344
345	if {"" != $units} {
346	set nv [Rappture::Units::convert \
347	$value -context $units -to $units -units off]
348	} else {
349	set nv $value
350	}
351	if {![string is double $nv]
352	\|\| [regexp -nocase {^(inf\|nan)$} $nv]} {
353	error "Value out of range"
354	}
355
356	set rawmin [$_xmlobj get $path.min]
357	if {"" != $rawmin} {
358	set minv $rawmin
359	if {"" != $units} {
360	set minv [Rappture::Units::convert \
361	$minv -context $units -to $units -units off]
362	set nv [Rappture::Units::convert \
363	$value -context $units -to $units -units off]
364	}
365	# fix for the case when the user tries to
366	# compare values like minv=-500 nv=-0600
367	set nv [format "%g" $nv]
368	set minv [format "%g" $minv]
369
370	if {$nv < $minv} {
371	error "Minimum value allowed here is $rawmin"
372	}
373	}
374
375	set rawmax [$_xmlobj get $path.max]
376	if {"" != $rawmax} {
377	set maxv $rawmax
378	if {"" != $units} {
379	set maxv [Rappture::Units::convert \
380	$maxv -context $units -to $units -units off]
381	set nv [Rappture::Units::convert \
382	$value -context $units -to $units -units off]
383	}
384	# fix for the case when the user tries to
385	# compare values like maxv=-500 nv=-0600
386	set nv [format "%g" $nv]
387	set maxv [format "%g" $maxv]
388
389	if {$nv > $maxv} {
390	error "Maximum value allowed here is $rawmax"
391	}
392	}
393
394	return "ok"
395	}
396	put {
397	set path [lindex $args 0]
398	set value [lindex $args 1]
399	$_xmlobj put $path.current $value
400	_build
401	}
402	default {
403	error "bad option \"$option\": should be get or put"
404	}
405	}
406	}
407
408	# ----------------------------------------------------------------------
409	# USAGE: hints ?<keyword>?
410	#
411	# Returns a list of key/value pairs for various hints about plotting
412	# this field. If a particular <keyword> is specified, then it returns
413	# the hint for that <keyword>, if it exists.
414	# ----------------------------------------------------------------------
415	itcl::body Rappture::Field::hints {{keyword ""}} {
416	foreach {key path} {
417	group about.group
418	label about.label
419	color about.color
420	style about.style
421	scale about.scale
422	units units
423	updir updir
424	} {
425	set str [$_field get $path]
426	if {"" != $str} {
427	set hints($key) $str
428	}
429	}
430
431	# to be compatible with curve objects
432	set hints(xlabel) "Position"
433
434	if {[info exists hints(group)] && [info exists hints(label)]} {
435	# pop-up help for each curve
436	set hints(tooltip) $hints(label)
437	}
438
439	if {$keyword != ""} {
440	if {[info exists hints($keyword)]} {
441	return $hints($keyword)
442	}
443	return ""
444	}
445	return [array get hints]
446	}
447
448	# ----------------------------------------------------------------------
449	# USAGE: _build
450	#
451	# Used internally to build up the vector representation for the
452	# field when the object is first constructed, or whenever the field
453	# data changes. Discards any existing vectors and builds everything
454	# from scratch.
455	# ----------------------------------------------------------------------
456	itcl::body Rappture::Field::_build {} {
457	# discard any existing data
458	foreach name [array names _comp2xy] {
459	eval blt::vector destroy $_comp2xy($name)
460	}
461	foreach name [array names _comp2vtk] {
462	set mobj [lindex $_comp2vtk($name) 0]
463	set class [$mobj info class]
464	${class}::release $mobj
465
466	set fobj [lindex $_comp2vtk($name) 1]
467	rename $fobj ""
468	}
469	catch {unset _comp2xy}
470	catch {unset _comp2vtk}
471	catch {unset _comp2dx}
472	catch {unset _comp2dims}
473	catch {unset _comp2style}
474
475	#
476	# Scan through the components of the field and create
477	# vectors for each part.
478	#
479	foreach cname [$_field children -type component] {
480	set type ""
481	if {( [$_field element $cname.constant] != ""
482	&& [$_field element $cname.domain] != "" )
483	\|\| [$_field element $cname.xy] != ""} {
484	set type "1D"
485	} elseif {[$_field element $cname.mesh] != ""
486	&& [$_field element $cname.values] != ""} {
487	set type "points-on-mesh"
488	} elseif {[$_field element $cname.vtk] != ""} {
489	set type "vtk"
490	} elseif {[$_field element $cname.dx] != ""} {
491	set type "dx"
492	}
493
494	set _comp2style($cname) ""
495
496	if {$type == "1D"} {
497	#
498	# 1D data can be represented as 2 BLT vectors,
499	# one for x and the other for y.
500	#
501	set xv ""
502	set yv ""
503
504	set val [$_field get $cname.constant]
505	if {$val != ""} {
506	set domain [$_field get $cname.domain]
507	if {$domain == "" \|\| ![info exists _limits($domain)]} {
508	set z0 0
509	set z1 $_zmax
510	} else {
511	foreach {z0 z1} $_limits($domain) { break }
512	}
513	set xv [blt::vector create x$_counter]
514	$xv append $z0 $z1
515
516	foreach {val pcomp} [_getValue $val] break
517	set yv [blt::vector create y$_counter]
518	$yv append $val $val
519
520	if {$pcomp != ""} {
521	set zm [expr {0.5*($z0+$z1)}]
522	set _comp2cntls($cname) \
523	[list $pcomp $zm $val "$val$_units"]
524	}
525	} else {
526	set xydata [$_field get $cname.xy]
527	if {"" != $xydata} {
528	set xv [blt::vector create x$_counter]
529	set yv [blt::vector create y$_counter]
530
531	foreach line [split $xydata \n] {
532	if {[scan $line {%g %g} xval yval] == 2} {
533	$xv append $xval
534	$yv append $yval
535	}
536	}
537	}
538	}
539
540	if {$xv != "" && $yv != ""} {
541	# sort x-coords in increasing order
542	$xv sort $yv
543
544	set _comp2dims($cname) "1D"
545	set _comp2xy($cname) [list $xv $yv]
546	incr _counter
547	}
548	} elseif {$type == "points-on-mesh"} {
549	#
550	# More complex 2D/3D data is represented by a mesh
551	# object and an associated vtkFloatArray for field
552	# values.
553	#
554	set path [$_field get $cname.mesh]
555	if {[$_xmlobj element $path] != ""} {
556	switch -- [$_xmlobj element -as type $path] {
557	cloud {
558	set mobj [Rappture::Cloud::fetch $_xmlobj $path]
559	}
560	mesh {
561	set mobj [Rappture::Mesh::fetch $_xmlobj $path]
562	}
563	}
564
565	if {[$mobj dimensions] > 1} {
566	#
567	# 2D/3D data
568	# Store cloud/field as components
569	#
570	set values [$_field get $cname.values]
571	set farray [vtkFloatArray ::vals$_counter]
572
573	foreach v $values {
574	if {"" != $_units} {
575	set v [Rappture::Units::convert $v \
576	-context $_units -to $_units -units off]
577	}
578	$farray InsertNextValue $v
579	}
580
581	set _comp2dims($cname) "[$mobj dimensions]D"
582	set _comp2vtk($cname) [list $mobj $farray]
583	set _comp2style($cname) [$_field get $cname.style]
584	incr _counter
585	} else {
586	#
587	# OOPS! This is 1D data
588	# Forget the cloud/field -- store BLT vectors
589	#
590	set xv [blt::vector create x$_counter]
591	set yv [blt::vector create y$_counter]
592
593	set vtkpts [$mobj points]
594	set max [$vtkpts GetNumberOfPoints]
595	for {set i 0} {$i < $max} {incr i} {
596	set xval [lindex [$vtkpts GetPoint $i] 0]
597	$xv append $xval
598	}
599	set class [$mobj info class]
600	${class}::release $mobj
601
602	set values [$_field get $cname.values]
603	foreach yval $values {
604	if {"" != $_units} {
605	set yval [Rappture::Units::convert $yval \
606	-context $_units -to $_units -units off]
607	}
608	$yv append $yval
609	}
610
611	# sort x-coords in increasing order
612	$xv sort $yv
613
614	set _comp2dims($cname) "1D"
615	set _comp2xy($cname) [list $xv $yv]
616	incr _counter
617	}
618	} else {
619	puts "WARNING: can't find mesh $path for field component"
620	}
621	} elseif {$type == "vtk"} {
622	#
623	# Extract native vtk data from the XML and use a reader
624	# to load it.
625	#
626	vtkRectilinearGridReader $this-gr
627	$this-gr SetInputString [$_field get $cname.vtk]
628
629
630	set _comp2dims($cname) "[$mobj dimensions]D"
631	set _comp2vtk($cname) [list $mobj $farray]
632	set _comp2style($cname) [$_field get $cname.style]
633	incr _counter
634	} elseif {$type == "dx"} {
635	#
636	# HACK ALERT! Extract gzipped, base64-encoded OpenDX
637	# data. Assume that it's 3D. Pass it straight
638	# off to the NanoVis visualizer.
639	#
640	set _comp2dims($cname) "3D"
641	set _comp2dx($cname) [$_field get $cname.dx]
642	set _comp2style($cname) [$_field get $cname.style]
643	incr _counter
644	}
645	}
646	}
647
648	# ----------------------------------------------------------------------
649	# USAGE: _getValue <expr>
650	#
651	# Used internally to get the value for an expression <expr>. Returns
652	# a list of the form {val parameterPath}, where val is the numeric
653	# value of the expression, and parameterPath is the XML path to the
654	# parameter representing the value, or "" if the <expr> does not
655	# depend on any parameters.
656	# ----------------------------------------------------------------------
657	itcl::body Rappture::Field::_getValue {expr} {
658	#
659	# First, look for the expression among the <parameter>'s
660	# associated with the device.
661	#
662	set found 0
663	foreach pcomp [$_xmlobj children parameters] {
664	set id [$_xmlobj element -as id parameters.$pcomp]
665	if {[string equal $id $expr]} {
666	set val [$_xmlobj get parameters.$pcomp.current]
667	if {"" == $val} {
668	set val [$_xmlobj get parameters.$pcomp.default]
669	}
670	if {"" != $val} {
671	set expr $val
672	set found 1
673	break
674	}
675	}
676	}
677	if {$found} {
678	set pcomp "parameters.$pcomp"
679	} else {
680	set pcomp ""
681	}
682
683	if {$_units != ""} {
684	set expr [Rappture::Units::convert $expr \
685	-context $_units -to $_units -units off]
686	}
687
688	return [list $expr $pcomp]
689	}

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

Context Navigation

source: trunk/gui/scripts/field.tcl @ 738

Download in other formats: