Context Navigation

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

Last change on this file since 466 was 460, checked in by mmc, 18 years ago
Fixed the 3D viewer so that if it detects old-style vtk data, it will drop back to using the old vtk viewer. This means that older tools shouldn't be affected by the new nanovis upgrade.
File size: 21.7 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	foreach name [array names _comp2dims $pattern] {
137	switch -- $params(what) {
138	-name { lappend rlist $name }
139	-dimensions { lappend rlist $_comp2dims($name) }
140	-style { lappend rlist $_comp2style($name) }
141	}
142	}
143	return $rlist
144	}
145
146	# ----------------------------------------------------------------------
147	# USAGE: mesh ?<name>?
148	#
149	# Returns a list {xvec yvec} for the specified field component <name>.
150	# If the name is not specified, then it returns the vectors for the
151	# overall field (sum of all components).
152	# ----------------------------------------------------------------------
153	itcl::body Rappture::Field::mesh {{what -overall}} {
154	if {$what == "-overall" \|\| $what == "component0"} {
155	set what "component"
156	}
157	if {[info exists _comp2xy($what)]} {
158	return [lindex $_comp2xy($what) 0] ;# return xv
159	}
160	if {[info exists _comp2vtk($what)]} {
161	set mobj [lindex $_comp2vtk($what) 0]
162	return [$mobj mesh]
163	}
164	if {[info exists _comp2dx($what)]} {
165	return "" ;# no mesh -- it's embedded in the value data
166	}
167	error "bad option \"$what\": should be [join [lsort [array names _comp2dims]] {, }]"
168	}
169
170	# ----------------------------------------------------------------------
171	# USAGE: values ?<name>?
172	#
173	# Returns a list {xvec yvec} for the specified field component <name>.
174	# If the name is not specified, then it returns the vectors for the
175	# overall field (sum of all components).
176	# ----------------------------------------------------------------------
177	itcl::body Rappture::Field::values {{what -overall}} {
178	if {$what == "component0"} {
179	set what "component"
180	}
181	if {[info exists _comp2xy($what)]} {
182	return [lindex $_comp2xy($what) 1] ;# return yv
183	}
184	if {[info exists _comp2vtk($what)]} {
185	return [lindex $_comp2vtk($what) 1] ;# return vtkFloatArray
186	}
187	if {[info exists _comp2dx($what)]} {
188	return $_comp2dx($what) ;# return gzipped, base64-encoded DX data
189	}
190	error "bad option \"$what\": should be [join [lsort [array names _comp2dims]] {, }]"
191	}
192
193	# ----------------------------------------------------------------------
194	# USAGE: limits <axis>
195	#
196	# Returns a list {min max} representing the limits for the specified
197	# axis.
198	# ----------------------------------------------------------------------
199	itcl::body Rappture::Field::limits {which} {
200	set min ""
201	set max ""
202
203	blt::vector create tmp zero
204	foreach comp [array names _comp2dims] {
205	switch -- $_comp2dims($comp) {
206	1D {
207	switch -- $which {
208	x - xlin { set pos 0; set log 0; set axis xaxis }
209	xlog { set pos 0; set log 1; set axis xaxis }
210	y - ylin - v - vlin { set pos 1; set log 0; set axis yaxis }
211	ylog - vlog { set pos 1; set log 1; set axis yaxis }
212	default {
213	error "bad option \"$which\": should be x, xlin, xlog, y, ylin, ylog, v, vlin, vlog"
214	}
215	}
216
217	set vname [lindex $_comp2xy($comp) $pos]
218	$vname variable vec
219
220	if {$log} {
221	# on a log scale, use abs value and ignore 0's
222	$vname dup tmp
223	$vname dup zero
224	zero expr {tmp == 0} ;# find the 0's
225	tmp expr {abs(tmp)} ;# get the abs value
226	tmp expr {tmp + zero*max(tmp)} ;# replace 0's with abs max
227	set vmin [blt::vector expr min(tmp)]
228	set vmax [blt::vector expr max(tmp)]
229	} else {
230	set vmin $vec(min)
231	set vmax $vec(max)
232	}
233
234	if {"" == $min} {
235	set min $vmin
236	} elseif {$vmin < $min} {
237	set min $vmin
238	}
239	if {"" == $max} {
240	set max $vmax
241	} elseif {$vmax > $max} {
242	set max $vmax
243	}
244	}
245	2D - 3D {
246	if {[info exists _comp2vkt($comp)]} {
247	foreach {xv yv} $_comp2vtk($comp) break
248	switch -- $which {
249	x - xlin - xlog {
250	foreach {vmin vmax} [$xv limits x] break
251	set axis xaxis
252	}
253	y - ylin - ylog {
254	foreach {vmin vmax} [$xv limits y] break
255	set axis yaxis
256	}
257	z - zlin - zlog {
258	foreach {vmin vmax} [$xv limits z] break
259	set axis zaxis
260	}
261	v - vlin - vlog {
262	catch {unset style}
263	array set style $_comp2style($comp)
264	if {[info exists style(-min)] && [info exists style(-max)]} {
265	# This component has its own hard-coded
266	# min/max range. Ignore it for overall limits.
267	set vmin $min
268	set vmax $max
269	} else {
270	foreach {vmin vmax} [$yv GetRange] break
271	}
272	set axis vaxis
273	}
274	default {
275	error "bad option \"$which\": should be x, xlin, xlog, y, ylin, ylog, v, vlin, vlog"
276	}
277	}
278	} else {
279	set vmin 0 ;# HACK ALERT! must be OpenDX data
280	set vmax 1
281	set axis vaxis
282	}
283	}
284	}
285	if {"" == $min} {
286	set min $vmin
287	} elseif {$vmin < $min} {
288	set min $vmin
289	}
290	if {"" == $max} {
291	set max $vmax
292	} elseif {$vmax > $max} {
293	set max $vmax
294	}
295	}
296	blt::vector destroy tmp zero
297
298	set val [$_field get $axis.min]
299	if {"" != $val && "" != $min} {
300	if {$val > $min} {
301	# tool specified this min -- don't go any lower
302	set min $val
303	}
304	}
305
306	set val [$_field get $axis.max]
307	if {"" != $val && "" != $max} {
308	if {$val < $max} {
309	# tool specified this max -- don't go any higher
310	set max $val
311	}
312	}
313
314	return [list $min $max]
315	}
316
317	# ----------------------------------------------------------------------
318	# USAGE: controls get ?<name>?
319	# USAGE: controls put <path> <value>
320	#
321	# Returns a list {path1 x1 y1 val1 path2 x2 y2 val2 ...} representing
322	# control points for the specified field component <name>.
323	# ----------------------------------------------------------------------
324	itcl::body Rappture::Field::controls {option args} {
325	switch -- $option {
326	get {
327	set what [lindex $args 0]
328	if {[info exists _comp2cntls($what)]} {
329	return $_comp2cntls($what)
330	}
331	return ""
332	}
333	put {
334	set path [lindex $args 0]
335	set value [lindex $args 1]
336	$_xmlobj put $path.current $value
337	_build
338	}
339	default {
340	error "bad option \"$option\": should be get or put"
341	}
342	}
343	}
344
345	# ----------------------------------------------------------------------
346	# USAGE: hints ?<keyword>?
347	#
348	# Returns a list of key/value pairs for various hints about plotting
349	# this field. If a particular <keyword> is specified, then it returns
350	# the hint for that <keyword>, if it exists.
351	# ----------------------------------------------------------------------
352	itcl::body Rappture::Field::hints {{keyword ""}} {
353	foreach {key path} {
354	group about.group
355	label about.label
356	color about.color
357	style about.style
358	scale about.scale
359	units units
360	updir updir
361	} {
362	set str [$_field get $path]
363	if {"" != $str} {
364	set hints($key) $str
365	}
366	}
367
368	# to be compatible with curve objects
369	set hints(xlabel) "Position"
370
371	if {[info exists hints(group)] && [info exists hints(label)]} {
372	# pop-up help for each curve
373	set hints(tooltip) $hints(label)
374	}
375
376	if {$keyword != ""} {
377	if {[info exists hints($keyword)]} {
378	return $hints($keyword)
379	}
380	return ""
381	}
382	return [array get hints]
383	}
384
385	# ----------------------------------------------------------------------
386	# USAGE: _build
387	#
388	# Used internally to build up the vector representation for the
389	# field when the object is first constructed, or whenever the field
390	# data changes. Discards any existing vectors and builds everything
391	# from scratch.
392	# ----------------------------------------------------------------------
393	itcl::body Rappture::Field::_build {} {
394	# discard any existing data
395	foreach name [array names _comp2xy] {
396	eval blt::vector destroy $_comp2xy($name)
397	}
398	foreach name [array names _comp2vtk] {
399	set mobj [lindex $_comp2vtk($name) 0]
400	set class [$mobj info class]
401	${class}::release $mobj
402
403	set fobj [lindex $_comp2vtk($name) 1]
404	rename $fobj ""
405	}
406	catch {unset _comp2xy}
407	catch {unset _comp2vtk}
408	catch {unset _comp2dx}
409	catch {unset _comp2dims}
410	catch {unset _comp2style}
411
412	#
413	# Scan through the components of the field and create
414	# vectors for each part.
415	#
416	foreach cname [$_field children -type component] {
417	set type ""
418	if {( [$_field element $cname.constant] != ""
419	&& [$_field element $cname.domain] != "" )
420	\|\| [$_field element $cname.xy] != ""} {
421	set type "1D"
422	} elseif {[$_field element $cname.mesh] != ""
423	&& [$_field element $cname.values] != ""} {
424	set type "points-on-mesh"
425	} elseif {[$_field element $cname.vtk] != ""} {
426	set type "vtk"
427	} elseif {[$_field element $cname.dx] != ""} {
428	set type "dx"
429	}
430
431	set _comp2style($cname) ""
432
433	if {$type == "1D"} {
434	#
435	# 1D data can be represented as 2 BLT vectors,
436	# one for x and the other for y.
437	#
438	set xv ""
439	set yv ""
440
441	set val [$_field get $cname.constant]
442	if {$val != ""} {
443	set domain [$_field get $cname.domain]
444	if {$domain == "" \|\| ![info exists _limits($domain)]} {
445	set z0 0
446	set z1 $_zmax
447	} else {
448	foreach {z0 z1} $_limits($domain) { break }
449	}
450	set xv [blt::vector create x$_counter]
451	$xv append $z0 $z1
452
453	foreach {val pcomp} [_getValue $val] break
454	set yv [blt::vector create y$_counter]
455	$yv append $val $val
456
457	if {$pcomp != ""} {
458	set zm [expr {0.5*($z0+$z1)}]
459	set _comp2cntls($cname) \
460	[list $pcomp $zm $val "$val$_units"]
461	}
462	} else {
463	set xydata [$_field get $cname.xy]
464	if {"" != $xydata} {
465	set xv [blt::vector create x$_counter]
466	set yv [blt::vector create y$_counter]
467
468	foreach line [split $xydata \n] {
469	if {[scan $line {%g %g} xval yval] == 2} {
470	$xv append $xval
471	$yv append $yval
472	}
473	}
474	}
475	}
476
477	if {$xv != "" && $yv != ""} {
478	# sort x-coords in increasing order
479	$xv sort $yv
480
481	set _comp2dims($cname) "1D"
482	set _comp2xy($cname) [list $xv $yv]
483	incr _counter
484	}
485	} elseif {$type == "points-on-mesh"} {
486	#
487	# More complex 2D/3D data is represented by a mesh
488	# object and an associated vtkFloatArray for field
489	# values.
490	#
491	set path [$_field get $cname.mesh]
492	if {[$_xmlobj element $path] != ""} {
493	switch -- [$_xmlobj element -as type $path] {
494	cloud {
495	set mobj [Rappture::Cloud::fetch $_xmlobj $path]
496	}
497	mesh {
498	set mobj [Rappture::Mesh::fetch $_xmlobj $path]
499	}
500	}
501
502	if {[$mobj dimensions] > 1} {
503	#
504	# 2D/3D data
505	# Store cloud/field as components
506	#
507	set values [$_field get $cname.values]
508	set farray [vtkFloatArray ::vals$_counter]
509
510	foreach v $values {
511	if {"" != $_units} {
512	set v [Rappture::Units::convert $v \
513	-context $_units -to $_units -units off]
514	}
515	$farray InsertNextValue $v
516	}
517
518	set _comp2dims($cname) "[$mobj dimensions]D"
519	set _comp2vtk($cname) [list $mobj $farray]
520	set _comp2style($cname) [$_field get $cname.style]
521	incr _counter
522	} else {
523	#
524	# OOPS! This is 1D data
525	# Forget the cloud/field -- store BLT vectors
526	#
527	set xv [blt::vector create x$_counter]
528	set yv [blt::vector create y$_counter]
529
530	set vtkpts [$mobj points]
531	set max [$vtkpts GetNumberOfPoints]
532	for {set i 0} {$i < $max} {incr i} {
533	set xval [lindex [$vtkpts GetPoint $i] 0]
534	$xv append $xval
535	}
536	set class [$mobj info class]
537	${class}::release $mobj
538
539	set values [$_field get $cname.values]
540	foreach yval $values {
541	if {"" != $_units} {
542	set yval [Rappture::Units::convert $yval \
543	-context $_units -to $_units -units off]
544	}
545	$yv append $yval
546	}
547
548	# sort x-coords in increasing order
549	$xv sort $yv
550
551	set _comp2dims($cname) "1D"
552	set _comp2xy($cname) [list $xv $yv]
553	incr _counter
554	}
555	} else {
556	puts "WARNING: can't find mesh $path for field component"
557	}
558	} elseif {$type == "vtk"} {
559	#
560	# Extract native vtk data from the XML and use a reader
561	# to load it.
562	#
563	vtkRectilinearGridReader $this-gr
564	$this-gr SetInputString [$_field get $cname.vtk]
565
566
567	set _comp2dims($cname) "[$mobj dimensions]D"
568	set _comp2vtk($cname) [list $mobj $farray]
569	set _comp2style($cname) [$_field get $cname.style]
570	incr _counter
571	} elseif {$type == "dx"} {
572	#
573	# HACK ALERT! Extract gzipped, base64-encoded OpenDX
574	# data. Assume that it's 3D. Pass it straight
575	# off to the NanoVis visualizer.
576	#
577	set _comp2dims($cname) "3D"
578	set _comp2dx($cname) [$_field get $cname.dx]
579	set _comp2style($cname) [$_field get $cname.style]
580	incr _counter
581	}
582	}
583	}
584
585	# ----------------------------------------------------------------------
586	# USAGE: _getValue <expr>
587	#
588	# Used internally to get the value for an expression <expr>. Returns
589	# a list of the form {val parameterPath}, where val is the numeric
590	# value of the expression, and parameterPath is the XML path to the
591	# parameter representing the value, or "" if the <expr> does not
592	# depend on any parameters.
593	# ----------------------------------------------------------------------
594	itcl::body Rappture::Field::_getValue {expr} {
595	#
596	# First, look for the expression among the <parameter>'s
597	# associated with the device.
598	#
599	set found 0
600	foreach pcomp [$_xmlobj children parameters] {
601	set id [$_xmlobj element -as id parameters.$pcomp]
602	if {[string equal $id $expr]} {
603	set val [$_xmlobj get parameters.$pcomp.current]
604	if {"" == $val} {
605	set val [$_xmlobj get parameters.$pcomp.default]
606	}
607	if {"" != $val} {
608	set expr $val
609	set found 1
610	break
611	}
612	}
613	}
614	if {$found} {
615	set pcomp "parameters.$pcomp"
616	} else {
617	set pcomp ""
618	}
619
620	if {$_units != ""} {
621	set expr [Rappture::Units::convert $expr \
622	-context $_units -to $_units -units off]
623	}
624
625	return [list $expr $pcomp]
626	}

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

Download in other formats: