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

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

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