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

Last change on this file since 6566 was 6566, checked in by ldelgass, 6 years ago

merge trunk to blt4_trunk

File size: 47.4 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            # These are optional
466            foreach key { times frameSeconds } {
467                set value [$layers get $layer.wms.$key]
468                if { $value != "" } {
469                    if {$key == "times"} {
470                        # Normalize whitespace
471                        regsub -all "\[ \t\r\n\]+" [string trim $value] " " value
472                    }
473                    $_tree set $child "wms.$key" $value
474                }
475            }
476            $_tree set $child "driver" "wms"
477        }
478        set xyz [$layers element -as type $layer.xyz]
479        if { $xyz != "" } {
480            foreach key { url } {
481                set value [$layers get $layer.xyz.$key]
482                $_tree set $child "xyz.$key" $value
483            }
484            $_tree set $child "driver" "xyz"
485        }
486    }
487    if {$layers != ""} {
488        rename $layers ""
489    }
490
491    # Parse viewpoints
492    set parent [$_tree findchild root "viewpoints"]
493    set viewpoints [$map element -as object "viewpoints"]
494    if { $viewpoints != "" } {
495        foreach viewpoint [$viewpoints children -type viewpoint] {
496            set name [$viewpoints element -as id "$viewpoint"]
497            if {[hasViewpoint $name]} {
498                puts stderr "ERROR: Duplicate viewpoint ID '$name', skipping"
499                continue
500            }
501            set child [$_tree insert $parent -label $name]
502            $_tree set $child "name" $viewpoint
503            set haveX 0
504            set haveZ 0
505            set haveSRS 0
506            set haveVertDatum 0
507            foreach key { label description x y z distance heading pitch srs verticalDatum } {
508                set val [$viewpoints get $viewpoint.$key]
509                if {$val != ""} {
510                    if {$key == "x"} {
511                        set haveX 1
512                    } elseif {$key == "z"} {
513                        set haveZ 1
514                    } elseif {$key == "srs"} {
515                        set haveSRS 1
516                    } elseif {$key == "verticalDatum"} {
517                        set haveVertDatum 1
518                    }
519                    $_tree set $child $key $val
520                }
521            }
522            if {!$haveX} {
523                set lat [$viewpoints get $viewpoint.latitude]
524                set long [$viewpoints get $viewpoint.longitude]
525                $_tree set $child x $long
526                $_tree set $child y $lat
527                if {!$haveSRS} {
528                    $_tree set $child srs wgs84
529                }
530                if {!$haveVertDatum} {
531                    $_tree set $child verticalDatum ""
532                }
533            }
534            if {!$haveZ} {
535                set z [$viewpoints get $viewpoint.altitude]
536                if {$z != ""} {
537                    $_tree set $child z $z
538                }
539            }
540        }
541        rename $viewpoints ""
542    }
543
544    # Fill in tool info
545    foreach {key path} {
546        toolid          tool.id
547        toolname        tool.name
548        toolcommand     tool.execute
549        tooltitle       tool.title
550        toolrevision    tool.version.application.revision
551    } {
552        set str [$xmlobj get $path]
553        if { "" != $str } {
554            $_tree set root $key $str
555        }
556    }
557
558    rename $map ""
559    set _isValid 1
560}
561
562itcl::body Rappture::Map::setToolInfo { id name command title revision } {
563    foreach key [list id name command title revision] {
564        set str [set $key]
565        if { "" != $str } {
566            $_tree set root "tool$key" $str
567        }
568    }
569}
570
571itcl::body Rappture::Map::setType { type } {
572    if { ![info exists _mapTypes($type)] } {
573        error "unknown map type \"$type\": should be one of: [join [array names _mapTypes] {, }]"
574    }
575    $_tree set root "type" $type
576}
577
578itcl::body Rappture::Map::setProjection { projection } {
579    $_tree set root "projection" $projection
580}
581
582itcl::body Rappture::Map::clearExtents {} {
583    $_tree set root "extents" ""
584}
585
586itcl::body Rappture::Map::setExtents { xmin ymin xmax ymax {srs "wgs84"} } {
587    $_tree set root "extents" [list $xmin $ymin $xmax $ymax $srs]
588}
589
590itcl::body Rappture::Map::setLabel { label } {
591    $_tree set root "label" $label
592}
593
594itcl::body Rappture::Map::setDescription { description } {
595    $_tree set root "description" $description
596}
597
598itcl::body Rappture::Map::setAttribution { attribution } {
599    $_tree set root "attribution" $attribution
600}
601
602itcl::body Rappture::Map::setStyle { style } {
603    if {$style != "" && [llength $style] % 2 != 0} {
604        error "Bad map style, must be key/value pairs"
605    }
606    array set styleinfo $style
607    foreach key [array names styleinfo] {
608        set valid 0
609        foreach validkey {-ambient -color -edgecolor -edges -lighting -linewidth -vertscale -wireframe} {
610            if {$key == $validkey} {
611                set valid 1
612                break
613            }
614        }
615        if {!$valid} {
616            error "Unknown style setting: $key"
617        }
618    }
619    $_tree set root "style" $style
620}
621
622itcl::body Rappture::Map::setCamera { camera } {
623    if {$camera != "" && [llength $camera] % 2 != 0} {
624        error "Bad camera settings, must be key/value pairs"
625    }
626    array set caminfo $camera
627    foreach key [array names caminfo] {
628        set valid 0
629        foreach validkey {layer x y latitude longitude z heading pitch distance xmin ymin xmax ymax srs verticalDatum} {
630            if {$key == $validkey} {
631                set valid 1
632                break
633            }
634        }
635        if {!$valid} {
636            error "Unknown camera setting: $key"
637        }
638    }
639    if {([info exists caminfo(x)] || [info exists caminfo(y)] ||
640         [info exists caminfo(latitude)] || [info exists caminfo(longitude)] ||
641         [info exists caminfo(z)] || [info exists caminfo(distance)]) &&
642        ([info exists caminfo(xmin)] || [info exists caminfo(xmax)] ||
643         [info exists caminfo(ymin)] || [info exists caminfo(ymax)])} {
644        error "Bad camera settings: Cannot set both focal point and extents"
645    }
646    $_tree set root "camera" $camera
647}
648
649itcl::body Rappture::Map::addLayer { type name paramArray driver driverParamArray {stylesheet {}} {script {}} {selectors {}} } {
650    set id "$name"
651    if {[hasLayer $id]} {
652        error "Layer '$id' already exists"
653    }
654    if { ![info exists _layerTypes($type)] } {
655        error "Invalid layer type \"$type\": should be one of: [join [array names _layerTypes] {, }]"
656    }
657    set parent [$_tree findchild root "layers"]
658    set child [$_tree insert $parent -label $id]
659    $_tree set $child "name" $name
660    $_tree set $child "type" $type
661    array set params $paramArray
662    foreach key { label description attribution profile srs verticalDatum } {
663        if {[info exists params($key)]} {
664            $_tree set $child $key $params($key)
665        } else {
666            $_tree set $child $key ""
667        }
668    }
669    # Common settings (for all layer types) with defaults
670    foreach { key defval } { visible 1 cache 1 shared 0 } {
671        $_tree set $child $key $defval
672        if {[info exists params($key)]} {
673            set val $params($key)
674            if {$val != ""} {
675                $_tree set $child $key $val
676            }
677        }
678    }
679    # These are settings for which there should be no default
680    # We want to know if they have been set by the user or not
681    # Not all layer types use these
682    foreach key { coverage opacity content priority style terrainPatch } {
683        if {[info exists params($key)]} {
684            set val $params($key)
685            if {$val != ""} {
686                if {$key eq "coverage" && $type ne "image"} {
687                    error "Coverage is only valid for layers of type \"image\""
688                }
689                if {$key eq "content" || $key eq "priority"} {
690                    if {$type ne "label"} {
691                        error "content and priority are only valid in layers of type \"label\""
692                    }
693                }
694                if {$key eq "opacity" && ($type eq "elevation" ||
695                    $type eq "mask")} {
696                    error  "opacity is not valid for layers of type \"elevation\" or \"mask\""
697                }
698                if {$key eq "terrainPatch" && $type ne "feature" &&
699                    $type ne "model" && $type ne "polygon"} {
700                    puts stderr "ERROR: <terrainPatch> is only valid for layers of type \"feature\", \"model\" or \"polygon\""
701                }
702                $_tree set $child $key $val
703            }
704        }
705    }
706    if {$stylesheet != ""} {
707        set val $stylesheet
708        # Normalize whitespace
709        regsub -all "\[ \t\r\n\]+" [string trim $val] " " val
710        $_tree set $child stylesheet $val
711    }
712    if {$script != ""} {
713        regsub -all "\[\r\n\]+" [string trim $script] " " script
714        $_tree set $child script $script
715    }
716    if {$selectors != ""} {
717        set sparent [$_tree insert $child -label "selectors"]
718        foreach selectorItem $selectors {
719            array set selector $selectorItem
720            if { [info exists selector(id)] } {
721                set selectorId $selector(id)
722            } else {
723                set selectorId "selector[incr _nextSelector]"
724            }
725            set snode [$_tree insert $sparent -label $selectorId]
726            foreach key { name style styleExpression query queryBounds queryOrderBy } {
727                if {[info exists selector($key)]} {
728                    set val $selector($key)
729                    if {$val != ""} {
730                        $_tree set $snode $key $val
731                    }
732                }
733            }
734        }
735    }
736    $_tree set $child "driver" $driver
737    switch -- $driver {
738        "agglite" {
739            array set params $driverParamArray
740            foreach key { url featuredriver format typeName } {
741                if {[info exists params($key)]} {
742                    set value $params($key)
743                    $_tree set $child "agglite.$key" $value
744                }
745            }
746        }
747        "arcgis" {
748            array set params $driverParamArray
749            foreach key { url token format layers } {
750                if {[info exists params($key)]} {
751                    set value $params($key)
752                    $_tree set $child "arcgis.$key" $value
753                }
754            }
755        }
756        "colorramp" {
757            array set params $driverParamArray
758            $_tree set $child "colorramp.elevdriver" "gdal"
759            $_tree set $child "colorramp.colormap" "0 0 0 0 1 1 1 1 1 1"
760            if {[info exists params(colormap)]} {
761                set cmap $params(colormap)
762                if {$cmap != ""} {
763                    # Normalize whitespace
764                    regsub -all "\[ \t\r\n\]+" [string trim $cmap] " " cmap
765                    $_tree set $child "colorramp.colormap" $cmap
766                }
767            }
768            foreach key { url elevdriver } {
769                if {[info exists params($key)]} {
770                    set value $params($key)
771                    if {$value != ""} {
772                        $_tree set $child "colorramp.$key" $value
773                    }
774                }
775            }
776        }
777        "gdal" {
778            array set params $driverParamArray
779            foreach key { url } {
780                set value $params($key)
781                $_tree set $child "gdal.$key" $value
782            }
783        }
784        "ogr" {
785            array set params $driverParamArray
786            foreach key { url } {
787                set value $params($key)
788                $_tree set $child "ogr.$key" $value
789            }
790            foreach key { connection geometry geometryUrl layer ogrDriver buildSpatialIndex } {
791                if {[info exists params($key)]} {
792                    set value $params($key)
793                    if { $value != "" } {
794                        $_tree set $child "ogr.$key" $value
795                    }
796                }
797            }
798        }
799        "osg" {
800            array set params $driverParamArray
801            foreach key { url } {
802                set value $params($key)
803                $_tree set $child "osg.$key" $value
804            }
805            $_tree set $child "osg.x" 0.0
806            $_tree set $child "osg.y" 0.0
807            $_tree set $child "osg.z" 0.0
808            $_tree set $child "osg.rotx" 0.0
809            $_tree set $child "osg.roty" 0.0
810            $_tree set $child "osg.rotz" 0.0
811            foreach key { x y z rotx roty rotz paged } {
812                if {[info exists params($key)]} {
813                    set value $params($key)
814                    if { $value != "" } {
815                        $_tree set $child "osg.$key" $value
816                    }
817                }
818            }
819        }
820        "tfs" {
821            array set params $driverParamArray
822            foreach key { url format } {
823                if {[info exists params($key)]} {
824                    set value $params($key)
825                    $_tree set $child "tfs.$key" $value
826                }
827            }
828        }
829        "tms" {
830            array set params $driverParamArray
831            foreach key { url tmsType format } {
832                if {[info exists params($key)]} {
833                    set value $params($key)
834                    $_tree set $child "tms.$key" $value
835                }
836            }
837        }
838        "wcs" {
839            array set params $driverParamArray
840            foreach key { url identifier format elevationUnit rangeSubset } {
841                if {[info exists params($key)]} {
842                    set value $params($key)
843                    $_tree set $child "wcs.$key" $value
844                }
845            }
846        }
847        "wfs" {
848            array set params $driverParamArray
849            foreach key { url typename format maxfeatures requestBuffer } {
850                if {[info exists params($key)]} {
851                    set value $params($key)
852                    $_tree set $child "wfs.$key" $value
853                }
854            }
855        }
856        "wms" {
857            array set params $driverParamArray
858            foreach key { url layers format transparent times frameSeconds } {
859                if {[info exists params($key)]} {
860                    set value $params($key)
861                    if {$key == "times"} {
862                        # Normalize whitespace
863                        regsub -all "\[ \t\r\n\]+" [string trim $value] " " value
864                    }
865                    $_tree set $child "wms.$key" $value
866                }
867            }
868        }
869        "xyz" {
870            array set params $driverParamArray
871            foreach key { url } {
872                if {[info exists params($key)]} {
873                    set value $params($key)
874                    $_tree set $child "xyz.$key" $value
875                }
876            }
877        }
878        default {
879            error "Unknown driver \"$driver\""
880        }
881    }
882    set _dirty($id) 1
883    return $id
884}
885
886itcl::body Rappture::Map::setPlacardConfig { layerName attrlist style padding } {
887    set id [$_tree findchild root->"layers" $layerName]
888    if { $id < 0 } {
889        error "unknown layer \"$layerName\""
890    }
891    set type [layer $layerName type]
892    if {$type == "image" || $type == "elevation"} {
893        error "Placard not supported on image or elevation layers"
894    }
895    array set placardConf {}
896    foreach key { padding } {
897        set placardConf($key) [set $key]
898    }
899    foreach key { attrlist style } {
900        # Normalize whitespace
901        set val [set $key]
902        regsub -all "\[ \t\r\n\]+" [string trim $val] " " val
903        set placardConf($key) $val
904    }
905    $_tree set $id "placard" [array get placardConf]
906}
907
908itcl::body Rappture::Map::getPlacardConfig { layerName } {
909    set id [$_tree findchild root->"layers" $layerName]
910    if { $id < 0 } {
911        error "unknown layer \"$layerName\""
912    }
913    return [$_tree get $id "placard" ""]
914}
915
916itcl::body Rappture::Map::deleteLayer { layerName } {
917    set id [$_tree findchild root->"layers" $layerName]
918    if { $id < 0 } {
919        error "unknown layer \"$layerName\""
920    }
921    $_tree delete $id
922    array unset _dirty $layerName
923}
924
925# ----------------------------------------------------------------------
926# USAGE: layers
927#
928# Returns a list of IDs for the layers in the map
929# ----------------------------------------------------------------------
930itcl::body Rappture::Map::layers {} {
931    set list {}
932    foreach node [$_tree children root->"layers"] {
933        lappend list [$_tree label $node]
934    }
935    return $list
936}
937
938# ----------------------------------------------------------------------
939# USAGE: viewpoints
940#
941# Returns a list of IDs for the viewpoints in the map
942# ----------------------------------------------------------------------
943itcl::body Rappture::Map::viewpoints {} {
944    set list {}
945    catch {
946        foreach node [$_tree children root->"viewpoints"] {
947            lappend list [$_tree label $node]
948        }
949    }
950    return $list
951}
952
953# ----------------------------------------------------------------------
954# USAGE: layer <layerName> <?prop?>
955#
956# Returns an array of settings for the named layer, or a single property
957# if specified.
958# ----------------------------------------------------------------------
959itcl::body Rappture::Map::layer { layerName args } {
960    set id [$_tree findchild root->"layers" $layerName]
961    if { $id < 0 } {
962        error "unknown layer \"$layerName\""
963    }
964    switch -- [llength $args] {
965        0 {
966            return [$_tree get $id]
967        }
968        1 {
969            set prop [lindex $args 0]
970            return [$_tree get $id $prop]
971        }
972        default {
973            error "wrong # args: should be \"layer <layerName> <?prop?>\""
974        }
975    }
976}
977
978itcl::body Rappture::Map::hasLayer { layerName } {
979    set id [$_tree findchild root->"layers" $layerName]
980    if { $id < 0 } {
981        return 0
982    } else {
983        return 1
984    }
985}
986
987itcl::body Rappture::Map::setScript { layerName script } {
988    set id [$_tree findchild root->"layers" $layerName]
989    if { $id < 0 } {
990        error "unknown layer \"$layerName\""
991    }
992    $_tree set $id "script" $script
993    set _dirty($layerName) 1
994}
995
996itcl::body Rappture::Map::setStylesheet { layerName stylesheet } {
997    set id [$_tree findchild root->"layers" $layerName]
998    if { $id < 0 } {
999        error "unknown layer \"$layerName\""
1000    }
1001    $_tree set $id "stylesheet" $stylesheet
1002    set _dirty($layerName) 1
1003}
1004
1005itcl::body Rappture::Map::setColormap { layerName colormap } {
1006    set id [$_tree findchild root->"layers" $layerName]
1007    if { $id < 0 } {
1008        error "unknown layer \"$layerName\""
1009    }
1010    $_tree set $id "colorramp.colormap" $colormap
1011    set _dirty($layerName) 1
1012}
1013
1014# ----------------------------------------------------------------------
1015# USAGE: selectors
1016#
1017# Returns a list of IDs for the selectors in a layer
1018# ----------------------------------------------------------------------
1019itcl::body Rappture::Map::selectors { layerName } {
1020    set list {}
1021    catch {
1022        foreach node [$_tree children root->"layers"->"$layerName"->"selectors"] {
1023            lappend list [$_tree label $node]
1024        }
1025    }
1026    return $list
1027}
1028
1029# ----------------------------------------------------------------------
1030# USAGE: selector
1031#
1032# Returns an array of settings for the named selector in the named
1033# layer
1034# ----------------------------------------------------------------------
1035itcl::body Rappture::Map::selector { layerName selectorName } {
1036    set id [$_tree findchild root->"layers"->"$layerName"->"selectors" $selectorName]
1037    if { $id < 0 } {
1038        error "unknown selector \"$selectorName\""
1039    }
1040    return [$_tree get $id]
1041}
1042
1043itcl::body Rappture::Map::hasSelector { layerName selectorName } {
1044    set id [$_tree findchild root->"layers"->"$layerName"->"selectors" $selectorName]
1045    if { $id < 0 } {
1046        return 0
1047    } else {
1048        return 1
1049    }
1050}
1051
1052itcl::body Rappture::Map::addSelector { layerName name params } {
1053    set nodeid $name
1054    set layerid [$_tree findchild root->"layers" $layerName]
1055    if { $layerid < 0 } {
1056        error "unknown layer \"$layerName\""
1057    }
1058    if {[hasSelector $layerName $nodeid]} {
1059        error "Selector '$nodeid' already exists"
1060    }
1061    set parent [$_tree findchild root->"layers"->"$layerName" "selectors"]
1062    if { $parent == "" } {
1063        set parent [$_tree insert $layerid -label "selectors"]
1064    }
1065    set child [$_tree insert $parent -label $nodeid]
1066    array set info $params
1067    foreach key { name style styleExpression query queryBounds queryOrderBy } {
1068        if { [info exists info($key)] &&
1069             $info($key) != ""} {
1070            $_tree set $child $key $info($key)
1071        }
1072    }
1073    set _dirty($layerName) 1
1074}
1075
1076itcl::body Rappture::Map::deleteSelector { layerName selectorName } {
1077    set id [$_tree findchild root->"layers"->"$layerName"->"selectors" $selectorName]
1078    if { $id < 0 } {
1079        error "unknown selector \"$selectorName\""
1080    }
1081    $_tree delete $id
1082    set _dirty($layerName) 1
1083}
1084
1085# ----------------------------------------------------------------------
1086# USAGE: viewpoint <viewpointName>
1087#
1088# Returns an array of settings for the named viewpoint
1089# ----------------------------------------------------------------------
1090itcl::body Rappture::Map::viewpoint { viewpointName } {
1091    set id [$_tree findchild root->"viewpoints" $viewpointName]
1092    if { $id < 0 } {
1093        error "unknown viewpoint \"$viewpointName\""
1094    }
1095    return [$_tree get $id]
1096}
1097
1098itcl::body Rappture::Map::hasViewpoint { viewpointName } {
1099    set id [$_tree findchild root->"viewpoints" $viewpointName]
1100    if { $id < 0 } {
1101        return 0
1102    } else {
1103        return 1
1104    }
1105}
1106
1107itcl::body Rappture::Map::addViewpoint { name props } {
1108    set nodeid $name
1109    if {[hasViewpoint $nodeid]} {
1110        error "Viewpoint '$nodeid' already exists"
1111    }
1112    set parent [$_tree findchild root "viewpoints"]
1113    set child [$_tree insert $parent -label $nodeid]
1114    $_tree set $child "name" $name
1115    set haveX 0
1116    set haveZ 0
1117    set haveSRS 0
1118    set haveVertDatum 0
1119    array set info $props
1120    foreach key { label description x y z distance heading pitch srs verticalDatum } {
1121        if {[info exists info($key)]} {
1122            set val $info($key)
1123            if {$key == "x"} {
1124                set haveX 1
1125            } elseif {$key == "z"} {
1126                set haveZ 1
1127            } elseif {$key == "srs"} {
1128                set haveSRS 1
1129            } elseif {$key == "verticalDatum"} {
1130                set haveVertDatum 1
1131            }
1132            $_tree set $child $key $val
1133        }
1134    }
1135    if {!$haveX} {
1136        set lat $info(latitude)
1137        set long $info(longitude)
1138        $_tree set $child x $long
1139        $_tree set $child y $lat
1140        if {!$haveSRS} {
1141            $_tree set $child srs wgs84
1142        }
1143        if {!$haveVertDatum} {
1144            $_tree set $child verticalDatum ""
1145        }
1146    }
1147    if {!$haveZ && [info exists info(altitude)]} {
1148        $_tree set $child z $info(altitude)
1149    }
1150    set _dirty(viewpoints) 1
1151}
1152
1153itcl::body Rappture::Map::deleteViewpoint { viewpointName } {
1154    set id [$_tree findchild root->"viewpoints" $viewpointName]
1155    if { $id < 0 } {
1156        error "unknown viewpoint \"$viewpointName\""
1157    }
1158    $_tree delete $id
1159    set _dirty(viewpoints) 1
1160}
1161
1162# ----------------------------------------------------------------------
1163# USAGE: isGeocentric
1164#
1165# Returns if the map is geocentric (1) or projected (0)
1166# ----------------------------------------------------------------------
1167itcl::body Rappture::Map::isGeocentric {} {
1168    return [expr {[hints "type"] eq "geocentric"}]
1169}
1170
1171itcl::body Rappture::Map::styleToCSS { layerType props {styleName "style"} } {
1172    append output "$styleName { "
1173    foreach {name value} $props {
1174        if {[string range $name 0 0] eq "-"} {
1175            set name [string range $name 1 end]
1176        }
1177        # These aren't really style properties
1178        if {$name eq "minrange" || $name eq "maxrange" } {
1179            continue
1180        }
1181        foreach {name value} [translateProp $layerType $name $value] {}
1182        # TODO: Fix quoting
1183        if {$name ne ""} {
1184            append output "$name: $value; "
1185        }
1186    }
1187    append output "}"
1188    return $output
1189}
1190
1191itcl::body Rappture::Map::colorToHTML { color } {
1192    foreach {r g b} [winfo rgb . $color] break
1193    return [format "#%02X%02X%02X" [expr {$r/256}] [expr {$g/256}] [expr {$b/256}]]
1194}
1195
1196itcl::body Rappture::Map::isColorProp { prop } {
1197    foreach colorprop { fill stroke point-fill text-fill text-halo } {
1198        if { $prop eq $colorprop } {
1199            return 1
1200        }
1201    }
1202    return 0
1203}
1204
1205itcl::body Rappture::Map::isBooleanProp { prop } {
1206    foreach boolprop {
1207        extrusion-flatten
1208        skin-tiled
1209        icon-declutter
1210        render-depth-test
1211        render-lighting
1212        render-transparent
1213        render-depth-offset
1214        text-declutter
1215    } {
1216        if { $prop eq $boolprop } {
1217            return 1
1218        }
1219    }
1220    return 0
1221}
1222
1223itcl::body Rappture::Map::isFileProp { prop } {
1224    foreach fileprop {
1225        icon
1226        model
1227    } {
1228        if { $prop eq $fileprop } {
1229            return 1
1230        }
1231    }
1232    return 0
1233}
1234
1235itcl::body Rappture::Map::fixQuotes { str } {
1236    return [string map {"\{" "\"" "\}" "\""} [list $str]]
1237}
1238
1239itcl::body Rappture::Map::fixEnum { str } {
1240    return [string map {"_" "-"} $str]
1241}
1242
1243itcl::body Rappture::Map::fixBoolean { val } {
1244    if { $val } {
1245        return "true"
1246    } else {
1247        return "false"
1248    }
1249}
1250
1251itcl::body Rappture::Map::translateProp { layerType styleProp styleValue } {
1252    switch -- $layerType {
1253        "icon" {
1254            array set trans {
1255                "align" "icon-align"
1256                "clamping" "altitude-clamping"
1257                "clamptechnique" "altitude-technique"
1258                "declutter" "icon-declutter"
1259                "library" "icon-library"
1260                "minbias" "render-depth-offset-min-bias"
1261                "maxbias" "render-depth-offset-max-bias"
1262                "scale" "icon-scale"
1263                "heading" "icon-heading"
1264                "placement" "icon-placement"
1265                "url" "icon"
1266            }
1267        }
1268        "label" {
1269            array set trans {
1270                "align" "text-align"
1271                "clamping" "altitude-clamping"
1272                "clamptechnique" "altitude-technique"
1273                "color" "text-fill"
1274                "content" "text-content"
1275                "declutter" "text-declutter"
1276                "font" "text-font"
1277                "fontsize" "text-size"
1278                "halocolor" "text-halo"
1279                "halowidth" "text-halo-offset"
1280                "layout" "text-layout"
1281                "minbias" "render-depth-offset-min-bias"
1282                "maxbias" "render-depth-offset-max-bias"
1283                "priority" "text-priority"
1284                "xoffset" "text-offset-x"
1285                "yoffset" "text-offset-y"
1286            }
1287        }
1288        "line" {
1289            array set trans {
1290                "cap" "stroke-linecap"
1291                "clamping" "altitude-clamping"
1292                "clamptechnique" "altitude-technique"
1293                "color" "stroke"
1294                "join" "stroke-linejoin"
1295                "minbias" "render-depth-offset-min-bias"
1296                "maxbias" "render-depth-offset-max-bias"
1297                "stipplepattern" "stroke-stipple-pattern"
1298                "stipplefactor" "stroke-stipple-factor"
1299                "width" "stroke-width"
1300            }
1301        }
1302        "point" {
1303             array set trans {
1304                "clamping" "altitude-clamping"
1305                "clamptechnique" "altitude-technique"
1306                "color" "point-fill"
1307                "minbias" "render-depth-offset-min-bias"
1308                "maxbias" "render-depth-offset-max-bias"
1309                "size" "point-size"
1310            }
1311        }
1312        "polygon" {
1313            array set trans {
1314                "clamping" "altitude-clamping"
1315                "clamptechnique" "altitude-technique"
1316                "color" "fill"
1317                "minbias" "render-depth-offset-min-bias"
1318                "maxbias" "render-depth-offset-max-bias"
1319                "strokecolor" "stroke"
1320                "strokewidth" "stroke-width"
1321            }
1322        }
1323        "image" - "elevation" - "feature" - "mask" - "model" {
1324        }
1325        default {
1326            error "Unknown layer type: \"$layerType\""
1327        }
1328    }
1329    if {[info exists trans($styleProp)]} {
1330        set styleProp $trans($styleProp)
1331    }
1332    if {[isColorProp $styleProp]} {
1333        set styleValue [colorToHTML $styleValue]
1334    }
1335    if {$styleProp eq "icon-scale" && $styleValue eq ""} {
1336        set styleProp ""
1337    }
1338    if {$styleProp eq "icon-heading" && $styleValue eq ""} {
1339        set styleProp ""
1340    }
1341    if {$styleProp eq "text-align" || $styleProp eq "icon-align"} {
1342        set styleValue [fixEnum $styleValue]
1343    }
1344    if {[isBooleanProp $styleProp]} {
1345        set styleValue [fixBoolean $styleValue]
1346    }
1347    set styleValue [fixQuotes $styleValue]
1348    return [list $styleProp $styleValue]
1349}
1350
1351itcl::body Rappture::Map::parseStylesheet { stylesheet } {
1352    set styles [list]
1353    # First split into style blocks
1354    set blocks [split $stylesheet "\{\}"]
1355    if {[llength $blocks] == 1} {
1356        set blocks [list style $blocks]
1357    }
1358    foreach {styleName block} $blocks {
1359        # Get name/value pairs
1360        set styleName [string trim $styleName]
1361        if {$styleName == ""} { set styleName "style" }
1362        set block [string trim $block " \t\n\r\{\}"]
1363        if {$block == ""} { continue }
1364        #puts stderr "styleName: \"$styleName\""
1365        #puts stderr "block: \"$block\""
1366        set lines [split $block ";"]
1367        array unset styleArray
1368        foreach line $lines {
1369            set line [string trim $line]
1370            if {$line == "" || [string index $line 0] == "#"} { continue }
1371            #puts stderr "line: \"$line\""
1372            set delim [string first ":" $line]
1373            set prop [string trim [string range $line 0 [expr {$delim-1}]]]
1374            set val [string trim [string range $line [expr {$delim+1}] end]]
1375            set styleArray($prop) $val
1376        }
1377        lappend styles $styleName [array get styleArray]
1378    }
1379    return $styles
1380}
1381
1382itcl::body Rappture::Map::getFilesFromStylesheet { stylesheet } {
1383    set files [list]
1384    set styles [parseStylesheet $stylesheet]
1385    foreach {name style} $styles {
1386        #puts stderr "Style: \"$name\""
1387        array unset info
1388        array set info $style
1389        foreach key [array names info] {
1390            #puts stderr "Prop: \"$key\" Val: \"$info($key)\""
1391            if {[isFileProp $key]} {
1392                lappend files [string trim $info($key) "\""]
1393            }
1394        }
1395    }
1396    return $files
1397}
Note: See TracBrowser for help on using the repository browser.