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

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

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