source: branches/blt4_geovis/gui/scripts/map.tcl @ 5994

Last change on this file since 5994 was 5994, checked in by dkearney, 7 years ago

merging in placard configuration updates, placard example, feature select example, and add-remove layer example from geomap branch r5971,r5990,r5991,r5993

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