Context Navigation

source: branches/blt4/gui/scripts/field.tcl @ 3029

Last change on this file since 3029 was 3029, checked in by gah, 12 years ago

File size: 42.1 KB

Line
1
2	# ----------------------------------------------------------------------
3	# COMPONENT: field - extracts data from an XML description of a field
4	#
5	# This object represents one field in an XML description of a device.
6	# It simplifies the process of extracting data vectors that represent
7	# the field.
8	# ======================================================================
9	# AUTHOR: Michael McLennan, Purdue University
10	# Copyright (c) 2004-2005 Purdue Research Foundation
11	#
12	# See the file "license.terms" for information on usage and
13	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14	# ======================================================================
15	package require Itcl
16	package require BLT
17
18	namespace eval Rappture { # forward declaration }
19
20	itcl::class Rappture::Field {
21	constructor {xmlobj path} { # defined below }
22	destructor { # defined below }
23
24	public method blob {{what -overall}}
25	public method components {args}
26	public method controls {option args}
27	public method extents {{what -overall}}
28	public method flowhints { cname }
29	public method hints {{key ""}}
30	public method isunirect2d {}
31	public method isunirect3d {}
32	public method limits {axis}
33	public method mesh {{what -overall}}
34	public method style { cname }
35	public method typeof { cname }
36	public method values {{what -overall}}
37	public method viewer {}
38	public method vtkdata {{what -overall}}
39
40	protected method _build {}
41	protected method _getValue {expr}
42
43	private variable _xmlobj "" ; # ref to XML obj with device data
44	private variable _path ""; # Path of this object in the XML
45	private variable _units "" ; # system of units for this field
46	private variable _limits ;# maps box name => {z0 z1} limits
47	private variable _zmax 0 ;# length of the device
48
49	private variable _field "" ;# lib obj representing this field
50	private variable _comp2dims ;# maps component name => dimensionality
51	private variable _comp2xy ;# maps component name => x,y vectors
52	private variable _comp2vtk ;# maps component name => vtkFloatArray
53	private variable _comp2vtkstreamlines ;# maps component name => vtkFloatArray
54	private variable _comp2vtkcontour ;# maps component name => vtkFloatArray
55	private variable _comp2vtkvolume ;# maps component name => vtkFloatArray
56	private variable _comp2volume ;# maps component name => vtkFloatArray
57	private variable _comp2dx ;# maps component name => OpenDX data
58	private variable _comp2unirect2d ;# maps component name => unirect2d obj
59	private variable _comp2unirect3d ;# maps component name => unirect3d obj
60	private variable _comp2style ;# maps component name => style settings
61	private variable _comp2cntls ;# maps component name => x,y control points
62	private variable _comp2extents
63	private variable _comp2limits
64	private variable _type ""
65	private variable _comp2flowhints
66	private common _counter 0 ;# counter for unique vector names
67
68	private method ConvertToVtkData { cname }
69	private method ReadVtkDataSet { cname contents }
70	private variable _fields {}
71	}
72
73	# ----------------------------------------------------------------------
74	# CONSTRUCTOR
75	# ----------------------------------------------------------------------
76	itcl::body Rappture::Field::constructor {xmlobj path} {
77	if {![Rappture::library isvalid $xmlobj]} {
78	error "bad value \"$xmlobj\": should be Rappture::library"
79	}
80	set _xmlobj $xmlobj
81	set _path $path
82	set _field [$xmlobj element -as object $path]
83	set _units [$_field get units]
84
85	set xunits [$xmlobj get units]
86	if {"" == $xunits \|\| "arbitrary" == $xunits} {
87	set xunits "um"
88	}
89
90	# determine the overall size of the device
91	set z0 [set z1 0]
92	foreach elem [$_xmlobj children components] {
93	switch -glob -- $elem {
94	box* {
95	if {![regexp {[0-9]$} $elem]} {
96	set elem "${elem}0"
97	}
98	set z0 [$_xmlobj get components.$elem.corner0]
99	set z0 [Rappture::Units::convert $z0 \
100	-context $xunits -to $xunits -units off]
101
102	set z1 [$_xmlobj get components.$elem.corner1]
103	set z1 [Rappture::Units::convert $z1 \
104	-context $xunits -to $xunits -units off]
105
106	set _limits($elem) [list $z0 $z1]
107	}
108	}
109	}
110	set _zmax $z1
111
112	# build up vectors for various components of the field
113	_build
114	}
115
116	# ----------------------------------------------------------------------
117	# DESTRUCTOR
118	# ----------------------------------------------------------------------
119	itcl::body Rappture::Field::destructor {} {
120	itcl::delete object $_field
121	# don't destroy the _xmlobj! we don't own it!
122
123	foreach name [array names _comp2xy] {
124	eval blt::vector destroy $_comp2xy($name)
125	}
126	foreach name [array names _comp2vtk] {
127	set mobj [lindex $_comp2vtk($name) 0]
128	set class [$mobj info class]
129	${class}::release $mobj
130
131	set fobj [lindex $_comp2vtk($name) 1]
132	rename $fobj ""
133	}
134	foreach name [array names _comp2unirect2d] {
135	itcl::delete object $_comp2unirect2d($name)
136	}
137	foreach name [array names _comp2unirect3d] {
138	itcl::delete object $_comp2unirect3d($name)
139	}
140	foreach name [array names _comp2flowhints] {
141	itcl::delete object $_comp2flowhints($name)
142	}
143	}
144
145	# ----------------------------------------------------------------------
146	# USAGE: components ?-name\|-dimensions\|-style? ?<pattern>?
147	#
148	# Returns a list of names or types for the various components of
149	# this field. If the optional glob-style <pattern> is specified,
150	# then it returns only the components with names matching the pattern.
151	# ----------------------------------------------------------------------
152	itcl::body Rappture::Field::components {args} {
153	Rappture::getopts args params {
154	flag what -name default
155	flag what -dimensions
156	flag what -style
157	flag what -particles
158	flag what -flow
159	flag what -box
160	}
161
162	set pattern *
163	if {[llength $args] > 0} {
164	set pattern [lindex $args 0]
165	set args [lrange $args 1 end]
166	}
167	if {[llength $args] > 0} {
168	error "wrong # args: should be \"components ?switches? ?pattern?\""
169	}
170
171	set rlist ""
172
173	# BE CAREFUL: return component names in proper order
174	foreach cname [$_field children -type component] {
175	if {[info exists _comp2dims($cname)]
176	&& [string match $pattern $cname]} {
177
178	switch -- $params(what) {
179	-name { lappend rlist $cname }
180	-dimensions { lappend rlist $_comp2dims($cname) }
181	-style { lappend rlist $_comp2style($cname) }
182	}
183	}
184	}
185	return $rlist
186	}
187
188	# ----------------------------------------------------------------------
189	# USAGE: mesh ?<name>?
190	#
191	# Returns a list {xvec yvec} for the specified field component <name>.
192	# If the name is not specified, then it returns the vectors for the
193	# overall field (sum of all components).
194	# ----------------------------------------------------------------------
195	itcl::body Rappture::Field::mesh {{what -overall}} {
196	if {$what == "-overall" \|\| $what == "component0"} {
197	set what [lindex [components -name] 0]
198	}
199	if {[info exists _comp2xy($what)]} {
200	return [lindex $_comp2xy($what) 0] ;# return xv
201	}
202	if { [info exists _comp2vtkstreamlines($what)] } {
203	error "mesh: not implemented for streamlines"
204	return [$mobj mesh]
205	}
206	if { [info exists _comp2vtkcontour($what)] } {
207	error "method \"mesh\" is not implemented for vtkcontour"
208	}
209	if { [info exists _comp2vtk($what)] } {
210	set mobj [lindex $_comp2vtk($what) 0]
211	return [$mobj mesh]
212	}
213	if {[info exists _comp2dx($what)]} {
214	return "" ;# no mesh -- it's embedded in the value data
215	}
216	if {[info exists _comp2vtkvolume($what)]} {
217	return "" ;# no mesh -- it's embedded in the value data
218	}
219	if {[info exists _comp2unirect2d($what)]} {
220	set mobj [lindex $_comp2unirect2d($what) 0]
221	return [$mobj mesh]
222	}
223	if {[info exists _comp2unirect3d($what)]} {
224	set mobj [lindex $_comp2unirect3d($what) 0]
225	return [$mobj mesh]
226	}
227	error "bad option \"$what\": should be [join [lsort [array names _comp2dims]] {, }]"
228	}
229
230	# ----------------------------------------------------------------------
231	# USAGE: values ?<name>?
232	#
233	# Returns a list {xvec yvec} for the specified field component <name>.
234	# If the name is not specified, then it returns the vectors for the
235	# overall field (sum of all components).
236	# ----------------------------------------------------------------------
237	itcl::body Rappture::Field::values {{what -overall}} {
238	if {$what == "component0"} {
239	set what "component"
240	}
241	if {[info exists _comp2xy($what)]} {
242	return [lindex $_comp2xy($what) 1] ;# return yv
243	}
244	if { [info exists _comp2vtkcontour($what)] } {
245	error "method \"values\" is not implemented for vtkcontour"
246	}
247	if { [info exists _comp2vtkstreamlines($what)] } {
248	# FIXME: Need to process the vtk file data to pull out the field's
249	# values.
250	error "vtkstreamlines: values not implements"
251	return [lindex $_comp2vtkstreamlines($what) 1]
252	}
253	if { [info exists _comp2vtk($what)] } {
254	return [lindex $_comp2vtk($what) 1] ;# return vtkFloatArray
255	}
256	if {[info exists _comp2dx($what)]} {
257	return $_comp2dx($what) ;# return gzipped, base64-encoded DX data
258	}
259	if {[info exists _comp2unirect2d($what)]} {
260	return [$_comp2unirect2d($what) values]
261	}
262	if {[info exists _comp2unirect3d($what)]} {
263	return [$_comp2unirect3d($what) blob]
264	}
265	error "bad option \"$what\": should be [join [lsort [array names _comp2dims]] {, }]"
266	}
267
268	# ----------------------------------------------------------------------
269	# USAGE: blob ?<name>?
270	#
271	# Returns a string representing the blob of data for the mesh and values.
272	# ----------------------------------------------------------------------
273	itcl::body Rappture::Field::blob {{what -overall}} {
274	if {$what == "component0"} {
275	set what "component"
276	}
277	if {[info exists _comp2xy($what)]} {
278	return ""
279	}
280	if { [info exists _comp2vtk($what)] } {
281	return ""
282	}
283	if { [info exists _comp2vtkvolume($what)] } {
284	return $_comp2vtkvolume($what)
285	}
286	if { [info exists _comp2vtkcontour($what)] } {
287	return $_comp2vtkcontour($what)
288	}
289	if { [info exists _comp2vtkstreamlines($what)] } {
290	# Return the contents of the vtk file.
291	return $_comp2vtkstreamlines($what)
292	}
293	if {[info exists _comp2dx($what)]} {
294	return $_comp2dx($what) ;# return gzipped, base64-encoded DX data
295	}
296	if {[info exists _comp2unirect2d($what)]} {
297	return [$_comp2unirect2d($what) blob]
298	}
299	if {[info exists _comp2unirect3d($what)]} {
300	return [$_comp2unirect3d($what) blob]
301	}
302	error "bad option \"$what\": should be [join [lsort [array names _comp2dims]] {, }]"
303	}
304
305
306	# ----------------------------------------------------------------------
307	# USAGE: limits <axis>
308	#
309	# Returns a list {min max} representing the limits for the specified
310	# axis.
311	# ----------------------------------------------------------------------
312	itcl::body Rappture::Field::limits {which} {
313	set min ""
314	set max ""
315
316	blt::vector tmp zero
317	foreach comp [array names _comp2dims] {
318	switch -- $_comp2dims($comp) {
319	1D {
320	switch -- $which {
321	x - xlin { set pos 0; set log 0; set axis xaxis }
322	xlog { set pos 0; set log 1; set axis xaxis }
323	y - ylin - v - vlin { set pos 1; set log 0; set axis yaxis }
324	ylog - vlog { set pos 1; set log 1; set axis yaxis }
325	default {
326	error "bad option \"$which\": should be x, xlin, xlog, y, ylin, ylog, v, vlin, vlog"
327	}
328	}
329
330	set vname [lindex $_comp2xy($comp) $pos]
331	$vname variable vec
332
333	if {$log} {
334	# on a log scale, use abs value and ignore 0's
335	$vname dup tmp
336	$vname dup zero
337	zero expr {tmp == 0} ;# find the 0's
338	tmp expr {abs(tmp)} ;# get the abs value
339	tmp expr {tmp + zero*max(tmp)} ;# replace 0's with abs max
340	set vmin [blt::vector expr min(tmp)]
341	set vmax [blt::vector expr max(tmp)]
342	} else {
343	set vmin $vec(min)
344	set vmax $vec(max)
345	}
346
347	if {"" == $min} {
348	set min $vmin
349	} elseif {$vmin < $min} {
350	set min $vmin
351	}
352	if {"" == $max} {
353	set max $vmax
354	} elseif {$vmax > $max} {
355	set max $vmax
356	}
357	}
358	2D - 3D {
359	if {[info exists _comp2unirect2d($comp)]} {
360	set limits [$_comp2unirect2d($comp) limits $which]
361	foreach {vmin vmax} $limits break
362	set axis vaxis
363	} elseif {[info exists _comp2unirect3d($comp)]} {
364	set limits [$_comp2unirect3d($comp) limits $which]
365	foreach {vmin vmax} $limits break
366	set axis vaxis
367	} elseif {[info exists _comp2vtk($comp)]} {
368	foreach {xv yv} $_comp2vtk($comp) break
369	switch -- $which {
370	x - xlin - xlog {
371	foreach {vmin vmax} [$xv limits x] break
372	set axis xaxis
373	}
374	y - ylin - ylog {
375	foreach {vmin vmax} [$xv limits y] break
376	set axis yaxis
377	}
378	z - zlin - zlog {
379	foreach {vmin vmax} [$xv limits z] break
380	set axis zaxis
381	}
382	v - vlin - vlog {
383	catch {unset style}
384	array set style $_comp2style($comp)
385	if {[info exists style(-min)] && [info exists style(-max)]} {
386	# This component has its own hard-coded
387	# min/max range. Ignore it for overall limits.
388	set vmin $min
389	set vmax $max
390	} else {
391	foreach {vmin vmax} [$yv GetRange] break
392	}
393	set axis vaxis
394	}
395	default {
396	error "bad option \"$which\": should be x, xlin, xlog, y, ylin, ylog, v, vlin, vlog"
397	}
398	}
399	} else {
400	set vmin 0 ;# HACK ALERT! must be OpenDX data
401	set vmax 1
402	set axis vaxis
403	}
404	}
405	}
406	if {"" == $min} {
407	set min $vmin
408	} elseif {$vmin < $min} {
409	set min $vmin
410	}
411	if {"" == $max} {
412	set max $vmax
413	} elseif {$vmax > $max} {
414	set max $vmax
415	}
416	}
417	blt::vector destroy tmp zero
418
419	set val [$_field get $axis.min]
420	if {"" != $val && "" != $min} {
421	if {$val > $min} {
422	# tool specified this min -- don't go any lower
423	set min $val
424	}
425	}
426
427	set val [$_field get $axis.max]
428	if {"" != $val && "" != $max} {
429	if {$val < $max} {
430	# tool specified this max -- don't go any higher
431	set max $val
432	}
433	}
434	return [list $min $max]
435	}
436
437	# ----------------------------------------------------------------------
438	# USAGE: controls get ?<name>?
439	# USAGE: controls validate <path> <value>
440	# USAGE: controls put <path> <value>
441	#
442	# Returns a list {path1 x1 y1 val1 path2 x2 y2 val2 ...} representing
443	# control points for the specified field component <name>.
444	# ----------------------------------------------------------------------
445	itcl::body Rappture::Field::controls {option args} {
446	switch -- $option {
447	get {
448	set what [lindex $args 0]
449	if {[info exists _comp2cntls($what)]} {
450	return $_comp2cntls($what)
451	}
452	return ""
453	}
454	validate {
455	set path [lindex $args 0]
456	set value [lindex $args 1]
457	set units [$_xmlobj get $path.units]
458
459	if {"" != $units} {
460	set nv [Rappture::Units::convert \
461	$value -context $units -to $units -units off]
462	} else {
463	set nv $value
464	}
465	if {![string is double $nv]
466	\|\| [regexp -nocase {^(inf\|nan)$} $nv]} {
467	error "Value out of range"
468	}
469
470	set rawmin [$_xmlobj get $path.min]
471	if {"" != $rawmin} {
472	set minv $rawmin
473	if {"" != $units} {
474	set minv [Rappture::Units::convert \
475	$minv -context $units -to $units -units off]
476	set nv [Rappture::Units::convert \
477	$value -context $units -to $units -units off]
478	}
479	# fix for the case when the user tries to
480	# compare values like minv=-500 nv=-0600
481	set nv [format "%g" $nv]
482	set minv [format "%g" $minv]
483
484	if {$nv < $minv} {
485	error "Minimum value allowed here is $rawmin"
486	}
487	}
488
489	set rawmax [$_xmlobj get $path.max]
490	if {"" != $rawmax} {
491	set maxv $rawmax
492	if {"" != $units} {
493	set maxv [Rappture::Units::convert \
494	$maxv -context $units -to $units -units off]
495	set nv [Rappture::Units::convert \
496	$value -context $units -to $units -units off]
497	}
498	# fix for the case when the user tries to
499	# compare values like maxv=-500 nv=-0600
500	set nv [format "%g" $nv]
501	set maxv [format "%g" $maxv]
502
503	if {$nv > $maxv} {
504	error "Maximum value allowed here is $rawmax"
505	}
506	}
507
508	return "ok"
509	}
510	put {
511	set path [lindex $args 0]
512	set value [lindex $args 1]
513	$_xmlobj put $path.current $value
514	_build
515	}
516	default {
517	error "bad option \"$option\": should be get or put"
518	}
519	}
520	}
521
522	# ----------------------------------------------------------------------
523	# USAGE: hints ?<keyword>?
524	#
525	# Returns a list of key/value pairs for various hints about plotting
526	# this field. If a particular <keyword> is specified, then it returns
527	# the hint for that <keyword>, if it exists.
528	# ----------------------------------------------------------------------
529	itcl::body Rappture::Field::hints {{keyword ""}} {
530	foreach {key path} {
531	camera camera.position
532	color about.color
533	default about.default
534	group about.group
535	label about.label
536	scalars about.scalars
537	scale about.scale
538	seeds about.seeds
539	style about.style
540	toolId tool.id
541	toolName tool.name
542	toolRevision tool.version.application.revision
543	type about.type
544	units units
545	updir updir
546	vectors about.vectors
547	} {
548	set str [$_field get $path]
549	if {"" != $str} {
550	set hints($key) $str
551	}
552	}
553	# Set tool and path hints
554	set hints(tool) [$_xmlobj get tool.name]
555	set hints(path) $_path
556	if 0 {
557	# to be compatible with curve objects
558	set hints(xlabel) "Position"
559	}
560	if {[info exists hints(group)] && [info exists hints(label)]} {
561	# pop-up help for each curve
562	set hints(tooltip) $hints(label)
563	}
564
565	if {$keyword != ""} {
566	if {[info exists hints($keyword)]} {
567	return $hints($keyword)
568	}
569	return ""
570	}
571	return [array get hints]
572	}
573
574	# ----------------------------------------------------------------------
575	# USAGE: _build
576	#
577	# Used internally to build up the vector representation for the
578	# field when the object is first constructed, or whenever the field
579	# data changes. Discards any existing vectors and builds everything
580	# from scratch.
581	# ----------------------------------------------------------------------
582	itcl::body Rappture::Field::_build {} {
583	# discard any existing data
584	foreach name [array names _comp2xy] {
585	eval blt::vector destroy $_comp2xy($name)
586	}
587	foreach name [array names _comp2vtk] {
588	set mobj [lindex $_comp2vtk($name) 0]
589	set class [$mobj info class]
590	${class}::release $mobj
591
592	set fobj [lindex $_comp2vtk($name) 1]
593	rename $fobj ""
594	}
595	foreach name [array names _comp2unirect2d] {
596	eval itcl::delete object $_comp2unirect2d($name)
597	}
598	foreach name [array names _comp2unirect3d] {
599	eval itcl::delete object $_comp2unirect3d($name)
600	}
601	catch {unset _comp2xy}
602	catch {unset _comp2vtk}
603	catch {unset _comp2dx}
604	catch {unset _comp2dims}
605	catch {unset _comp2style}
606	array unset _comp2volume
607	array unset _comp2vtkstreamlines
608	array unset _comp2vtkcontour
609	array unset _comp2unirect2d
610	array unset _comp2unirect3d
611	array unset _comp2extents
612	array unset _dataobj2type
613	#
614	# Scan through the components of the field and create
615	# vectors for each part.
616	#
617	foreach cname [$_field children -type component] {
618	set type ""
619	if { ([$_field element $cname.constant] != "" &&
620	[$_field element $cname.domain] != "") \|\|
621	[$_field element $cname.xy] != ""} {
622	set type "1D"
623	} elseif {[$_field element $cname.mesh] != "" &&
624	[$_field element $cname.values] != ""} {
625	set type "points-on-mesh"
626	} elseif {[$_field element $cname.vtk] != ""} {
627	if { [$_field get "about.view"] == "streamlines" } {
628	set type "vtkstreamlines"
629	} elseif { [$_field get "about.view"] == "contour" } {
630	set type "vtkcontour"
631	} else {
632	set type "vtk"
633	}
634	} elseif {[$_field element $cname.opendx] != ""} {
635	global env
636	if { [info exists env(VTKVOLUME)] } {
637	set type "vtkvolume"
638	} else {
639	set type "dx"
640	}
641	} elseif {[$_field element $cname.dx] != ""} {
642	global env
643	if { [info exists env(VTKVOLUME)] } {
644	set type "vtkvolume"
645	} else {
646	set type "dx"
647	}
648	}
649	set _comp2style($cname) ""
650
651	# Save the extents of the component
652	if { [$_field element $cname.extents] != "" } {
653	set extents [$_field get $cname.extents]
654	} else {
655	set extents 1
656	}
657	set _comp2extents($cname) $extents
658	set _type $type
659	if {$type == "1D"} {
660	#
661	# 1D data can be represented as 2 BLT vectors,
662	# one for x and the other for y.
663	#
664	set xv ""
665	set yv ""
666
667	set val [$_field get $cname.constant]
668	if {$val != ""} {
669	set domain [$_field get $cname.domain]
670	if {$domain == "" \|\| ![info exists _limits($domain)]} {
671	set z0 0
672	set z1 $_zmax
673	} else {
674	foreach {z0 z1} $_limits($domain) { break }
675	}
676	set xv [blt::vector create x$_counter]
677	$xv append $z0 $z1
678
679	foreach {val pcomp} [_getValue $val] break
680	set yv [blt::vector create y$_counter]
681	$yv append $val $val
682
683	if {$pcomp != ""} {
684	set zm [expr {0.5*($z0+$z1)}]
685	set _comp2cntls($cname) \
686	[list $pcomp $zm $val "$val$_units"]
687	}
688	} else {
689	set xydata [$_field get $cname.xy]
690	if {"" != $xydata} {
691	set xv [blt::vector create x$_counter]
692	set yv [blt::vector create y$_counter]
693	set tmp [blt::vector create \#auto]
694	$tmp set $xydata
695	$tmp split $xv $yv
696	blt::vector destroy $tmp
697	}
698	}
699
700	if {$xv != "" && $yv != ""} {
701	# sort x-coords in increasing order
702	$xv sort $yv
703
704	set _comp2dims($cname) "1D"
705	set _comp2xy($cname) [list $xv $yv]
706	incr _counter
707	}
708	} elseif {$type == "points-on-mesh"} {
709	#
710	# More complex 2D/3D data is represented by a mesh
711	# object and an associated vtkFloatArray for field
712	# values.
713	#
714	set path [$_field get $cname.mesh]
715	if {[$_xmlobj element $path] != ""} {
716	set element [$_xmlobj element -as type $path]
717	if { $element == "unirect2d" } {
718	set _comp2dims($cname) "2D"
719	set _comp2unirect2d($cname) \
720	[Rappture::Unirect2d \#auto $_xmlobj $_field $cname \
721	$extents]
722	set _comp2style($cname) [$_field get $cname.style]
723	if {[$_field element $cname.flow] != ""} {
724	set _comp2flowhints($cname) \
725	[Rappture::FlowHints ::\#auto $_field $cname $_units]
726	}
727	incr _counter
728	} elseif { $element == "unirect3d" } {
729	set _comp2dims($cname) "3D"
730	set _comp2unirect3d($cname) \
731	[Rappture::Unirect3d \#auto $_xmlobj $_field $cname \
732	$extents]
733	set _comp2style($cname) [$_field get $cname.style]
734	if {[$_field element $cname.flow] != ""} {
735	set _comp2flowhints($cname) \
736	[Rappture::FlowHints ::\#auto $_field $cname $_units]
737	}
738	incr _counter
739	} elseif { $element == "cloud" \|\| $element == "mesh" } {
740	switch -- $element {
741	cloud {
742	set mobj [Rappture::Cloud::fetch $_xmlobj $path]
743	}
744	mesh {
745	set mobj [Rappture::Mesh::fetch $_xmlobj $path]
746	}
747	}
748	if {[$mobj dimensions] > 1} {
749	#
750	# 2D/3D data
751	# Store cloud/field as components
752	#
753	set values [$_field get $cname.values]
754	set farray [vtkFloatArray ::vals$_counter]
755
756	foreach v $values {
757	if {"" != $_units} {
758	set v [Rappture::Units::convert $v \
759	-context $_units -to $_units -units off]
760	}
761	$farray InsertNextValue $v
762	}
763
764	set _comp2dims($cname) "[$mobj dimensions]D"
765	set _comp2vtk($cname) [list $mobj $farray]
766	set _comp2style($cname) [$_field get $cname.style]
767	incr _counter
768	} else {
769	#
770	# OOPS! This is 1D data
771	# Forget the cloud/field -- store BLT vectors
772	#
773	set xv [blt::vector create x$_counter]
774	set yv [blt::vector create y$_counter]
775
776	set vtkpts [$mobj points]
777	set max [$vtkpts GetNumberOfPoints]
778	for {set i 0} {$i < $max} {incr i} {
779	set xval [lindex [$vtkpts GetPoint $i] 0]
780	$xv append $xval
781	}
782	set class [$mobj info class]
783	${class}::release $mobj
784
785	set values [$_field get $cname.values]
786	foreach yval $values {
787	if {"" != $_units} {
788	set yval [Rappture::Units::convert $yval \
789	-context $_units -to $_units -units off]
790	}
791	$yv append $yval
792	}
793
794	# sort x-coords in increasing order
795	$xv sort $yv
796
797	set _comp2dims($cname) "1D"
798	set _comp2xy($cname) [list $xv $yv]
799	incr _counter
800	}
801	}
802	} else {
803	puts "WARNING: can't find mesh $path for field component"
804	}
805	} elseif {$type == "vtk"} {
806	#
807	# Extract native vtk data from the XML and use a reader
808	# to load it.
809	#
810	vtkRectilinearGridReader $this-gr
811	$this-gr SetInputString [$_field get $cname.vtk]
812
813
814	set _comp2dims($cname) "[$mobj dimensions]D"
815	set _comp2vtk($cname) [list $mobj $farray]
816	set _comp2style($cname) [$_field get $cname.style]
817	incr _counter
818	} elseif {$type == "vtkstreamlines"} {
819	set _comp2dims($cname) "3D"
820	# Allow redirects to another element.
821	set vtkdata [$_field get $cname.vtk]
822	if { ![string match "!*" $vtkdata] } {
823	set _comp2vtkstreamlines($cname) $vtkdata
824	} else {
825	set path [string range $vtkdata 1 end]
826	if { [$_xmlobj element $path] == "" } {
827	error "bad redirection path \"$path\""
828	}
829	set element [$_xmlobj element -as type $path]
830	if { $element != "vtk" } {
831	error "bad path \"$path\": must redirect to a vtk element"
832	}
833	set _comp2vtkstreamlines($cname) [$_xmlobj get $path]
834	}
835	set _comp2style($cname) [$_field get $cname.style]
836	incr _counter
837	} elseif {$type == "vtkcontour"} {
838	set _comp2dims($cname) "2D"
839	# Allow redirects to another element.
840
841	set data [$_field get $cname.vtk]
842	ReadVtkDataSet $cname $data
843	set _comp2vtkcontour($cname) $data
844	set _comp2style($cname) [$_field get $cname.style]
845	incr _counter
846	} elseif {$type == "vtkvolume"} {
847	set _comp2dims($cname) "3D"
848	# Allow redirects to another element.
849	set data [$_field get -decode no $cname.dx]
850	set data [Rappture::encoding::decode -as zb64 $data]
851	if 1 {
852	set file "/tmp/$cname.dx"
853	set f [open $file "w"]
854	puts $f $data
855	close $f
856	}
857	set data [Rappture::ConvertDxToVtk $data]
858	if 1 {
859	set file "/tmp/$cname.vtk"
860	set f [open $file "w"]
861	puts $f $data
862	close $f
863	}
864	set _comp2vtkvolume($cname) $data
865	set _comp2style($cname) [$_field get $cname.style]
866	incr _counter
867	} elseif {$type == "vtkstreamlines2"} {
868	set _comp2dims($cname) "3D"
869	set _comp2vtkstreamlines($cname) [$_field get $cname.vtk]
870	set _comp2style($cname) [$_field get $cname.style]
871	incr _counter
872	} elseif {$type == "dx" } {
873	#
874	# HACK ALERT! Extract gzipped, base64-encoded OpenDX
875	# data. Assume that it's 3D. Pass it straight
876	# off to the NanoVis visualizer.
877	#
878	set _comp2dims($cname) "3D"
879	set _comp2dx($cname) [$_field get -decode no $cname.dx]
880	if 1 {
881	set data [$_field get -decode yes $cname.dx]
882	set file "/tmp/junk.dx"
883	set f [open $file "w"]
884	puts $f $data
885	close $f
886	if { [string match "<ODX>*" $data] } {
887	set data [string range $data 5 end]
888	set _comp2dx($cname) \
889	[Rappture::encoding::encode -as zb64 $data]
890	}
891	}
892	set _comp2style($cname) [$_field get $cname.style]
893	if {[$_field element $cname.flow] != ""} {
894	set _comp2flowhints($cname) \
895	[Rappture::FlowHints ::\#auto $_field $cname $_units]
896	}
897	incr _counter
898	} elseif {$type == "opendx"} {
899	#
900	# HACK ALERT! Extract gzipped, base64-encoded OpenDX
901	# data. Assume that it's 3D. Pass it straight
902	# off to the NanoVis visualizer.
903	#
904	set _comp2dims($cname) "3D"
905	set data [$_field get -decode yes $cname.opendx]
906	set data "<ODX>$data"
907	set data [Rappture::encoding::encode -as zb64 $data]
908	set _comp2dx($cname) $data
909	set _comp2style($cname) [$_field get $cname.style]
910	if {[$_field element $cname.flow] != ""} {
911	set _comp2flowhints($cname) \
912	[Rapture::FlowHints ::\#auto $_field $cname $_units]
913	}
914	incr _counter
915	}
916	}
917	}
918
919	# ----------------------------------------------------------------------
920	# USAGE: _getValue <expr>
921	#
922	# Used internally to get the value for an expression <expr>. Returns
923	# a list of the form {val parameterPath}, where val is the numeric
924	# value of the expression, and parameterPath is the XML path to the
925	# parameter representing the value, or "" if the <expr> does not
926	# depend on any parameters.
927	# ----------------------------------------------------------------------
928	itcl::body Rappture::Field::_getValue {expr} {
929	#
930	# First, look for the expression among the <parameter>'s
931	# associated with the device.
932	#
933	set found 0
934	foreach pcomp [$_xmlobj children parameters] {
935	set id [$_xmlobj element -as id parameters.$pcomp]
936	if {[string equal $id $expr]} {
937	set val [$_xmlobj get parameters.$pcomp.current]
938	if {"" == $val} {
939	set val [$_xmlobj get parameters.$pcomp.default]
940	}
941	if {"" != $val} {
942	set expr $val
943	set found 1
944	break
945	}
946	}
947	}
948	if {$found} {
949	set pcomp "parameters.$pcomp"
950	} else {
951	set pcomp ""
952	}
953
954	if {$_units != ""} {
955	set expr [Rappture::Units::convert $expr \
956	-context $_units -to $_units -units off]
957	}
958
959	return [list $expr $pcomp]
960	}
961
962	#
963	# isunirect2d --
964	#
965	# Returns if the field is a unirect2d object.
966	#
967	itcl::body Rappture::Field::isunirect2d { } {
968	return [expr [array size _comp2unirect2d] > 0]
969	}
970
971	#
972	# isunirect3d --
973	#
974	# Returns if the field is a unirect3d object.
975	#
976	itcl::body Rappture::Field::isunirect3d { } {
977	return [expr [array size _comp2unirect3d] > 0]
978	}
979
980	#
981	# flowhints --
982	#
983	# Returns the hints associated with a flow vector field.
984	#
985	itcl::body Rappture::Field::flowhints { cname } {
986	if { [info exists _comp2flowhints($cname)] } {
987	return $_comp2flowhints($cname)
988	}
989	return ""
990	}
991
992	#
993	# style --
994	#
995	# Returns the style associated with a component of the field.
996	#
997	itcl::body Rappture::Field::style { cname } {
998	if { [info exists _comp2style($cname)] } {
999	return $_comp2style($cname)
1000	}
1001	return ""
1002	}
1003
1004	#
1005	# typeof --
1006	#
1007	# Returns the style associated with a component of the field.
1008	#
1009	itcl::body Rappture::Field::typeof { what } {
1010	if {$what == "component0"} {
1011	set what "component"
1012	}
1013	if {[info exists _comp2xy($what)]} {
1014	return "xy"
1015	}
1016	if { [info exists _comp2vtk($what)] } {
1017	return "vtk"
1018	}
1019	if { [info exists _comp2vtkstreamlines($what)] } {
1020	return "vtkstreamlines"
1021	}
1022	if { [info exists _comp2vtkcontour($what)] } {
1023	return "vtkcontour"
1024	}
1025	if { [info exists _comp2vtkvolume($what)] } {
1026	return "vtkvolume"
1027	}
1028	if {[info exists _comp2dx($what)]} {
1029	return "dx"
1030	}
1031	if {[info exists _comp2unirect2d($what)]} {
1032	return "unirect2d"
1033	}
1034	if {[info exists _comp2unirect3d($what)]} {
1035	return "unirect3d"
1036	}
1037	}
1038
1039	itcl::body Rappture::Field::viewer { } {
1040	return $_type
1041	}
1042
1043	#
1044	# extents --
1045	#
1046	# Returns if the field is a unirect2d object.
1047	#
1048	itcl::body Rappture::Field::extents {{what -overall}} {
1049	if {$what == "-overall" } {
1050	set max 0
1051	foreach cname [$_field children -type component] {
1052	if { ![info exists _comp2unirect3d($cname)] &&
1053	![info exists _comp2extents($cname)] } {
1054	continue
1055	}
1056	set value $_comp2extents($cname)
1057	if { $max < $value } {
1058	set max $value
1059	}
1060	}
1061	return $max
1062	}
1063	if { $what == "component0"} {
1064	set what [lindex [components -name] 0]
1065	}
1066	return $_comp2extents($what)
1067	}
1068
1069	# ----------------------------------------------------------------------
1070	# USAGE: blob ?<name>?
1071	#
1072	# Returns a string representing the blob of data for the mesh and values.
1073	# ----------------------------------------------------------------------
1074	itcl::body Rappture::Field::vtkdata {{what -overall}} {
1075	if {$what == "component0"} {
1076	set what "component"
1077	}
1078	if {[info exists _comp2xy($what)]} {
1079	return ""
1080	}
1081	if { [info exists _comp2vtk($what)] } {
1082	return ""
1083	}
1084	if { [info exists _comp2vtkcontour($what)] } {
1085	return [blob $what]
1086	}
1087	if { [info exists _comp2vtkstreamlines($what)] } {
1088	return $_comp2vtkstreamlines($what)
1089	}
1090	if { [info exists _comp2vtkvolume($what)] } {
1091	return $_comp2vtkvolume($what)
1092	}
1093	return [ConvertToVtkData $what]
1094	}
1095
1096	itcl::body Rappture::Field::ConvertToVtkData { comp } {
1097	set ds ""
1098	switch -- [typeof $comp] {
1099	"unirect2d" {
1100	foreach { x1 x2 xN y1 y2 yN } [$dataobj mesh $comp] break
1101	set spacingX [expr {double($x2 - $x1)/double($xN - 1)}]
1102	set spacingY [expr {double($y2 - $y1)/double($yN - 1)}]
1103
1104	set ds [vtkImageData $this-grdataTemp]
1105	$ds SetDimensions $xN $yN 1
1106	$ds SetOrigin $x1 $y1 0
1107	$ds SetSpacing $spacingX $spacingY 0
1108	set arr [vtkDoubleArray $this-arrTemp]
1109	foreach {val} [$dataobj values $comp] {
1110	$arr InsertNextValue $val
1111	}
1112	[$ds GetPointData] SetScalars $arr
1113	}
1114	"unirect3d" {
1115	foreach { x1 x2 xN y1 y2 yN z1 z2 zN } [$dataobj mesh $comp] break
1116	set spacingX [expr {double($x2 - $x1)/double($xN - 1)}]
1117	set spacingY [expr {double($y2 - $y1)/double($yN - 1)}]
1118	set spacingZ [expr {double($z2 - $z1)/double($zN - 1)}]
1119
1120	set ds [vtkImageData $this-grdataTemp]
1121	$ds SetDimensions $xN $yN $zN
1122	$ds SetOrigin $x1 $y1 $z1
1123	$ds SetSpacing $spacingX $spacingY $spacingZ
1124	set arr [vtkDoubleArray $this-arrTemp]
1125	foreach {val} [$dataobj values $comp] {
1126	$arr InsertNextValue $val
1127	}
1128	[$ds GetPointData] SetScalars $val
1129	}
1130	"vtkcontour" {
1131	return [$dataobj blob $comp]
1132	}
1133	"dx" {
1134	return [Rappture::ConvertDxToVtk $_comp2dx($what)]
1135	}
1136	default {
1137	set mesh [$dataobj mesh $comp]
1138	switch -- [$mesh GetClassName] {
1139	vtkPoints {
1140	# handle cloud of points
1141	set ds [vtkPolyData $this-polydataTemp]
1142	$ds SetPoints $mesh
1143	[$ds GetPointData] SetScalars [$dataobj values $comp]
1144	}
1145	vtkPolyData {
1146	set ds [vtkPolyData $this-polydataTemp]
1147	$ds ShallowCopy $mesh
1148	[$ds GetPointData] SetScalars [$dataobj values $comp]
1149	}
1150	vtkUnstructuredGrid {
1151	# handle 3D grid with connectivity
1152	set ds [vtkUnstructuredGrid $this-grdataTemp]
1153	$ds ShallowCopy $mesh
1154	[$ds GetPointData] SetScalars [$dataobj values $comp]
1155	}
1156	vtkRectilinearGrid {
1157	# handle 3D grid with connectivity
1158	set ds [vtkRectilinearGrid $this-grdataTemp]
1159	$ds ShallowCopy $mesh
1160	[$ds GetPointData] SetScalars [$dataobj values $comp]
1161	}
1162	default {
1163	error "don't know how to handle [$mesh GetClassName] data"
1164	}
1165	}
1166	}
1167	}
1168
1169	if {"" != $ds} {
1170	set writer [vtkDataSetWriter $this-dsWriterTmp]
1171	$writer SetInput $ds
1172	$writer SetFileTypeToASCII
1173	$writer WriteToOutputStringOn
1174	$writer Write
1175	set out [$writer GetOutputString]
1176	$ds Delete
1177	$writer Delete
1178	} else {
1179	set out ""
1180	error "No DataSet to write"
1181	}
1182
1183	append out "\n"
1184	return $out
1185	}
1186
1187	itcl::body Rappture::Field::ReadVtkDataSet { comp contents } {
1188	package require vtk
1189
1190	set reader $this-datasetreader
1191	vtkDataSetReader $reader
1192
1193	# Write the contents to a file just in case it's binary.
1194	set tmpfile file[pid].vtk
1195	set f [open "$tmpfile" "w"]
1196	fconfigure $f -translation binary -encoding binary
1197	puts $f $contents
1198	close $f
1199	$reader SetFileName $tmpfile
1200	$reader ReadAllScalarsOn
1201	$reader ReadAllVectorsOn
1202	$reader ReadAllFieldsOn
1203	$reader Update
1204	set dataset [$reader GetOutput]
1205	set limits {}
1206	foreach {xmin xmax ymin ymax zmin zmax} [$dataset GetBounds] break
1207	lappend limits xmin $xmin xmax $xmax ymin $ymin ymax $ymax
1208	set dataAttrs [$dataset GetPointData]
1209	if { $dataAttrs == ""} {
1210	puts stderr "No point data"
1211	}
1212	for {set i 0} {$i < [$dataAttrs GetNumberOfArrays] } {incr i} {
1213	set array [$dataAttrs GetArray $i]
1214	set name [$dataAttrs GetArrayName $i]
1215	foreach {min max} [$array GetRange] break
1216	lappend limits $name-min $min $name-max $max
1217	lappend _fields $name
1218	}
1219	set _comp2limits($comp) $limits
1220	puts stderr limits=$limits
1221	$reader Delete
1222	file delete $tmpfile
1223	}
1224

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

Download in other formats: