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

Last change on this file since 5975 was 5975, checked in by ldelgass, 8 years ago

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