Context Navigation

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

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

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

Download in other formats: