source: branches/blt4_trunk/gui/scripts/map.tcl @ 6351

Last change on this file since 6351 was 6351, checked in by dkearney, 8 years ago

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