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

Last change on this file since 5948 was 5948, checked in by ldelgass, 9 years ago

Add deleteLayer, hasLayer methods. Use XML id attribute for layer names.
File size: 29.2 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# ======================================================================
17package require Itcl
18package require BLT
19
20namespace eval Rappture {
21    # forward declaration
22}
23
24itcl::class Rappture::Map {
25    constructor {args} {
26        # defined below
27    }
28    destructor {
29        # defined below
30    }
31
32    public method addLayer { type name paramArray driver driverParamArray {stylesheet {}} {script {}} {selectors {}} }
33    public method addViewpoint { name props }
34    public method deleteLayer { layerName }
35    public method earthfile {}
36    public method hasLayer { layerName }
37    public method hints { args }
38    public method isGeocentric {}
39    public method isvalid {} {
40        return $_isValid;
41    }
42    public method layer { layerName }
43    public method layers {}
44    public method selectors { layerName }
45    public method selector { layerName selectorName }
46    public method setAttribution { attribution }
47    public method setCamera { camera }
48    public method setExtents { xmin ymin xmax ymax {srs "wgs84"} }
49    public method setLabel { label }
50    public method setProjection { projection }
51    public method setStyle { style }
52    public method setToolInfo { id name command title revision }
53    public method setType { type }
54    public method type { layerName }
55    public method viewpoint { viewpointName }
56    public method viewpoints {}
57
58    protected method Parse { xmlobj path }
59
60    private variable _tree "";         # Tree of information about the map.
61    private variable _isValid 0;
62    private common _nextSelector 0;
63    private common _nextViewpoint 0;   # Counter used to generate unique
64                                       # viewpoint names.
65    private common _layerTypes
66    private common _mapTypes
67    array set _layerTypes {
68        "image"         0
69        "elevation"     1
70        "feature"       2
71        "polygon"       3
72        "point"         4
73        "icon"          5
74        "line"          6
75        "label"         7
76    }
77    array set _mapTypes {
78        "geocentric"    0
79        "projected"     1
80    }
81}
82
83# ----------------------------------------------------------------------
84# CONSTRUCTOR
85# ----------------------------------------------------------------------
86itcl::body Rappture::Map::constructor {args} {
87    if {$args == ""} {
88        set _tree [blt::tree create]
89        setLabel "Map"
90        setType "projected"
91        setProjection "global-mercator"
92        $_tree set root "extents" ""
93        setStyle ""
94        setCamera ""
95        $_tree insert root -label "layers"
96        $_tree insert root -label "viewpoints"
97        set _isValid 1
98    } else {
99        set xmlobj [lindex $args 0]
100        set path [lindex $args 1]
101        if {![Rappture::library isvalid $xmlobj]} {
102            error "bad value \"$xmlobj\": should be LibraryObj"
103        }
104        Parse $xmlobj $path
105    }
106}
107
108# ----------------------------------------------------------------------
109# DESTRUCTOR
110# ----------------------------------------------------------------------
111itcl::body Rappture::Map::destructor {} {
112    if { $_tree != "" } {
113        blt::tree destroy $_tree
114    }
115}
116
117itcl::body Rappture::Map::hints { args } {
118    switch -- [llength $args] {
119        0 {
120            return [$_tree get root]
121        }
122        1 {
123            set field [lindex $args 0]
124            return [$_tree get root $field ""]
125        }
126        default {
127            error "wrong # args: should be \"hints ?name?\""
128        }
129    }
130}
131
132#
133# Parse --
134#
135#   Parses the map description in the XML object.
136#
137itcl::body Rappture::Map::Parse { xmlobj path } {
138
139    set map [$xmlobj element -as object $path]
140
141    if { $_tree != "" } {
142        blt::tree destroy $_tree
143    }
144    set _tree [blt::tree create]
145    set parent [$_tree insert root -label "layers"]
146    set layers [$map element -as object "layers"]
147    foreach layer [$layers children -type layer] {
148        # Unique identifier for layer.
149        set name [$map element -as id "layers.$layer"]
150        if {[hasLayer $name]} {
151            puts stderr "ERROR: Duplicate layer ID '$name', skipping"
152            continue
153        }
154        set child [$_tree insert $parent -label $name]
155        set layerType [$layers get $layer.type]
156        if { ![info exists _layerTypes($layerType)] } {
157            error "invalid layer type \"$layerType\": should be one of [array names _layerTypes]"
158        }
159        $_tree set $child "name" $name
160        $_tree set $child "type" $layerType
161        foreach key { label description attribution profile srs verticalDatum } {
162            $_tree set $child $key [$layers get $layer.$key]
163        }
164        # Common settings (for all layer types) with defaults
165        foreach { key defval } { visible 1 cache 1 } {
166            $_tree set $child $key $defval
167            set val [$layers get $layer.$key]
168            if {$val != ""} {
169                $_tree set $child $key $val
170            }
171        }
172        # These are settings for which there should be no default
173        # We want to know if they have been set by the user or not
174        # Not all layer types use these
175        foreach key { coverage opacity content priority style } {
176            set val [$layers get $layer.$key]
177            if {$val != ""} {
178                $_tree set $child $key $val
179            }
180        }
181        set styles [$layers element -as object $layer.styles]
182        if {$styles != ""} {
183            set val [$styles get stylesheet]
184            # Normalize whitespace
185            regsub -all "\[ \t\r\n\]+" [string trim $val] " " val
186            $_tree set $child stylesheet $val
187            set script [$styles get script]
188            if {$script != ""} {
189                regsub -all "\[\r\n\]+" [string trim $script] " " script
190                $_tree set $child script $script
191            }
192            set sparent [$_tree insert $child -label "selectors"]
193            foreach selector [$styles children -type selector] {
194                set id "selector[incr _nextSelector]"
195                set snode [$_tree insert $sparent -label $id]
196                foreach key { name style styleExpression query queryBounds queryOrderBy } {
197                    set val [$styles get $selector.$key]
198                    if {$val != ""} {
199                        $_tree set $snode $key $val
200                    }
201                }
202            }
203            rename $styles ""
204        }
205        $_tree set $child "driver" "debug"
206        set colorramp [$layers element -as type $layer.colorramp]
207        if { $colorramp != "" } {
208            $_tree set $child "colorramp.elevdriver" "gdal"
209            $_tree set $child "colorramp.colormap" "0 0 0 0 1 1 1 1 1 1"
210            set cmap [$layers get $layer.colorramp.colormap]
211            if {$cmap != ""} {
212                # Normalize whitespace
213                regsub -all "\[ \t\r\n\]+" [string trim $cmap] " " cmap
214                $_tree set $child "colorramp.colormap" $cmap
215            }
216            foreach key { url elevdriver } {
217                set value [$layers get $layer.colorramp.$key]
218                if {$value != ""} {
219                    $_tree set $child "colorramp.$key" $value
220                }
221            }
222            set file [$layers get $layer.colorramp.file]
223            if { $file != "" } {
224                # FIXME: Add test for valid file path
225                $_tree set $child "colorramp.url" $file
226            }
227            $_tree set $child "driver" "colorramp"
228        }
229        set arcgis [$layers element -as type $layer.arcgis]
230        if { $arcgis != "" } {
231            foreach key { url token format layers } {
232                set value [$layers get $layer.arcgis.$key]
233                $_tree set $child "arcgis.$key" $value
234            }
235            $_tree set $child "driver" "arcgis"
236        }
237        set gdal [$layers element -as type $layer.gdal]
238        if { $gdal != "" } {
239            foreach key { url } {
240                set value [$layers get $layer.gdal.$key]
241                $_tree set $child "gdal.$key" $value
242            }
243            set file [$layers get $layer.gdal.file]
244            if { $file != "" } {
245                # FIXME: Add test for valid file path
246                $_tree set $child "gdal.url" $file
247            }
248            $_tree set $child "driver" "gdal"
249        }
250        set ogr [$layers element -as type $layer.ogr]
251        if { $ogr != "" } {
252            foreach key { url } {
253                set value [$layers get $layer.ogr.$key]
254                $_tree set $child "ogr.$key" $value
255            }
256            set file [$layers get $layer.ogr.file]
257            if { $file != "" } {
258                # FIXME: Add test for valid file path
259                $_tree set $child "ogr.url" $file
260            }
261            foreach key { connection geometry geometry_url layer ogr_driver build_spatial_index } {
262                set value [$layers get $layer.ogr.$key]
263                if { $value != "" } {
264                    $_tree set $child "ogr.$key" $value
265                }
266            }
267            $_tree set $child "driver" "ogr"
268        }
269        set tfs [$layers element -as type $layer.tfs]
270        if { $tfs != "" } {
271            foreach key { url format } {
272                set value [$layers get $layer.tfs.$key]
273                $_tree set $child "tfs.$key" $value
274            }
275            $_tree set $child "driver" "tfs"
276        }
277        set tms [$layers element -as type $layer.tms]
278        if { $tms != "" } {
279            foreach key { url tmsType format } {
280                set value [$layers get $layer.tms.$key]
281                $_tree set $child "tms.$key" $value
282            }
283            $_tree set $child "driver" "tms"
284        }
285        set wcs [$layers element -as type $layer.wcs]
286        if { $wcs != "" } {
287            foreach key { url identifier format elevationUnit rangeSubset } {
288                set value [$layers get $layer.wcs.$key]
289                $_tree set $child "wcs.$key" $value
290            }
291            $_tree set $child "driver" "wcs"
292        }
293        set wfs [$layers element -as type $layer.wfs]
294        if { $wfs != "" } {
295            foreach key { url typename format maxfeatures requestBuffer } {
296                set value [$layers get $layer.wfs.$key]
297                $_tree set $child "wfs.$key" $value
298            }
299            $_tree set $child "driver" "wfs"
300        }
301        set wms [$layers element -as type $layer.wms]
302        if { $wms != "" } {
303            foreach key { url layers format transparent } {
304                set value [$layers get $layer.wms.$key]
305                $_tree set $child "wms.$key" $value
306            }
307            $_tree set $child "driver" "wms"
308        }
309        set xyz [$layers element -as type $layer.xyz]
310        if { $xyz != "" } {
311            foreach key { url } {
312                set value [$layers get $layer.xyz.$key]
313                $_tree set $child "xyz.$key" $value
314            }
315            $_tree set $child "driver" "xyz"
316        }
317    }
318    if {$layers != ""} {
319        rename $layers ""
320    }
321
322    $_tree set root "label"       [$map get "about.label"]
323    $_tree set root "attribution" [$map get "about.attribution"]
324    $_tree set root "style"       [$map get "style"]
325    $_tree set root "camera"      [$map get "camera"]
326    set parent [$_tree insert root -label "viewpoints"]
327    set viewpoints [$map element -as object "viewpoints"]
328    if { $viewpoints != "" } {
329        foreach viewpoint [$viewpoints children -type viewpoint] {
330            set name "viewpoint[incr _nextViewpoint]"
331            set child [$_tree insert $parent -label $name]
332            $_tree set $child "name" $viewpoint
333            set haveX 0
334            set haveZ 0
335            set haveSRS 0
336            set haveVertDatum 0
337            foreach key { label description x y z distance heading pitch srs verticalDatum } {
338                set val [$viewpoints get $viewpoint.$key]
339                if {$val != ""} {
340                    if {$key == "x"} {
341                        set haveX 1
342                    } elseif {$key == "z"} {
343                        set haveZ 1
344                    } elseif {$key == "srs"} {
345                        set haveSRS 1
346                    } elseif {$key == "verticalDatum"} {
347                        set haveVertDatum 1
348                    }
349                    $_tree set $child $key $val
350                }
351            }
352            if {!$haveX} {
353                set lat [$viewpoints get $viewpoint.latitude]
354                set long [$viewpoints get $viewpoint.longitude]
355                $_tree set $child x $long
356                $_tree set $child y $lat
357                if {!$haveSRS} {
358                    $_tree set $child srs wgs84
359                }
360                if {!$haveVertDatum} {
361                    $_tree set $child verticalDatum ""
362                }
363            }
364            if {!$haveZ} {
365                set z [$viewpoints get $viewpoint.altitude]
366                if {$z != ""} {
367                    $_tree set $child z $z
368                }
369            }
370        }
371        rename $viewpoints ""
372    }
373
374    set projection [$map get "projection"]
375    set extents    [$map get "extents"]
376    if { $projection  == "" } {
377        if { $extents != "" } {
378            error "cannot specify extents without a projection"
379        }
380        set projection "global-mercator"; # Default projection.
381    } elseif { $projection == "geodetic" || $projection == "global-geodetic" ||
382           $projection == "wgs84" || $projection == "epsg:4326" ||
383           $projection == "plate-carre" || $projection == "plate-carree" } {
384        # Can't use angular units in projection 
385        error "Geodetic profile not supported as map projection.  Try using an equirectangular (epsg:32663) projection instead."
386    } elseif { $projection == "equirectangular" || $projection == "eqc-wgs84" } {
387        set projection "epsg:32663"
388    }
389    # FIXME: Verify projection is valid.
390    $_tree set root "projection" $projection
391    $_tree set root "extents"    $extents
392
393    set mapType [$map get "type"]
394    if { $mapType == "" } {
395        set mapType "projected";           # Default type is "projected".
396    }
397    if { ![info exists _mapTypes($mapType)] } {
398        error "unknown map type \"$mapType\": should be one of [array names _mapTypes]"
399    }
400    $_tree set root "type" $mapType
401
402    foreach {key path} {
403        toolid          tool.id
404        toolname        tool.name
405        toolcommand     tool.execute
406        tooltitle       tool.title
407        toolrevision    tool.version.application.revision
408    } {
409        set str [$xmlobj get $path]
410        if { "" != $str } {
411            $_tree set root $key $str
412        }
413    }
414    rename $map ""
415    set _isValid 1
416}
417
418itcl::body Rappture::Map::setToolInfo { id name command title revision } {
419    foreach key [list id name command title revision] {
420        set str [set $key]
421        if { "" != $str } {
422            $_tree set root "tool$key" $str
423        }
424    }
425}
426
427itcl::body Rappture::Map::setType { type } {
428    if { ![info exists _mapTypes($type)] } {
429        error "unknown map type \"$mapType\": should be one of [array names _mapTypes]"
430    }
431    $_tree set root "type" $type
432}
433
434itcl::body Rappture::Map::setProjection { projection } {
435    $_tree set root "projection" $projection
436}
437
438itcl::body Rappture::Map::setExtents { xmin ymin xmax ymax {srs "wgs84"} } {
439    $_tree set root "extents" [list $xmin $ymin $xmax $ymax $srs]
440}
441
442itcl::body Rappture::Map::setLabel { label } {
443    $_tree set root "label" $label
444}
445
446itcl::body Rappture::Map::setAttribution { attribution } {
447    $_tree set root "attribution" $attribution
448}
449
450itcl::body Rappture::Map::setStyle { style } {
451    $_tree set root "style" $style
452}
453
454itcl::body Rappture::Map::setCamera { camera } {
455    $_tree set root "camera" $camera
456}
457
458itcl::body Rappture::Map::addLayer { type name paramArray driver driverParamArray {stylesheet {}} {script {}} {selectors {}} } {
459    set id "$name"
460    if {[hasLayer $id]} {
461        error "Layer '$id' already exists"
462    }
463    set parent [$_tree findchild root "layers"]
464    set child [$_tree insert $parent -label $id]
465    $_tree set $child "name" $name
466    $_tree set $child "type" $type
467    array set params $paramArray
468    foreach key { label description attribution profile srs verticalDatum } {
469        if {[info exists params($key)]} {
470            $_tree set $child $key $params($key)
471        } else {
472            $_tree set $child $key ""
473        }
474    }
475    # Common settings (for all layer types) with defaults
476    foreach { key defval } { visible 1 cache 1 } {
477        $_tree set $child $key $defval
478        if {[info exists params($key)]} {
479            set val $params($key)
480            if {$val != ""} {
481                $_tree set $child $key $val
482            }
483        }
484    }
485    # These are settings for which there should be no default
486    # We want to know if they have been set by the user or not
487    # Not all layer types use these
488    foreach key { coverage opacity content priority style } {
489        if {[info exists params($key)]} {
490            set val $params($key)
491            if {$val != ""} {
492                $_tree set $child $key $val
493            }
494        }
495    }
496    if {$stylesheet != ""} {
497        set val $stylesheet
498        # Normalize whitespace
499        regsub -all "\[ \t\r\n\]+" [string trim $val] " " val
500        $_tree set $child stylesheet $val
501    }
502    if {$script != ""} {
503        regsub -all "\[\r\n\]+" [string trim $script] " " script
504        $_tree set $child script $script
505    }
506    if {$selectors != ""} {
507        set sparent [$_tree insert $child -label "selectors"]
508        foreach selectorItem $selectors {
509            array set selector $selectorItem
510            set id "selector[incr _nextSelector]"
511            set snode [$_tree insert $sparent -label $id]
512            foreach key { name style styleExpression query queryBounds queryOrderBy } {
513                if {[info exists selector($key)]} {
514                    set val $selector($key)
515                    if {$val != ""} {
516                        $_tree set $snode $key $val
517                    }
518                }
519            }
520        }
521    }
522    $_tree set $child "driver" $driver
523    switch -- $driver {
524        "arcgis" {
525            array set params $driverParamArray
526            foreach key { url token format layers } {
527                if {[info exists params($key)]} {
528                    set value $params($key)
529                    $_tree set $child "arcgis.$key" $value
530                }
531            }
532        }
533        "colorramp" {
534            array set params $driverParamArray
535            $_tree set $child "colorramp.elevdriver" "gdal"
536            $_tree set $child "colorramp.colormap" "0 0 0 0 1 1 1 1 1 1"
537            if {[info exists params(colormap)]} {
538                set cmap $params(colormap)
539                if {$cmap != ""} {
540                    # Normalize whitespace
541                    regsub -all "\[ \t\r\n\]+" [string trim $cmap] " " cmap
542                    $_tree set $child "colorramp.colormap" $cmap
543                }
544            }
545            foreach key { url elevdriver } {
546                if {[info exists params($key)]} {
547                    set value $params($key)
548                    if {$value != ""} {
549                        $_tree set $child "colorramp.$key" $value
550                    }
551                }
552            }
553        }
554        "gdal" {
555            array set params $driverParamArray
556            foreach key { url } {
557                set value $params($key)
558                $_tree set $child "gdal.$key" $value
559            }
560        }
561        "ogr" {
562            array set params $driverParamArray
563            foreach key { url } {
564                set value $params($key)
565                $_tree set $child "ogr.$key" $value
566            }
567            foreach key { connection geometry geometry_url layer ogr_driver build_spatial_index } {
568                if {[info exists params($key)]} {
569                    set value $params($key)
570                    if { $value != "" } {
571                        $_tree set $child "ogr.$key" $value
572                    }
573                }
574            }
575        }
576        "tfs" {
577            foreach key { url format } {
578                if {[info exists params($key)]} {
579                    set value $params($key)
580                    $_tree set $child "tfs.$key" $value
581                }
582            }
583        }
584        "tms" {
585            foreach key { url tmsType format } {
586                if {[info exists params($key)]} {
587                    set value $params($key)
588                    $_tree set $child "tms.$key" $value
589                }
590            }
591        }
592        "wcs" {
593            foreach key { url identifier format elevationUnit rangeSubset } {
594                if {[info exists params($key)]} {
595                    set value $params($key)
596                    $_tree set $child "wcs.$key" $value
597                }
598            }
599        }
600        "wfs" {
601            foreach key { url typename format maxfeatures requestBuffer } {
602                if {[info exists params($key)]} {
603                    set value $params($key)
604                    $_tree set $child "wfs.$key" $value
605                }
606            }
607        }
608        "wms" {
609            foreach key { url layers format transparent } {
610                if {[info exists params($key)]} {
611                    set value $params($key)
612                    $_tree set $child "wms.$key" $value
613                }
614            }
615        }
616        "xyz" {
617            foreach key { url } {
618                if {[info exists params($key)]} {
619                    set value $params($key)
620                    $_tree set $child "xyz.$key" $value
621                }
622            }
623        }
624    }
625    return $id
626}
627
628itcl::body Rappture::Map::deleteLayer { layerName } {
629    set id [$_tree findchild root->"layers" $layerName]
630    if { $id < 0 } {
631        error "unknown layer \"$layerName\""
632    }
633    $_tree delete $id
634}
635
636# ----------------------------------------------------------------------
637# USAGE: layers
638#
639# Returns a list of IDs for the layers in the map
640# ----------------------------------------------------------------------
641itcl::body Rappture::Map::layers {} {
642    set list {}
643    foreach node [$_tree children root->"layers"] {
644        lappend list [$_tree label $node]
645    }
646    return $list
647}
648
649# ----------------------------------------------------------------------
650# USAGE: viewpoints
651#
652# Returns a list of IDs for the viewpoints in the map
653# ----------------------------------------------------------------------
654itcl::body Rappture::Map::viewpoints {} {
655    set list {}
656    catch {
657        foreach node [$_tree children root->"viewpoints"] {
658            lappend list [$_tree label $node]
659        }
660    }
661    return $list
662}
663
664# ----------------------------------------------------------------------
665# USAGE: layer <layerName>
666#
667# Returns an array of settings for the named layer
668# ----------------------------------------------------------------------
669itcl::body Rappture::Map::layer { layerName } {
670    set id [$_tree findchild root->"layers" $layerName]
671    if { $id < 0 } {
672        error "unknown layer \"$layerName\""
673    }
674    return [$_tree get $id]
675}
676
677itcl::body Rappture::Map::hasLayer { layerName } {
678    set id [$_tree findchild root->"layers" $layerName]
679    if { $id < 0 } {
680        return 0
681    } else {
682        return 1
683    }
684}
685
686# ----------------------------------------------------------------------
687# USAGE: selectors
688#
689# Returns a list of IDs for the selectors in a layer
690# ----------------------------------------------------------------------
691itcl::body Rappture::Map::selectors { layerName } {
692    set list {}
693    catch {
694        foreach node [$_tree children root->"layers"->"$layerName"->"selectors"] {
695            lappend list [$_tree label $node]
696        }
697    }
698    return $list
699}
700
701# ----------------------------------------------------------------------
702# USAGE: selector
703#
704# Returns an array of settings for the named selector in the named
705# layer
706# ----------------------------------------------------------------------
707itcl::body Rappture::Map::selector { layerName selectorName } {
708    set id [$_tree findchild root->"layers"->"$layerName"->"selectors" $selectorName]
709    if { $id < 0 } {
710        error "unknown selector \"$selectorName\""
711    }
712    return [$_tree get $id]
713}
714
715# ----------------------------------------------------------------------
716# USAGE: viewopint <viewopintName>
717#
718# Returns an array of settings for the named viewpoint
719# ----------------------------------------------------------------------
720itcl::body Rappture::Map::viewpoint { viewopintName } {
721    set id [$_tree findchild root->"viewpoints" $viewopintName]
722    if { $id < 0 } {
723        error "unknown viewpoint \"$viewpointName\""
724    }
725    return [$_tree get $id]
726}
727
728itcl::body Rappture::Map::addViewpoint { name props } {
729    set nodeid "viewpoint[incr _nextViewpoint]"
730    set parent [$_tree findchild root "viewpoints"]
731    set child [$_tree insert $parent -label $nodeid]
732    $_tree set $child "name" $name
733    set haveX 0
734    set haveZ 0
735    set haveSRS 0
736    set haveVertDatum 0
737    array set info $props
738    foreach key { label description x y z distance heading pitch srs verticalDatum } {
739        if {[info exists info($key)]} {
740            set val $info($key)
741            if {$key == "x"} {
742                set haveX 1
743            } elseif {$key == "z"} {
744                set haveZ 1
745            } elseif {$key == "srs"} {
746                set haveSRS 1
747            } elseif {$key == "verticalDatum"} {
748                set haveVertDatum 1
749            }
750            $_tree set $child $key $val
751        }
752    }
753    if {!$haveX} {
754        set lat $info(latitude)
755        set long $info(longitude)
756        $_tree set $child x $long
757        $_tree set $child y $lat
758        if {!$haveSRS} {
759            $_tree set $child srs wgs84
760        }
761        if {!$haveVertDatum} {
762            $_tree set $child verticalDatum ""
763        }
764    }
765    if {!$haveZ && [info exists info(altitude)]} {
766        $_tree set $child z $info(altitude)
767    }
768}
769
770# ----------------------------------------------------------------------
771# USAGE: type <layerName>
772#
773# Returns the type of the named layer
774# ----------------------------------------------------------------------
775itcl::body Rappture::Map::type { layerName } {
776    set id [$_tree findchild root->"layers" $layerName]
777    if { $id < 0 } {
778        error "unknown layer \"$layerName\""
779    }
780    return [$_tree get $id "type" ""]
781}
782
783# ----------------------------------------------------------------------
784# USAGE: isGeocentric
785#
786# Returns if the map is geocentric (1) or projected (0)
787# ----------------------------------------------------------------------
788itcl::body Rappture::Map::isGeocentric {} {
789    return [expr {[hints "type"] eq "geocentric"}]
790}
791
792itcl::body Rappture::Map::earthfile {} {
793    array set info [$_tree get root]
794    append out "<map"
795    append out " name=\"$info(label)\""
796    append out " type=\"$info(type)\""
797    append out " version=\"2\""
798    append out ">\n"
799    # Profile is optional
800    if { [info exists info(projection)] } {
801        append out " <options>\n"
802        append out "  <profile"
803        append out " srs=\"$info(projection)\""
804        if { [info exists info(extents)] && $info(extents) != "" } {
805            foreach {x1 y1 x2 y2} $info(extents) break
806            append out " xmin=\"$x1\""
807            append out " ymin=\"$y1\""
808            append out " xmax=\"$x2\""
809            append out " ymax=\"$y2\""
810        }
811        append out "/>\n"
812        append out " </options>\n"
813    }
814    foreach node [$_tree children root->"layers"] {
815        array unset info
816        array set info [$_tree get $node]
817        set label [$_tree label $node]
818        switch -- $info(type) {
819            "image" {
820                append out " <image"
821                append out " name=\"$label\""
822                append out " driver=\"gdal\""
823                if { [info exists info(opacity)] } {
824                    append out " opacity=\"$info(opacity)\""
825                }
826                if { $info(visible) } {
827                    append out " visible=\"true\""
828                } else {
829                    append out " visible=\"false\""
830                }
831                append out ">\n"
832                append out "  <url>$info(url)</url>\n"
833                append out " </image>\n"
834            }
835            "elevation" {
836                append out " <elevation"
837                append out " name=\"$label\""
838                append out " driver=\"gdal\""
839                if { $info(visible) } {
840                    append out " visible=\"true\""
841                } else {
842                    append out " visible=\"false\""
843                }
844                append out ">\n"
845                append out "  <url>$info(url)</url>\n"
846                append out " </elevation>\n"
847            }
848            default {
849                puts stderr "Type $info(type) not implemented in earthfile"
850            }
851        }
852    }
853    append out "</map>\n"
854}
Note: See TracBrowser for help on using the repository browser.