Context Navigation

source: trunk/gui/scripts/map.tcl @ 5909

Last change on this file since 5909 was 5909, checked in by ldelgass, 9 years ago
First pass at making Rappture::Map object usable without an XML DOM tree. Add setter methods for map "hints", ctor with no arguments, addViewpoint method. Still needs methods to add layers.
File size: 21.6 KB

Line
1	# -- mode: tcl; indent-tabs-mode: nil --
2	# ----------------------------------------------------------------------
3	# COMPONENT: map - extracts data from an XML description of a field
4	#
5	# This object represents a map of data in an XML description of
6	# simulator output. A map is similar to a field, but a field is
7	# a quantity versus position in device. A map is any quantity
8	# versus any other quantity. This class simplifies the process of
9	# extracting data vectors that represent the map.
10	# ======================================================================
11	# AUTHOR: Michael McLennan, Purdue University
12	# Copyright (c) 2004-2012 HUBzero Foundation, LLC
13	#
14	# See the file "license.terms" for information on usage and
15	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
16	# ======================================================================
17	package require Itcl
18	package require BLT
19
20	namespace eval Rappture {
21	# forward declaration
22	}
23
24	itcl::class Rappture::Map {
25	constructor {args} {
26	# defined below
27	}
28	destructor {
29	# defined below
30	}
31
32	public method addViewpoint { name props }
33	public method earthfile {}
34	public method hints { args }
35	public method isGeocentric {}
36	public method isvalid {} {
37	return $_isValid;
38	}
39	public method layer { layerName }
40	public method layers {}
41	public method selectors { layerName }
42	public method selector { layerName selectorName }
43	public method setAttribution { attribution }
44	public method setCamera { camera }
45	public method setExtents { xmin ymin xmax ymax }
46	public method setLabel { label }
47	public method setProjection { projection }
48	public method setStyle { style }
49	public method setToolInfo { id name command title revision }
50	public method setType { type }
51	public method type { layerName }
52	public method viewpoint { viewpointName }
53	public method viewpoints {}
54
55	protected method Parse { xmlobj path }
56
57	private variable _tree ""; # Tree of information about the map.
58	private variable _isValid 0;
59	private common _nextLayer 0; # Counter used to generate unique
60	# layer names.
61	private common _nextSelector 0;
62	private common _nextViewpoint 0; # Counter used to generate unique
63	# viewpoint names.
64	private common _layerTypes
65	private common _mapTypes
66	array set _layerTypes {
67	"image" 0
68	"elevation" 1
69	"feature" 2
70	"polygon" 3
71	"point" 4
72	"icon" 5
73	"line" 6
74	"label" 7
75	}
76	array set _mapTypes {
77	"geocentric" 0
78	"projected" 1
79	}
80	}
81
82	# ----------------------------------------------------------------------
83	# CONSTRUCTOR
84	# ----------------------------------------------------------------------
85	itcl::body Rappture::Map::constructor {args} {
86	if {$args == ""} {
87	set _tree [blt::tree create]
88	set parent [$_tree insert root -label "layers"]
89	setLabel "Map"
90	setType "projected"
91	setProjection "global-mercator"
92	setExtents ""
93	setStyle ""
94	setCamera ""
95	set _isValid 1
96	} else {
97	set xmlobj [lindex $args 0]
98	set path [lindex $args 1]
99	if {![Rappture::library isvalid $xmlobj]} {
100	error "bad value \"$xmlobj\": should be LibraryObj"
101	}
102	Parse $xmlobj $path
103	}
104	}
105
106	# ----------------------------------------------------------------------
107	# DESTRUCTOR
108	# ----------------------------------------------------------------------
109	itcl::body Rappture::Map::destructor {} {
110	if { $_tree != "" } {
111	blt::tree destroy $_tree
112	}
113	}
114
115	itcl::body Rappture::Map::hints { args } {
116	switch -- [llength $args] {
117	0 {
118	return [$_tree get root]
119	}
120	1 {
121	set field [lindex $args 0]
122	return [$_tree get root $field ""]
123	}
124	default {
125	error "wrong # args: should \"hints ?name?\""
126	}
127	}
128	}
129
130	#
131	# Parse --
132	#
133	# Parses the map description in the XML object.
134	#
135	itcl::body Rappture::Map::Parse { xmlobj path } {
136
137	set map [$xmlobj element -as object $path]
138
139	if { $_tree != "" } {
140	blt::tree destroy $_tree
141	}
142	set _tree [blt::tree create]
143	set parent [$_tree insert root -label "layers"]
144	set layers [$map element -as object "layers"]
145	foreach layer [$layers children -type layer] {
146	# Unique identifier for layer.
147	set name "layer[incr _nextLayer]"
148	set child [$_tree insert $parent -label $name]
149	set layerType [$layers get $layer.type]
150	if { ![info exists _layerTypes($layerType)] } {
151	error "invalid layer type \"$layerType\": should be one of [array names _layerTypes]"
152	}
153	$_tree set $child "name" $layer
154	$_tree set $child "type" $layerType
155	foreach key { label description attribution profile srs verticalDatum } {
156	$_tree set $child $key [$layers get $layer.$key]
157	}
158	# Common settings (for all layer types) with defaults
159	foreach { key defval } { visible 1 cache 1 } {
160	$_tree set $child $key $defval
161	set val [$layers get $layer.$key]
162	if {$val != ""} {
163	$_tree set $child $key $val
164	}
165	}
166	# These are settings for which there should be no default
167	# We want to know if they have been set by the user or not
168	# Not all layer types use these
169	foreach key { coverage opacity content priority style } {
170	set val [$layers get $layer.$key]
171	if {$val != ""} {
172	$_tree set $child $key $val
173	}
174	}
175	set styles [$layers element -as object $layer.styles]
176	if {$styles != ""} {
177	set val [$styles get stylesheet]
178	# Normalize whitespace
179	regsub -all "\[ \t\r\n\]+" [string trim $val] " " val
180	$_tree set $child stylesheet $val
181	set script [$styles get script]
182	if {$script != ""} {
183	regsub -all "\[\r\n\]+" [string trim $script] " " script
184	$_tree set $child script $script
185	}
186	set sparent [$_tree insert $child -label "selectors"]
187	foreach selector [$styles children -type selector] {
188	set id "selector[incr _nextSelector]"
189	set snode [$_tree insert $sparent -label $id]
190	foreach key { name style styleExpression query queryBounds queryOrderBy } {
191	set val [$styles get $selector.$key]
192	if {$val != ""} {
193	$_tree set $snode $key $val
194	}
195	}
196	}
197	rename $styles ""
198	}
199	$_tree set $child "driver" "debug"
200	set colorramp [$layers element -as type $layer.colorramp]
201	if { $colorramp != "" } {
202	$_tree set $child "colorramp.elevdriver" "gdal"
203	$_tree set $child "colorramp.colormap" "0 0 0 0 1 1 1 1 1 1"
204	set cmap [$layers get $layer.colorramp.colormap]
205	if {$cmap != ""} {
206	# Normalize whitespace
207	regsub -all "\[ \t\r\n\]+" [string trim $cmap] " " cmap
208	$_tree set $child "colorramp.colormap" $cmap
209	}
210	foreach key { url elevdriver } {
211	set value [$layers get $layer.colorramp.$key]
212	if {$value != ""} {
213	$_tree set $child "colorramp.$key" $value
214	}
215	}
216	set file [$layers get $layer.colorramp.file]
217	if { $file != "" } {
218	# FIXME: Add test for valid file path
219	$_tree set $child "colorramp.url" $file
220	}
221	$_tree set $child "driver" "colorramp"
222	}
223	set gdal [$layers element -as type $layer.gdal]
224	if { $gdal != "" } {
225	foreach key { url } {
226	set value [$layers get $layer.gdal.$key]
227	$_tree set $child "gdal.$key" $value
228	}
229	set file [$layers get $layer.gdal.file]
230	if { $file != "" } {
231	# FIXME: Add test for valid file path
232	$_tree set $child "gdal.url" $file
233	}
234	$_tree set $child "driver" "gdal"
235	}
236	set ogr [$layers element -as type $layer.ogr]
237	if { $ogr != "" } {
238	foreach key { url } {
239	set value [$layers get $layer.ogr.$key]
240	$_tree set $child "ogr.$key" $value
241	}
242	set file [$layers get $layer.ogr.file]
243	if { $file != "" } {
244	# FIXME: Add test for valid file path
245	$_tree set $child "ogr.url" $file
246	}
247	$_tree set $child "driver" "ogr"
248	}
249	set tfs [$layers element -as type $layer.tfs]
250	if { $tfs != "" } {
251	foreach key { url format } {
252	set value [$layers get $layer.tfs.$key]
253	$_tree set $child "tfs.$key" $value
254	}
255	$_tree set $child "driver" "tfs"
256	}
257	set tms [$layers element -as type $layer.tms]
258	if { $tms != "" } {
259	foreach key { url tmsType format } {
260	set value [$layers get $layer.tms.$key]
261	$_tree set $child "tms.$key" $value
262	}
263	$_tree set $child "driver" "tms"
264	}
265	set wcs [$layers element -as type $layer.wcs]
266	if { $wcs != "" } {
267	foreach key { url identifier format elevationUnit rangeSubset } {
268	set value [$layers get $layer.wcs.$key]
269	$_tree set $child "wcs.$key" $value
270	}
271	$_tree set $child "driver" "wcs"
272	}
273	set wfs [$layers element -as type $layer.wfs]
274	if { $wfs != "" } {
275	foreach key { url typename format maxfeatures requestBuffer } {
276	set value [$layers get $layer.wfs.$key]
277	$_tree set $child "wfs.$key" $value
278	}
279	$_tree set $child "driver" "wfs"
280	}
281	set wms [$layers element -as type $layer.wms]
282	if { $wms != "" } {
283	foreach key { url layers format transparent } {
284	set value [$layers get $layer.wms.$key]
285	$_tree set $child "wms.$key" $value
286	}
287	$_tree set $child "driver" "wms"
288	}
289	set xyz [$layers element -as type $layer.xyz]
290	if { $xyz != "" } {
291	foreach key { url } {
292	set value [$layers get $layer.xyz.$key]
293	$_tree set $child "xyz.$key" $value
294	}
295	$_tree set $child "driver" "xyz"
296	}
297	}
298	if {$layers != ""} {
299	rename $layers ""
300	}
301
302	$_tree set root "label" [$map get "about.label"]
303	$_tree set root "attribution" [$map get "about.attribution"]
304	$_tree set root "style" [$map get "style"]
305	$_tree set root "camera" [$map get "camera"]
306	set parent [$_tree insert root -label "viewpoints"]
307	set viewpoints [$map element -as object "viewpoints"]
308	if { $viewpoints != "" } {
309	foreach viewpoint [$viewpoints children -type viewpoint] {
310	set name "viewpoint[incr _nextViewpoint]"
311	set child [$_tree insert $parent -label $name]
312	$_tree set $child "name" $viewpoint
313	set haveX 0
314	set haveZ 0
315	set haveSRS 0
316	set haveVertDatum 0
317	foreach key { label description x y z distance heading pitch srs verticalDatum } {
318	set val [$viewpoints get $viewpoint.$key]
319	if {$val != ""} {
320	if {$key == "x"} {
321	set haveX 1
322	} elseif {$key == "z"} {
323	set haveZ 1
324	} elseif {$key == "srs"} {
325	set haveSRS 1
326	} elseif {$key == "verticalDatum"} {
327	set haveVertDatum 1
328	}
329	$_tree set $child $key $val
330	}
331	}
332	if {!$haveX} {
333	set lat [$viewpoints get $viewpoint.latitude]
334	set long [$viewpoints get $viewpoint.longitude]
335	$_tree set $child x $long
336	$_tree set $child y $lat
337	if {!$haveSRS} {
338	$_tree set $child srs wgs84
339	}
340	if {!$haveVertDatum} {
341	$_tree set $child verticalDatum ""
342	}
343	}
344	if {!$haveZ} {
345	set z [$viewpoints get $viewpoint.altitude]
346	if {$z != ""} {
347	$_tree set $child z $z
348	}
349	}
350	}
351	rename $viewpoints ""
352	}
353
354	set projection [$map get "projection"]
355	set extents [$map get "extents"]
356	if { $projection == "" } {
357	if { $extents != "" } {
358	error "cannot specify extents without a projection"
359	}
360	set projection "global-mercator"; # Default projection.
361	} elseif { $projection == "geodetic" && $extents == "" } {
362	set projection "global-geodetic"
363	}
364	# FIXME: Verify projection is valid.
365	$_tree set root "projection" $projection
366	$_tree set root "extents" $extents
367
368	set mapType [$map get "type"]
369	if { $mapType == "" } {
370	set mapType "projected"; # Default type is "projected".
371	}
372	if { ![info exists _mapTypes($mapType)] } {
373	error "unknown map type \"$mapType\": should be one of [array names _mapTypes]"
374	}
375	$_tree set root "type" $mapType
376
377	foreach {key path} {
378	toolid tool.id
379	toolname tool.name
380	toolcommand tool.execute
381	tooltitle tool.title
382	toolrevision tool.version.application.revision
383	} {
384	set str [$xmlobj get $path]
385	if { "" != $str } {
386	$_tree set root $key $str
387	}
388	}
389	rename $map ""
390	set _isValid 1
391	}
392
393	itcl::body Rappture::Map::setToolInfo { id name command title revision } {
394	foreach key [list id name command title revision] {
395	set str [set $key]
396	if { "" != $str } {
397	$_tree set root "tool$key" $str
398	}
399	}
400	}
401
402	itcl::body Rappture::Map::setType { type } {
403	if { ![info exists _mapTypes($type)] } {
404	error "unknown map type \"$mapType\": should be one of [array names _mapTypes]"
405	}
406	$_tree set root "type" $type
407	}
408
409	itcl::body Rappture::Map::setProjection { projection } {
410	$_tree set root "projection" $projection
411	}
412
413	itcl::body Rappture::Map::setExtents { xmin ymin xmax ymax } {
414	$_tree set root "extents" "$xmin $ymin $xmax $ymax"
415	}
416
417	itcl::body Rappture::Map::setLabel { label } {
418	$_tree set root "label" $label
419	}
420
421	itcl::body Rappture::Map::setAttribution { attribution } {
422	$_tree set root "attribution" $attribution
423	}
424
425	itcl::body Rappture::Map::setStyle { style } {
426	$_tree set root "style" $style
427	}
428
429	itcl::body Rappture::Map::setCamera { camera } {
430	$_tree set root "camera" $camera
431	}
432
433	# ----------------------------------------------------------------------
434	# USAGE: layers
435	#
436	# Returns a list of IDs for the layers in the map
437	# ----------------------------------------------------------------------
438	itcl::body Rappture::Map::layers {} {
439	set list {}
440	foreach node [$_tree children root->"layers"] {
441	lappend list [$_tree label $node]
442	}
443	return $list
444	}
445
446	# ----------------------------------------------------------------------
447	# USAGE: viewpoints
448	#
449	# Returns a list of IDs for the viewpoints in the map
450	# ----------------------------------------------------------------------
451	itcl::body Rappture::Map::viewpoints {} {
452	set list {}
453	foreach node [$_tree children root->"viewpoints"] {
454	lappend list [$_tree label $node]
455	}
456	return $list
457	}
458
459	# ----------------------------------------------------------------------
460	# USAGE: layer <layerName>
461	#
462	# Returns an array of settings for the named layer
463	# ----------------------------------------------------------------------
464	itcl::body Rappture::Map::layer { layerName } {
465	set id [$_tree findchild root->"layers" $layerName]
466	if { $id < 0 } {
467	error "unknown layer \"$layerName\""
468	}
469	return [$_tree get $id]
470	}
471
472	# ----------------------------------------------------------------------
473	# USAGE: selectors
474	#
475	# Returns a list of IDs for the selectors in a layer
476	# ----------------------------------------------------------------------
477	itcl::body Rappture::Map::selectors { layerName } {
478	set list {}
479	foreach node [$_tree children root->"layers"->"$layerName"->"selectors"] {
480	lappend list [$_tree label $node]
481	}
482	return $list
483	}
484
485	# ----------------------------------------------------------------------
486	# USAGE: selector
487	#
488	# Returns an array of settings for the named selector in the named
489	# layer
490	# ----------------------------------------------------------------------
491	itcl::body Rappture::Map::selector { layerName selectorName } {
492	set id [$_tree findchild root->"layers"->"$layerName"->"selectors" $selectorName]
493	if { $id < 0 } {
494	error "unknown selector \"$selectorName\""
495	}
496	return [$_tree get $id]
497	}
498
499	# ----------------------------------------------------------------------
500	# USAGE: viewopint <viewopintName>
501	#
502	# Returns an array of settings for the named viewpoint
503	# ----------------------------------------------------------------------
504	itcl::body Rappture::Map::viewpoint { viewopintName } {
505	set id [$_tree findchild root->"viewpoints" $viewopintName]
506	if { $id < 0 } {
507	error "unknown viewpoint \"$viewpointName\""
508	}
509	return [$_tree get $id]
510	}
511
512	itcl::body Rappture::Map::addViewpoint { name props } {
513	set nodeid "viewpoint[incr _nextViewpoint]"
514	set child [$_tree insert $parent -label $nodeid]
515	$_tree set $child "name" $name
516	set haveX 0
517	set haveZ 0
518	set haveSRS 0
519	set haveVertDatum 0
520	array set info $props
521	foreach key { label description x y z distance heading pitch srs verticalDatum } {
522	if {[info exists info($key)]} {
523	set val $info($key)
524	if {$key == "x"} {
525	set haveX 1
526	} elseif {$key == "z"} {
527	set haveZ 1
528	} elseif {$key == "srs"} {
529	set haveSRS 1
530	} elseif {$key == "verticalDatum"} {
531	set haveVertDatum 1
532	}
533	$_tree set $child $key $val
534	}
535	}
536	if {!$haveX} {
537	set lat $info(latitude)
538	set long $info(longitude)
539	$_tree set $child x $long
540	$_tree set $child y $lat
541	if {!$haveSRS} {
542	$_tree set $child srs wgs84
543	}
544	if {!$haveVertDatum} {
545	$_tree set $child verticalDatum ""
546	}
547	}
548	if {!$haveZ && [info exists info(altitude)]} {
549	$_tree set $child z $info(altitude)
550	}
551	}
552
553	# ----------------------------------------------------------------------
554	# USAGE: type <layerName>
555	#
556	# Returns the type of the named layer
557	# ----------------------------------------------------------------------
558	itcl::body Rappture::Map::type { layerName } {
559	set id [$_tree findchild root->"layers" $layerName]
560	if { $id < 0 } {
561	error "unknown layer \"$layerName\""
562	}
563	return [$_tree get $id "type" ""]
564	}
565
566	# ----------------------------------------------------------------------
567	# USAGE: isGeocentric
568	#
569	# Returns if the map is geocentric (1) or projected (0)
570	# ----------------------------------------------------------------------
571	itcl::body Rappture::Map::isGeocentric {} {
572	return [expr {[hints "type"] eq "geocentric"}]
573	}
574
575	itcl::body Rappture::Map::earthfile {} {
576	array set info [$_tree get root]
577	append out "<map"
578	append out " name=\"$info(label)\""
579	append out " type=\"$info(type)\""
580	append out " version=\"2\""
581	append out ">\n"
582	# Profile is optional
583	if { [info exists info(projection)] } {
584	append out " <options>\n"
585	append out " <profile"
586	append out " srs=\"$info(projection)\""
587	if { [info exists info(extents)] && $info(extents) != "" } {
588	foreach {x1 y1 x2 y2} $info(extents) break
589	append out " xmin=\"$x1\""
590	append out " ymin=\"$y1\""
591	append out " xmax=\"$x2\""
592	append out " ymax=\"$y2\""
593	}
594	append out "/>\n"
595	append out " </options>\n"
596	}
597	foreach node [$_tree children root->"layers"] {
598	array unset info
599	array set info [$_tree get $node]
600	set label [$_tree label $node]
601	switch -- $info(type) {
602	"image" {
603	append out " <image"
604	append out " name=\"$label\""
605	append out " driver=\"gdal\""
606	if { [info exists info(opacity)] } {
607	append out " opacity=\"$info(opacity)\""
608	}
609	if { $info(visible) } {
610	append out " visible=\"true\""
611	} else {
612	append out " visible=\"false\""
613	}
614	append out ">\n"
615	append out " <url>$info(url)</url>\n"
616	append out " </image>\n"
617	}
618	"elevation" {
619	append out " <elevation"
620	append out " name=\"$label\""
621	append out " driver=\"gdal\""
622	if { $info(visible) } {
623	append out " visible=\"true\""
624	} else {
625	append out " visible=\"false\""
626	}
627	append out ">\n"
628	append out " <url>$info(url)</url>\n"
629	append out " </elevation>\n"
630	}
631	default {
632	puts stderr "Type $info(type) not implemented in earthfile"
633	}
634	}
635	}
636	append out "</map>\n"
637	}

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

Download in other formats: