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

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

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