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

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

merge from trunk to blt4_trunk branch
File size: 46.5 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 colorToHTML { color }
84    protected proc fixBoolean { val }
85    protected proc fixEnum { str }
86    protected proc fixQuotes { str }
87    protected proc isBooleanProp { prop }
88    protected proc isColorProp { prop }
89    protected proc isFileProp { prop }
90    protected proc parseStylesheet { stylesheet }
91    protected proc styleToCSS { layerType props {styleName "style"} }
92    protected proc translateProp { layerType styleProp styleValue }
93
94    private variable _tree "";         # Tree of information about the map.
95    private variable _isValid 0;
96    private variable _dirty;
97    array set _dirty {
98        viewpoints 0
99    }
100    private common _nextSelector 0;
101    private common _layerTypes
102    private common _mapTypes
103    array set _layerTypes {
104        "image"         0
105        "elevation"     1
106        "feature"       2
107        "mask"          3
108        "model"         4
109        "polygon"       5
110        "point"         6
111        "icon"          7
112        "line"          8
113        "label"         9
114    }
115    array set _mapTypes {
116        "geocentric"    0
117        "projected"     1
118    }
119}
120
121# ----------------------------------------------------------------------
122# CONSTRUCTOR
123# ----------------------------------------------------------------------
124itcl::body Rappture::Map::constructor {args} {
125    set _tree [blt::tree create]
126    $_tree insert root -label "layers"
127    $_tree insert root -label "viewpoints"
128    setLabel "Map"
129    setType "projected"
130    setProjection "global-mercator"
131    clearExtents
132    setStyle ""
133    setCamera ""
134    if {$args == ""} {
135        set _isValid 1
136    } else {
137        set xmlobj [lindex $args 0]
138        set path [lindex $args 1]
139        if {![Rappture::library isvalid $xmlobj]} {
140            error "bad value \"$xmlobj\": should be LibraryObj"
141        }
142        parseXML $xmlobj $path
143    }
144}
145
146# ----------------------------------------------------------------------
147# DESTRUCTOR
148# ----------------------------------------------------------------------
149itcl::body Rappture::Map::destructor {} {
150    if { $_tree != "" } {
151        blt::tree destroy $_tree
152    }
153}
154
155itcl::body Rappture::Map::hints { args } {
156    switch -- [llength $args] {
157        0 {
158            return [$_tree get root]
159        }
160        1 {
161            set field [lindex $args 0]
162            return [$_tree get root $field ""]
163        }
164        default {
165            error "wrong # args: should be \"hints <?name?>\""
166        }
167    }
168}
169
170#
171# parseXML --
172#
173#   Parses the map description in the XML object.
174#
175itcl::body Rappture::Map::parseXML { xmlobj path } {
176    set map [$xmlobj element -as object $path]
177    set elemType [$xmlobj element -as type $path]
178    if {$elemType != "map"} {
179        puts stderr "ERROR: Invalid map XML: \"$elemType\""
180        return
181    }
182
183    # Set global map properties
184    setLabel [$map get "about.label"]
185    setDescription [$map get "about.description"]
186    setAttribution [$map get "about.attribution"]
187
188    set mapType [$map get "type"]
189    if { $mapType != "" } {
190        if {[catch {setType $mapType} msg] != 0} {
191            puts stderr "ERROR: $msg"
192            return
193        }
194    }
195
196    set projection [$map get "projection"]
197    set extents    [$map get "extents"]
198    if { $projection  == "" } {
199        if { $extents != "" } {
200            puts stderr "ERROR: cannot specify extents without a projection"
201            set extents ""
202        }
203        set projection "global-mercator"; # Default projection.
204    } elseif { $projection == "geodetic" || $projection == "global-geodetic" ||
205               $projection == "wgs84" || $projection == "epsg:4326" ||
206               $projection == "plate-carre" || $projection == "plate-carree" } {
207        # Can't use angular units in projection 
208        puts stderr "ERROR: Geodetic profile not supported as map projection.  Try using an equirectangular (epsg:32663) projection instead."
209        set projection "epsg:32663"
210    } elseif { $projection == "equirectangular" ||
211               $projection == "eqc-wgs84" } {
212        set projection "epsg:32663"
213    }
214    # FIXME: Verify projection is valid.
215    setProjection $projection
216    if {$extents != ""} {
217        foreach {xmin ymin xmax ymax srs} $extents {}
218        if {$srs == ""} {
219            setExtents $xmin $ymin $xmax $ymax
220        } else {
221            setExtents $xmin $ymin $xmax $ymax $srs
222        }
223    } else {
224         clearExtents
225    }
226
227    if {[catch {setStyle [$map get "style"]} msg] != 0} {
228        puts stderr "ERROR: $msg"
229    }
230    if {[catch {setCamera [$map get "camera"]} msg] != 0} {
231        puts stderr "ERROR: $msg"
232    }
233
234    # Parse layers
235    set parent [$_tree findchild root "layers"]
236    set layers [$map element -as object "layers"]
237    foreach layer [$layers children -type layer] {
238        # Unique identifier for layer.
239        set name [$layers element -as id "$layer"]
240        if {[hasLayer $name]} {
241            puts stderr "ERROR: Duplicate layer ID '$name', skipping"
242            continue
243        }
244        set layerType [$layers get $layer.type]
245        if { ![info exists _layerTypes($layerType)] } {
246            puts stderr "ERROR: invalid layer type \"$layerType\": should be one of: [join [array names _layerTypes] {, }]"
247            continue
248        }
249        set child [$_tree insert $parent -label $name]
250        $_tree set $child "name" $name
251        $_tree set $child "type" $layerType
252        foreach key { label description attribution profile srs verticalDatum } {
253            $_tree set $child $key [$layers get $layer.$key]
254        }
255        # Common settings (for all layer types) with defaults
256        foreach { key defval } { visible 1 cache 1 shared 0 } {
257            $_tree set $child $key $defval
258            set val [$layers get $layer.$key]
259            if {$val != ""} {
260                $_tree set $child $key $val
261            }
262        }
263        # These are settings for which there should be no default
264        # We want to know if they have been set by the user or not
265        # Not all layer types use these
266        foreach key { coverage opacity content priority style terrainPatch } {
267            set val [$layers get $layer.$key]
268            if {$val != ""} {
269                if {$key eq "coverage" && $layerType ne "image"} {
270                    puts stderr "ERROR: <coverage> is only valid for layers of type \"image\""
271                }
272                if {$key eq "content" || $key eq "priority"} {
273                    if {$layerType ne "label"} {
274                        puts stderr "ERROR: <content> and <priority> are only valid in layers of type \"label\""
275                    }
276                }
277                if {$key eq "opacity" && ($layerType eq "elevation" ||
278                    $layerType eq "mask")} {
279                    puts stderr "ERROR: <opacity> is not valid for layers of type \"elevation\" or \"mask\""
280                }
281                if {$key eq "terrainPatch" && $layerType ne "feature" &&
282                    $layerType ne "model" && $layerType ne "polygon"} {
283                    puts stderr "ERROR: <terrainPatch> is only valid for layers of type \"feature\", \"model\" or \"polygon\""
284                }
285                $_tree set $child $key $val
286            }
287        }
288        set styles [$layers element -as object $layer.styles]
289        if {$styles != ""} {
290            set val [$styles get stylesheet]
291            # Normalize whitespace
292            regsub -all "\[ \t\r\n\]+" [string trim $val] " " val
293            $_tree set $child stylesheet $val
294            set script [$styles get script]
295            if {$script != ""} {
296                regsub -all "\[\r\n\]+" [string trim $script] " " script
297                $_tree set $child script $script
298            }
299            set sparent [$_tree insert $child -label "selectors"]
300            foreach selector [$styles children -type selector] {
301                set id [$styles element -as id "$selector"]
302                set snode [$_tree insert $sparent -label $id]
303                foreach key { name style styleExpression query queryBounds queryOrderBy } {
304                    set val [$styles get $selector.$key]
305                    if {$val != ""} {
306                        $_tree set $snode $key $val
307                    }
308                }
309            }
310            rename $styles ""
311        }
312        set placard [$layers element -as object $layer.placard]
313        if {$placard != ""} {
314            if {$layerType == "image" || $layerType == "elevation"} {
315                puts stderr "ERROR: Placard not supported on image or elevation layers"
316            }
317            foreach key { attributes style padding } {
318                set $key [$placard get $key]
319            }
320            setPlacardConfig $name $attributes $style $padding
321        }
322        $_tree set $child "driver" "debug"
323        set colorramp [$layers element -as type $layer.colorramp]
324        if { $colorramp != "" } {
325            $_tree set $child "colorramp.elevdriver" "gdal"
326            $_tree set $child "colorramp.colormap" "0 0 0 0 1 1 1 1 1 1"
327            set cmap [$layers get $layer.colorramp.colormap]
328            if {$cmap != ""} {
329                # Normalize whitespace
330                regsub -all "\[ \t\r\n\]+" [string trim $cmap] " " cmap
331                $_tree set $child "colorramp.colormap" $cmap
332            }
333            foreach key { url elevdriver } {
334                set value [$layers get $layer.colorramp.$key]
335                if {$value != ""} {
336                    $_tree set $child "colorramp.$key" $value
337                }
338            }
339            set file [$layers get $layer.colorramp.file]
340            if { $file != "" } {
341                # FIXME: Add test for valid file path
342                $_tree set $child "colorramp.url" $file
343            }
344            $_tree set $child "driver" "colorramp"
345        }
346        set agglite [$layers element -as type $layer.agglite]
347        if { $agglite != "" } {
348            foreach key { url } {
349                set value [$layers get $layer.agglite.$key]
350                $_tree set $child "agglite.$key" $value
351            }
352            $_tree set $child "driver" "agglite"
353        }
354        set arcgis [$layers element -as type $layer.arcgis]
355        if { $arcgis != "" } {
356            foreach key { url token format layers } {
357                set value [$layers get $layer.arcgis.$key]
358                $_tree set $child "arcgis.$key" $value
359            }
360            $_tree set $child "driver" "arcgis"
361        }
362        set gdal [$layers element -as type $layer.gdal]
363        if { $gdal != "" } {
364            foreach key { url } {
365                set value [$layers get $layer.gdal.$key]
366                $_tree set $child "gdal.$key" $value
367            }
368            set file [$layers get $layer.gdal.file]
369            if { $file != "" } {
370                # FIXME: Add test for valid file path
371                $_tree set $child "gdal.url" $file
372            }
373            $_tree set $child "driver" "gdal"
374        }
375        set ogr [$layers element -as type $layer.ogr]
376        if { $ogr != "" } {
377            foreach key { url } {
378                set value [$layers get $layer.ogr.$key]
379                $_tree set $child "ogr.$key" $value
380            }
381            set file [$layers get $layer.ogr.file]
382            if { $file != "" } {
383                # FIXME: Add test for valid file path
384                $_tree set $child "ogr.url" $file
385            }
386            foreach key { connection geometry geometryUrl layer ogrDriver buildSpatialIndex } {
387                set value [$layers get $layer.ogr.$key]
388                if { $value != "" } {
389                    $_tree set $child "ogr.$key" $value
390                }
391            }
392            $_tree set $child "driver" "ogr"
393        }
394        set osg [$layers element -as type $layer.osg]
395        if { $osg != "" } {
396            foreach key { url } {
397                set value [$layers get $layer.osg.$key]
398                $_tree set $child "osg.$key" $value
399            }
400            set file [$layers get $layer.osg.file]
401            if { $file != "" } {
402                $_tree set $child "osg.url" $file
403            }
404            $_tree set $child "osg.x" 0.0
405            $_tree set $child "osg.y" 0.0
406            $_tree set $child "osg.z" 0.0
407            $_tree set $child "osg.rotx" 0.0
408            $_tree set $child "osg.roty" 0.0
409            $_tree set $child "osg.rotz" 0.0
410            foreach key { x y z rotx roty rotz paged } {
411                set value [$layers get $layer.osg.$key]
412                if { $value != "" } {
413                    $_tree set $child "osg.$key" $value
414                }
415            }
416            $_tree set $child "driver" "osg"
417        }
418        set tfs [$layers element -as type $layer.tfs]
419        if { $tfs != "" } {
420            foreach key { url format } {
421                set value [$layers get $layer.tfs.$key]
422                $_tree set $child "tfs.$key" $value
423            }
424            $_tree set $child "driver" "tfs"
425        }
426        set tms [$layers element -as type $layer.tms]
427        if { $tms != "" } {
428            foreach key { url tmsType format } {
429                set value [$layers get $layer.tms.$key]
430                $_tree set $child "tms.$key" $value
431            }
432            $_tree set $child "driver" "tms"
433        }
434        set wcs [$layers element -as type $layer.wcs]
435        if { $wcs != "" } {
436            foreach key { url identifier format elevationUnit rangeSubset } {
437                set value [$layers get $layer.wcs.$key]
438                $_tree set $child "wcs.$key" $value
439            }
440            $_tree set $child "driver" "wcs"
441        }
442        set wfs [$layers element -as type $layer.wfs]
443        if { $wfs != "" } {
444            foreach key { url typename format maxfeatures requestBuffer } {
445                set value [$layers get $layer.wfs.$key]
446                $_tree set $child "wfs.$key" $value
447            }
448            $_tree set $child "driver" "wfs"
449        }
450        set wms [$layers element -as type $layer.wms]
451        if { $wms != "" } {
452            foreach key { url layers format transparent } {
453                set value [$layers get $layer.wms.$key]
454                $_tree set $child "wms.$key" $value
455            }
456            $_tree set $child "driver" "wms"
457        }
458        set xyz [$layers element -as type $layer.xyz]
459        if { $xyz != "" } {
460            foreach key { url } {
461                set value [$layers get $layer.xyz.$key]
462                $_tree set $child "xyz.$key" $value
463            }
464            $_tree set $child "driver" "xyz"
465        }
466    }
467    if {$layers != ""} {
468        rename $layers ""
469    }
470
471    # Parse viewpoints
472    set parent [$_tree findchild root "viewpoints"]
473    set viewpoints [$map element -as object "viewpoints"]
474    if { $viewpoints != "" } {
475        foreach viewpoint [$viewpoints children -type viewpoint] {
476            set name [$viewpoints element -as id "$viewpoint"]
477            if {[hasViewpoint $name]} {
478                puts stderr "ERROR: Duplicate viewpoint ID '$name', skipping"
479                continue
480            }
481            set child [$_tree insert $parent -label $name]
482            $_tree set $child "name" $viewpoint
483            set haveX 0
484            set haveZ 0
485            set haveSRS 0
486            set haveVertDatum 0
487            foreach key { label description x y z distance heading pitch srs verticalDatum } {
488                set val [$viewpoints get $viewpoint.$key]
489                if {$val != ""} {
490                    if {$key == "x"} {
491                        set haveX 1
492                    } elseif {$key == "z"} {
493                        set haveZ 1
494                    } elseif {$key == "srs"} {
495                        set haveSRS 1
496                    } elseif {$key == "verticalDatum"} {
497                        set haveVertDatum 1
498                    }
499                    $_tree set $child $key $val
500                }
501            }
502            if {!$haveX} {
503                set lat [$viewpoints get $viewpoint.latitude]
504                set long [$viewpoints get $viewpoint.longitude]
505                $_tree set $child x $long
506                $_tree set $child y $lat
507                if {!$haveSRS} {
508                    $_tree set $child srs wgs84
509                }
510                if {!$haveVertDatum} {
511                    $_tree set $child verticalDatum ""
512                }
513            }
514            if {!$haveZ} {
515                set z [$viewpoints get $viewpoint.altitude]
516                if {$z != ""} {
517                    $_tree set $child z $z
518                }
519            }
520        }
521        rename $viewpoints ""
522    }
523
524    # Fill in tool info
525    foreach {key path} {
526        toolid          tool.id
527        toolname        tool.name
528        toolcommand     tool.execute
529        tooltitle       tool.title
530        toolrevision    tool.version.application.revision
531    } {
532        set str [$xmlobj get $path]
533        if { "" != $str } {
534            $_tree set root $key $str
535        }
536    }
537
538    rename $map ""
539    set _isValid 1
540}
541
542itcl::body Rappture::Map::setToolInfo { id name command title revision } {
543    foreach key [list id name command title revision] {
544        set str [set $key]
545        if { "" != $str } {
546            $_tree set root "tool$key" $str
547        }
548    }
549}
550
551itcl::body Rappture::Map::setType { type } {
552    if { ![info exists _mapTypes($type)] } {
553        error "unknown map type \"$type\": should be one of: [join [array names _mapTypes] {, }]"
554    }
555    $_tree set root "type" $type
556}
557
558itcl::body Rappture::Map::setProjection { projection } {
559    $_tree set root "projection" $projection
560}
561
562itcl::body Rappture::Map::clearExtents {} {
563    $_tree set root "extents" ""
564}
565
566itcl::body Rappture::Map::setExtents { xmin ymin xmax ymax {srs "wgs84"} } {
567    $_tree set root "extents" [list $xmin $ymin $xmax $ymax $srs]
568}
569
570itcl::body Rappture::Map::setLabel { label } {
571    $_tree set root "label" $label
572}
573
574itcl::body Rappture::Map::setDescription { description } {
575    $_tree set root "description" $description
576}
577
578itcl::body Rappture::Map::setAttribution { attribution } {
579    $_tree set root "attribution" $attribution
580}
581
582itcl::body Rappture::Map::setStyle { style } {
583    if {$style != "" && [llength $style] % 2 != 0} {
584        error "Bad map style, must be key/value pairs"
585    }
586    array set styleinfo $style
587    foreach key [array names styleinfo] {
588        set valid 0
589        foreach validkey {-ambient -color -edgecolor -edges -lighting -linewidth -vertscale -wireframe} {
590            if {$key == $validkey} {
591                set valid 1
592                break
593            }
594        }
595        if {!$valid} {
596            error "Unknown style setting: $key"
597        }
598    }
599    $_tree set root "style" $style
600}
601
602itcl::body Rappture::Map::setCamera { camera } {
603    if {$camera != "" && [llength $camera] % 2 != 0} {
604        error "Bad camera settings, must be key/value pairs"
605    }
606    array set caminfo $camera
607    foreach key [array names caminfo] {
608        set valid 0
609        foreach validkey {layer x y latitude longitude z heading pitch distance xmin ymin xmax ymax srs verticalDatum} {
610            if {$key == $validkey} {
611                set valid 1
612                break
613            }
614        }
615        if {!$valid} {
616            error "Unknown camera setting: $key"
617        }
618    }
619    if {([info exists caminfo(x)] || [info exists caminfo(y)] ||
620         [info exists caminfo(latitude)] || [info exists caminfo(longitude)] ||
621         [info exists caminfo(z)] || [info exists caminfo(distance)]) &&
622        ([info exists caminfo(xmin)] || [info exists caminfo(xmax)] ||
623         [info exists caminfo(ymin)] || [info exists caminfo(ymax)])} {
624        error "Bad camera settings: Cannot set both focal point and extents"
625    }
626    $_tree set root "camera" $camera
627}
628
629itcl::body Rappture::Map::addLayer { type name paramArray driver driverParamArray {stylesheet {}} {script {}} {selectors {}} } {
630    set id "$name"
631    if {[hasLayer $id]} {
632        error "Layer '$id' already exists"
633    }
634    if { ![info exists _layerTypes($type)] } {
635        error "Invalid layer type \"$type\": should be one of: [join [array names _layerTypes] {, }]"
636    }
637    set parent [$_tree findchild root "layers"]
638    set child [$_tree insert $parent -label $id]
639    $_tree set $child "name" $name
640    $_tree set $child "type" $type
641    array set params $paramArray
642    foreach key { label description attribution profile srs verticalDatum } {
643        if {[info exists params($key)]} {
644            $_tree set $child $key $params($key)
645        } else {
646            $_tree set $child $key ""
647        }
648    }
649    # Common settings (for all layer types) with defaults
650    foreach { key defval } { visible 1 cache 1 shared 0 } {
651        $_tree set $child $key $defval
652        if {[info exists params($key)]} {
653            set val $params($key)
654            if {$val != ""} {
655                $_tree set $child $key $val
656            }
657        }
658    }
659    # These are settings for which there should be no default
660    # We want to know if they have been set by the user or not
661    # Not all layer types use these
662    foreach key { coverage opacity content priority style terrainPatch } {
663        if {[info exists params($key)]} {
664            set val $params($key)
665            if {$val != ""} {
666                if {$key eq "coverage" && $type ne "image"} {
667                    error "Coverage is only valid for layers of type \"image\""
668                }
669                if {$key eq "content" || $key eq "priority"} {
670                    if {$type ne "label"} {
671                        error "content and priority are only valid in layers of type \"label\""
672                    }
673                }
674                if {$key eq "opacity" && ($type eq "elevation" ||
675                    $type eq "mask")} {
676                    error  "opacity is not valid for layers of type \"elevation\" or \"mask\""
677                }
678                if {$key eq "terrainPatch" && $type ne "feature" &&
679                    $type ne "model" && $type ne "polygon"} {
680                    puts stderr "ERROR: <terrainPatch> is only valid for layers of type \"feature\", \"model\" or \"polygon\""
681                }
682                $_tree set $child $key $val
683            }
684        }
685    }
686    if {$stylesheet != ""} {
687        set val $stylesheet
688        # Normalize whitespace
689        regsub -all "\[ \t\r\n\]+" [string trim $val] " " val
690        $_tree set $child stylesheet $val
691    }
692    if {$script != ""} {
693        regsub -all "\[\r\n\]+" [string trim $script] " " script
694        $_tree set $child script $script
695    }
696    if {$selectors != ""} {
697        set sparent [$_tree insert $child -label "selectors"]
698        foreach selectorItem $selectors {
699            array set selector $selectorItem
700            if { [info exists selector(id)] } {
701                set selectorId $selector(id)
702            } else {
703                set selectorId "selector[incr _nextSelector]"
704            }
705            set snode [$_tree insert $sparent -label $selectorId]
706            foreach key { name style styleExpression query queryBounds queryOrderBy } {
707                if {[info exists selector($key)]} {
708                    set val $selector($key)
709                    if {$val != ""} {
710                        $_tree set $snode $key $val
711                    }
712                }
713            }
714        }
715    }
716    $_tree set $child "driver" $driver
717    switch -- $driver {
718        "agglite" {
719            array set params $driverParamArray
720            foreach key { url featuredriver format typeName } {
721                if {[info exists params($key)]} {
722                    set value $params($key)
723                    $_tree set $child "agglite.$key" $value
724                }
725            }
726        }
727        "arcgis" {
728            array set params $driverParamArray
729            foreach key { url token format layers } {
730                if {[info exists params($key)]} {
731                    set value $params($key)
732                    $_tree set $child "arcgis.$key" $value
733                }
734            }
735        }
736        "colorramp" {
737            array set params $driverParamArray
738            $_tree set $child "colorramp.elevdriver" "gdal"
739            $_tree set $child "colorramp.colormap" "0 0 0 0 1 1 1 1 1 1"
740            if {[info exists params(colormap)]} {
741                set cmap $params(colormap)
742                if {$cmap != ""} {
743                    # Normalize whitespace
744                    regsub -all "\[ \t\r\n\]+" [string trim $cmap] " " cmap
745                    $_tree set $child "colorramp.colormap" $cmap
746                }
747            }
748            foreach key { url elevdriver } {
749                if {[info exists params($key)]} {
750                    set value $params($key)
751                    if {$value != ""} {
752                        $_tree set $child "colorramp.$key" $value
753                    }
754                }
755            }
756        }
757        "gdal" {
758            array set params $driverParamArray
759            foreach key { url } {
760                set value $params($key)
761                $_tree set $child "gdal.$key" $value
762            }
763        }
764        "ogr" {
765            array set params $driverParamArray
766            foreach key { url } {
767                set value $params($key)
768                $_tree set $child "ogr.$key" $value
769            }
770            foreach key { connection geometry geometryUrl layer ogrDriver buildSpatialIndex } {
771                if {[info exists params($key)]} {
772                    set value $params($key)
773                    if { $value != "" } {
774                        $_tree set $child "ogr.$key" $value
775                    }
776                }
777            }
778        }
779        "osg" {
780            array set params $driverParamArray
781            foreach key { url } {
782                set value $params($key)
783                $_tree set $child "osg.$key" $value
784            }
785            $_tree set $child "osg.x" 0.0
786            $_tree set $child "osg.y" 0.0
787            $_tree set $child "osg.z" 0.0
788            $_tree set $child "osg.rotx" 0.0
789            $_tree set $child "osg.roty" 0.0
790            $_tree set $child "osg.rotz" 0.0
791            foreach key { x y z rotx roty rotz paged } {
792                if {[info exists params($key)]} {
793                    set value $params($key)
794                    if { $value != "" } {
795                        $_tree set $child "osg.$key" $value
796                    }
797                }
798            }
799        }
800        "tfs" {
801            array set params $driverParamArray
802            foreach key { url format } {
803                if {[info exists params($key)]} {
804                    set value $params($key)
805                    $_tree set $child "tfs.$key" $value
806                }
807            }
808        }
809        "tms" {
810            array set params $driverParamArray
811            foreach key { url tmsType format } {
812                if {[info exists params($key)]} {
813                    set value $params($key)
814                    $_tree set $child "tms.$key" $value
815                }
816            }
817        }
818        "wcs" {
819            array set params $driverParamArray
820            foreach key { url identifier format elevationUnit rangeSubset } {
821                if {[info exists params($key)]} {
822                    set value $params($key)
823                    $_tree set $child "wcs.$key" $value
824                }
825            }
826        }
827        "wfs" {
828            array set params $driverParamArray
829            foreach key { url typename format maxfeatures requestBuffer } {
830                if {[info exists params($key)]} {
831                    set value $params($key)
832                    $_tree set $child "wfs.$key" $value
833                }
834            }
835        }
836        "wms" {
837            array set params $driverParamArray
838            foreach key { url layers format transparent } {
839                if {[info exists params($key)]} {
840                    set value $params($key)
841                    $_tree set $child "wms.$key" $value
842                }
843            }
844        }
845        "xyz" {
846            array set params $driverParamArray
847            foreach key { url } {
848                if {[info exists params($key)]} {
849                    set value $params($key)
850                    $_tree set $child "xyz.$key" $value
851                }
852            }
853        }
854        default {
855            error "Unknown driver \"$driver\""
856        }
857    }
858    set _dirty($id) 1
859    return $id
860}
861
862itcl::body Rappture::Map::setPlacardConfig { layerName attrlist style padding } {
863    set id [$_tree findchild root->"layers" $layerName]
864    if { $id < 0 } {
865        error "unknown layer \"$layerName\""
866    }
867    set type [layer $layerName type]
868    if {$type == "image" || $type == "elevation"} {
869        error "Placard not supported on image or elevation layers"
870    }
871    array set placardConf {}
872    foreach key { padding } {
873        set placardConf($key) [set $key]
874    }
875    foreach key { attrlist style } {
876        # Normalize whitespace
877        set val [set $key]
878        regsub -all "\[ \t\r\n\]+" [string trim $val] " " val
879        set placardConf($key) $val
880    }
881    $_tree set $id "placard" [array get placardConf]
882}
883
884itcl::body Rappture::Map::getPlacardConfig { layerName } {
885    set id [$_tree findchild root->"layers" $layerName]
886    if { $id < 0 } {
887        error "unknown layer \"$layerName\""
888    }
889    return [$_tree get $id "placard" ""]
890}
891
892itcl::body Rappture::Map::deleteLayer { layerName } {
893    set id [$_tree findchild root->"layers" $layerName]
894    if { $id < 0 } {
895        error "unknown layer \"$layerName\""
896    }
897    $_tree delete $id
898    array unset _dirty $layerName
899}
900
901# ----------------------------------------------------------------------
902# USAGE: layers
903#
904# Returns a list of IDs for the layers in the map
905# ----------------------------------------------------------------------
906itcl::body Rappture::Map::layers {} {
907    set list {}
908    foreach node [$_tree children root->"layers"] {
909        lappend list [$_tree label $node]
910    }
911    return $list
912}
913
914# ----------------------------------------------------------------------
915# USAGE: viewpoints
916#
917# Returns a list of IDs for the viewpoints in the map
918# ----------------------------------------------------------------------
919itcl::body Rappture::Map::viewpoints {} {
920    set list {}
921    catch {
922        foreach node [$_tree children root->"viewpoints"] {
923            lappend list [$_tree label $node]
924        }
925    }
926    return $list
927}
928
929# ----------------------------------------------------------------------
930# USAGE: layer <layerName> <?prop?>
931#
932# Returns an array of settings for the named layer, or a single property
933# if specified.
934# ----------------------------------------------------------------------
935itcl::body Rappture::Map::layer { layerName args } {
936    set id [$_tree findchild root->"layers" $layerName]
937    if { $id < 0 } {
938        error "unknown layer \"$layerName\""
939    }
940    switch -- [llength $args] {
941        0 {
942            return [$_tree get $id]
943        }
944        1 {
945            set prop [lindex $args 0]
946            return [$_tree get $id $prop]
947        }
948        default {
949            error "wrong # args: should be \"layer <layerName> <?prop?>\""
950        }
951    }
952}
953
954itcl::body Rappture::Map::hasLayer { layerName } {
955    set id [$_tree findchild root->"layers" $layerName]
956    if { $id < 0 } {
957        return 0
958    } else {
959        return 1
960    }
961}
962
963itcl::body Rappture::Map::setScript { layerName script } {
964    set id [$_tree findchild root->"layers" $layerName]
965    if { $id < 0 } {
966        error "unknown layer \"$layerName\""
967    }
968    $_tree set $id "script" $script
969    set _dirty($layerName) 1
970}
971
972itcl::body Rappture::Map::setStylesheet { layerName stylesheet } {
973    set id [$_tree findchild root->"layers" $layerName]
974    if { $id < 0 } {
975        error "unknown layer \"$layerName\""
976    }
977    $_tree set $id "stylesheet" $stylesheet
978    set _dirty($layerName) 1
979}
980
981itcl::body Rappture::Map::setColormap { layerName colormap } {
982    set id [$_tree findchild root->"layers" $layerName]
983    if { $id < 0 } {
984        error "unknown layer \"$layerName\""
985    }
986    $_tree set $id "colorramp.colormap" $colormap
987    set _dirty($layerName) 1
988}
989
990# ----------------------------------------------------------------------
991# USAGE: selectors
992#
993# Returns a list of IDs for the selectors in a layer
994# ----------------------------------------------------------------------
995itcl::body Rappture::Map::selectors { layerName } {
996    set list {}
997    catch {
998        foreach node [$_tree children root->"layers"->"$layerName"->"selectors"] {
999            lappend list [$_tree label $node]
1000        }
1001    }
1002    return $list
1003}
1004
1005# ----------------------------------------------------------------------
1006# USAGE: selector
1007#
1008# Returns an array of settings for the named selector in the named
1009# layer
1010# ----------------------------------------------------------------------
1011itcl::body Rappture::Map::selector { layerName selectorName } {
1012    set id [$_tree findchild root->"layers"->"$layerName"->"selectors" $selectorName]
1013    if { $id < 0 } {
1014        error "unknown selector \"$selectorName\""
1015    }
1016    return [$_tree get $id]
1017}
1018
1019itcl::body Rappture::Map::hasSelector { layerName selectorName } {
1020    set id [$_tree findchild root->"layers"->"$layerName"->"selectors" $selectorName]
1021    if { $id < 0 } {
1022        return 0
1023    } else {
1024        return 1
1025    }
1026}
1027
1028itcl::body Rappture::Map::addSelector { layerName name params } {
1029    set nodeid $name
1030    set layerid [$_tree findchild root->"layers" $layerName]
1031    if { $layerid < 0 } {
1032        error "unknown layer \"$layerName\""
1033    }
1034    if {[hasSelector $layerName $nodeid]} {
1035        error "Selector '$nodeid' already exists"
1036    }
1037    set parent [$_tree findchild root->"layers"->"$layerName" "selectors"]
1038    if { $parent == "" } {
1039        set parent [$_tree insert $layerid -label "selectors"]
1040    }
1041    set child [$_tree insert $parent -label $nodeid]
1042    array set info $params
1043    foreach key { name style styleExpression query queryBounds queryOrderBy } {
1044        if { [info exists info($key)] &&
1045             $info($key) != ""} {
1046            $_tree set $child $key $info($key)
1047        }
1048    }
1049    set _dirty($layerName) 1
1050}
1051
1052itcl::body Rappture::Map::deleteSelector { layerName selectorName } {
1053    set id [$_tree findchild root->"layers"->"$layerName"->"selectors" $selectorName]
1054    if { $id < 0 } {
1055        error "unknown selector \"$selectorName\""
1056    }
1057    $_tree delete $id
1058    set _dirty($layerName) 1
1059}
1060
1061# ----------------------------------------------------------------------
1062# USAGE: viewpoint <viewpointName>
1063#
1064# Returns an array of settings for the named viewpoint
1065# ----------------------------------------------------------------------
1066itcl::body Rappture::Map::viewpoint { viewpointName } {
1067    set id [$_tree findchild root->"viewpoints" $viewpointName]
1068    if { $id < 0 } {
1069        error "unknown viewpoint \"$viewpointName\""
1070    }
1071    return [$_tree get $id]
1072}
1073
1074itcl::body Rappture::Map::hasViewpoint { viewpointName } {
1075    set id [$_tree findchild root->"viewpoints" $viewpointName]
1076    if { $id < 0 } {
1077        return 0
1078    } else {
1079        return 1
1080    }
1081}
1082
1083itcl::body Rappture::Map::addViewpoint { name props } {
1084    set nodeid $name
1085    if {[hasViewpoint $nodeid]} {
1086        error "Viewpoint '$nodeid' already exists"
1087    }
1088    set parent [$_tree findchild root "viewpoints"]
1089    set child [$_tree insert $parent -label $nodeid]
1090    $_tree set $child "name" $name
1091    set haveX 0
1092    set haveZ 0
1093    set haveSRS 0
1094    set haveVertDatum 0
1095    array set info $props
1096    foreach key { label description x y z distance heading pitch srs verticalDatum } {
1097        if {[info exists info($key)]} {
1098            set val $info($key)
1099            if {$key == "x"} {
1100                set haveX 1
1101            } elseif {$key == "z"} {
1102                set haveZ 1
1103            } elseif {$key == "srs"} {
1104                set haveSRS 1
1105            } elseif {$key == "verticalDatum"} {
1106                set haveVertDatum 1
1107            }
1108            $_tree set $child $key $val
1109        }
1110    }
1111    if {!$haveX} {
1112        set lat $info(latitude)
1113        set long $info(longitude)
1114        $_tree set $child x $long
1115        $_tree set $child y $lat
1116        if {!$haveSRS} {
1117            $_tree set $child srs wgs84
1118        }
1119        if {!$haveVertDatum} {
1120            $_tree set $child verticalDatum ""
1121        }
1122    }
1123    if {!$haveZ && [info exists info(altitude)]} {
1124        $_tree set $child z $info(altitude)
1125    }
1126    set _dirty(viewpoints) 1
1127}
1128
1129itcl::body Rappture::Map::deleteViewpoint { viewpointName } {
1130    set id [$_tree findchild root->"viewpoints" $viewpointName]
1131    if { $id < 0 } {
1132        error "unknown viewpoint \"$viewpointName\""
1133    }
1134    $_tree delete $id
1135    set _dirty(viewpoints) 1
1136}
1137
1138# ----------------------------------------------------------------------
1139# USAGE: isGeocentric
1140#
1141# Returns if the map is geocentric (1) or projected (0)
1142# ----------------------------------------------------------------------
1143itcl::body Rappture::Map::isGeocentric {} {
1144    return [expr {[hints "type"] eq "geocentric"}]
1145}
1146
1147itcl::body Rappture::Map::styleToCSS { layerType props {styleName "style"} } {
1148    append output "$styleName { "
1149    foreach {name value} $props {
1150        if {[string range $name 0 0] eq "-"} {
1151            set name [string range $name 1 end]
1152        }
1153        # These aren't really style properties
1154        if {$name eq "minrange" || $name eq "maxrange" } {
1155            continue
1156        }
1157        foreach {name value} [translateProp $layerType $name $value] {}
1158        # TODO: Fix quoting
1159        if {$name ne ""} {
1160            append output "$name: $value; "
1161        }
1162    }
1163    append output "}"
1164    return $output
1165}
1166
1167itcl::body Rappture::Map::colorToHTML { color } {
1168    foreach {r g b} [winfo rgb . $color] break
1169    return [format "#%02X%02X%02X" [expr {$r/256}] [expr {$g/256}] [expr {$b/256}]]
1170}
1171
1172itcl::body Rappture::Map::isColorProp { prop } {
1173    foreach colorprop { fill stroke point-fill text-fill text-halo } {
1174        if { $prop eq $colorprop } {
1175            return 1
1176        }
1177    }
1178    return 0
1179}
1180
1181itcl::body Rappture::Map::isBooleanProp { prop } {
1182    foreach boolprop {
1183        extrusion-flatten
1184        skin-tiled
1185        icon-declutter
1186        render-depth-test
1187        render-lighting
1188        render-transparent
1189        render-depth-offset
1190        text-declutter
1191    } {
1192        if { $prop eq $boolprop } {
1193            return 1
1194        }
1195    }
1196    return 0
1197}
1198
1199itcl::body Rappture::Map::isFileProp { prop } {
1200    foreach fileprop {
1201        icon
1202        model
1203    } {
1204        if { $prop eq $fileprop } {
1205            return 1
1206        }
1207    }
1208    return 0
1209}
1210
1211itcl::body Rappture::Map::fixQuotes { str } {
1212    return [string map {"\{" "\"" "\}" "\""} [list $str]]
1213}
1214
1215itcl::body Rappture::Map::fixEnum { str } {
1216    return [string map {"_" "-"} $str]
1217}
1218
1219itcl::body Rappture::Map::fixBoolean { val } {
1220    if { $val } {
1221        return "true"
1222    } else {
1223        return "false"
1224    }
1225}
1226
1227itcl::body Rappture::Map::translateProp { layerType styleProp styleValue } {
1228    switch -- $layerType {
1229        "icon" {
1230            array set trans {
1231                "align" "icon-align"
1232                "clamping" "altitude-clamping"
1233                "clamptechnique" "altitude-technique"
1234                "declutter" "icon-declutter"
1235                "library" "icon-library"
1236                "minbias" "render-depth-offset-min-bias"
1237                "maxbias" "render-depth-offset-max-bias"
1238                "scale" "icon-scale"
1239                "heading" "icon-heading"
1240                "placement" "icon-placement"
1241                "url" "icon"
1242            }
1243        }
1244        "label" {
1245            array set trans {
1246                "align" "text-align"
1247                "clamping" "altitude-clamping"
1248                "clamptechnique" "altitude-technique"
1249                "color" "text-fill"
1250                "content" "text-content"
1251                "declutter" "text-declutter"
1252                "font" "text-font"
1253                "fontsize" "text-size"
1254                "halocolor" "text-halo"
1255                "halowidth" "text-halo-offset"
1256                "layout" "text-layout"
1257                "minbias" "render-depth-offset-min-bias"
1258                "maxbias" "render-depth-offset-max-bias"
1259                "priority" "text-priority"
1260                "xoffset" "text-offset-x"
1261                "yoffset" "text-offset-y"
1262            }
1263        }
1264        "line" {
1265            array set trans {
1266                "cap" "stroke-linecap"
1267                "clamping" "altitude-clamping"
1268                "clamptechnique" "altitude-technique"
1269                "color" "stroke"
1270                "join" "stroke-linejoin"
1271                "minbias" "render-depth-offset-min-bias"
1272                "maxbias" "render-depth-offset-max-bias"
1273                "stipplepattern" "stroke-stipple-pattern"
1274                "stipplefactor" "stroke-stipple-factor"
1275                "width" "stroke-width"
1276            }
1277        }
1278        "point" {
1279             array set trans {
1280                "clamping" "altitude-clamping"
1281                "clamptechnique" "altitude-technique"
1282                "color" "point-fill"
1283                "minbias" "render-depth-offset-min-bias"
1284                "maxbias" "render-depth-offset-max-bias"
1285                "size" "point-size"
1286            }
1287        }
1288        "polygon" {
1289            array set trans {
1290                "clamping" "altitude-clamping"
1291                "clamptechnique" "altitude-technique"
1292                "color" "fill"
1293                "minbias" "render-depth-offset-min-bias"
1294                "maxbias" "render-depth-offset-max-bias"
1295                "strokecolor" "stroke"
1296                "strokewidth" "stroke-width"
1297            }
1298        }
1299        "image" - "elevation" - "feature" - "mask" - "model" {
1300        }
1301        default {
1302            error "Unknown layer type: \"$layerType\""
1303        }
1304    }
1305    if {[info exists trans($styleProp)]} {
1306        set styleProp $trans($styleProp)
1307    }
1308    if {[isColorProp $styleProp]} {
1309        set styleValue [colorToHTML $styleValue]
1310    }
1311    if {$styleProp eq "icon-scale" && $styleValue eq ""} {
1312        set styleProp ""
1313    }
1314    if {$styleProp eq "icon-heading" && $styleValue eq ""} {
1315        set styleProp ""
1316    }
1317    if {$styleProp eq "text-align" || $styleProp eq "icon-align"} {
1318        set styleValue [fixEnum $styleValue]
1319    }
1320    if {[isBooleanProp $styleProp]} {
1321        set styleValue [fixBoolean $styleValue]
1322    }
1323    set styleValue [fixQuotes $styleValue]
1324    return [list $styleProp $styleValue]
1325}
1326
1327itcl::body Rappture::Map::parseStylesheet { stylesheet } {
1328    set styles [list]
1329    # First split into style blocks
1330    set blocks [split $stylesheet "\{\}"]
1331    if {[llength $blocks] == 1} {
1332        set blocks [list style $blocks]
1333    }
1334    foreach {styleName block} $blocks {
1335        # Get name/value pairs
1336        set styleName [string trim $styleName]
1337        if {$styleName == ""} { set styleName "style" }
1338        set block [string trim $block " \t\n\r\{\}"]
1339        if {$block == ""} { continue }
1340        #puts stderr "styleName: \"$styleName\""
1341        #puts stderr "block: \"$block\""
1342        set lines [split $block ";"]
1343        array unset styleArray
1344        foreach line $lines {
1345            set line [string trim $line]
1346            if {$line == "" || [string index $line 0] == "#"} { continue }
1347            #puts stderr "line: \"$line\""
1348            set delim [string first ":" $line]
1349            set prop [string trim [string range $line 0 [expr {$delim-1}]]]
1350            set val [string trim [string range $line [expr {$delim+1}] end]]
1351            set styleArray($prop) $val
1352        }
1353        lappend styles $styleName [array get styleArray]
1354    }
1355    return $styles
1356}
1357
1358itcl::body Rappture::Map::getFilesFromStylesheet { stylesheet } {
1359    set files [list]
1360    set styles [parseStylesheet $stylesheet]
1361    foreach {name style} $styles {
1362        #puts stderr "Style: \"$name\""
1363        array unset info
1364        array set info $style
1365        foreach key [array names info] {
1366            #puts stderr "Prop: \"$key\" Val: \"$info($key)\""
1367            if {[isFileProp $key]} {
1368                lappend files [string trim $info($key) "\""]
1369            }
1370        }
1371    }
1372    return $files
1373}
Note: See TracBrowser for help on using the repository browser.