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

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

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