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

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

merging in mapping layer objects, examples, and tests from the geomap branch.
File size: 25.9 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 addViewpoint { name props }
33    public method earthfile {}
34    public method hints { args }
35    public method isGeocentric {}
36    public method isvalid {} {
37        return $_isValid;
38    }
39    public method layer { option args }
40    public method layers {}
41    public method selectors { layerName }
42    public method selector { layerName selectorName }
43    public method setAttribution { attribution }
44    public method setCamera { camera }
45    public method setExtents { xmin ymin xmax ymax {srs "wgs84"} }
46    public method setLabel { label }
47    public method setProjection { projection }
48    public method setStyle { style }
49    public method setToolInfo { id name command title revision }
50    public method setType { type }
51    public method type { layerName }
52    public method viewpoint { viewpointName }
53    public method viewpoints {}
54
55    protected method Parse { xmlobj path }
56
57    private method AddLayer { args }
58    private method DeleteLayer { layerName }
59    private method GetLayerNames {}
60    private method GetLayerSettings { layerName }
61
62
63    private variable _tree "";         # Tree of information about the map.
64    private variable _isValid 0;
65    private common _nextLayer 0;       # Counter used to generate unique
66                                       # layer names.
67    private common _nextSelector 0;
68    private common _nextViewpoint 0;   # Counter used to generate unique
69                                       # viewpoint names.
70    private common _layerTypes
71    private common _mapTypes
72    array set _layerTypes {
73        "image"         0
74        "elevation"     1
75        "feature"       2
76        "polygon"       3
77        "point"         4
78        "icon"          5
79        "line"          6
80        "label"         7
81    }
82    array set _mapTypes {
83        "geocentric"    0
84        "projected"     1
85    }
86}
87
88# ----------------------------------------------------------------------
89# CONSTRUCTOR
90# ----------------------------------------------------------------------
91itcl::body Rappture::Map::constructor {args} {
92    if {$args == ""} {
93        set _tree [blt::tree create]
94        setLabel "Map"
95        setType "projected"
96        setProjection "global-mercator"
97        $_tree set root "extents" ""
98        setStyle ""
99        setCamera ""
100        $_tree insert root -label "layers"
101        $_tree insert root -label "viewpoints"
102        set _isValid 1
103    } else {
104        set xmlobj [lindex $args 0]
105        set path [lindex $args 1]
106        if {![Rappture::library isvalid $xmlobj]} {
107            error "bad value \"$xmlobj\": should be LibraryObj"
108        }
109        Parse $xmlobj $path
110    }
111}
112
113# ----------------------------------------------------------------------
114# DESTRUCTOR
115# ----------------------------------------------------------------------
116itcl::body Rappture::Map::destructor {} {
117    if { $_tree != "" } {
118        blt::tree destroy $_tree
119    }
120}
121
122itcl::body Rappture::Map::hints { args } {
123    switch -- [llength $args] {
124        0 {
125            return [$_tree get root]
126        }
127        1 {
128            set field [lindex $args 0]
129            return [$_tree get root $field ""]
130        }
131        default {
132            error "wrong # args: should be \"hints ?name?\""
133        }
134    }
135}
136
137#
138# Parse --
139#
140#   Parses the map description in the XML object.
141#
142itcl::body Rappture::Map::Parse { xmlobj path } {
143
144    set map [$xmlobj element -as object $path]
145
146    if { $_tree != "" } {
147        blt::tree destroy $_tree
148    }
149    set _tree [blt::tree create]
150    set parent [$_tree insert root -label "layers"]
151    set layers [$map element -as object "layers"]
152    foreach layer [$layers children -type layer] {
153        # Unique identifier for layer.
154        set name "layer[incr _nextLayer]"
155        set child [$_tree insert $parent -label $name]
156        set layerType [$layers get $layer.type]
157        if { ![info exists _layerTypes($layerType)] } {
158            error "invalid layer type \"$layerType\": should be one of [array names _layerTypes]"
159        }
160        $_tree set $child "name" $layer
161        $_tree set $child "type" $layerType
162        foreach key { label description attribution profile srs verticalDatum } {
163            $_tree set $child $key [$layers get $layer.$key]
164        }
165        # Common settings (for all layer types) with defaults
166        foreach { key defval } { visible 1 cache 1 } {
167            $_tree set $child $key $defval
168            set val [$layers get $layer.$key]
169            if {$val != ""} {
170                $_tree set $child $key $val
171            }
172        }
173        # These are settings for which there should be no default
174        # We want to know if they have been set by the user or not
175        # Not all layer types use these
176        foreach key { coverage opacity content priority style } {
177            set val [$layers get $layer.$key]
178            if {$val != ""} {
179                $_tree set $child $key $val
180            }
181        }
182        set styles [$layers element -as object $layer.styles]
183        if {$styles != ""} {
184            set val [$styles get stylesheet]
185            # Normalize whitespace
186            regsub -all "\[ \t\r\n\]+" [string trim $val] " " val
187            $_tree set $child stylesheet $val
188            set script [$styles get script]
189            if {$script != ""} {
190                regsub -all "\[\r\n\]+" [string trim $script] " " script
191                $_tree set $child script $script
192            }
193            set sparent [$_tree insert $child -label "selectors"]
194            foreach selector [$styles children -type selector] {
195                set id "selector[incr _nextSelector]"
196                set snode [$_tree insert $sparent -label $id]
197                foreach key { name style styleExpression query queryBounds queryOrderBy } {
198                    set val [$styles get $selector.$key]
199                    if {$val != ""} {
200                        $_tree set $snode $key $val
201                    }
202                }
203            }
204            rename $styles ""
205        }
206        $_tree set $child "driver" "debug"
207        set colorramp [$layers element -as type $layer.colorramp]
208        if { $colorramp != "" } {
209            $_tree set $child "colorramp.elevdriver" "gdal"
210            $_tree set $child "colorramp.colormap" "0 0 0 0 1 1 1 1 1 1"
211            set cmap [$layers get $layer.colorramp.colormap]
212            if {$cmap != ""} {
213                # Normalize whitespace
214                regsub -all "\[ \t\r\n\]+" [string trim $cmap] " " cmap
215                $_tree set $child "colorramp.colormap" $cmap
216            }
217            foreach key { url elevdriver } {
218                set value [$layers get $layer.colorramp.$key]
219                if {$value != ""} {
220                    $_tree set $child "colorramp.$key" $value
221                }
222            }
223            set file [$layers get $layer.colorramp.file]
224            if { $file != "" } {
225                # FIXME: Add test for valid file path
226                $_tree set $child "colorramp.url" $file
227            }
228            $_tree set $child "driver" "colorramp"
229        }
230        set arcgis [$layers element -as type $layer.arcgis]
231        if { $arcgis != "" } {
232            foreach key { url token format layers } {
233                set value [$layers get $layer.arcgis.$key]
234                $_tree set $child "arcgis.$key" $value
235            }
236            $_tree set $child "driver" "arcgis"
237        }
238        set gdal [$layers element -as type $layer.gdal]
239        if { $gdal != "" } {
240            foreach key { url } {
241                set value [$layers get $layer.gdal.$key]
242                $_tree set $child "gdal.$key" $value
243            }
244            set file [$layers get $layer.gdal.file]
245            if { $file != "" } {
246                # FIXME: Add test for valid file path
247                $_tree set $child "gdal.url" $file
248            }
249            $_tree set $child "driver" "gdal"
250        }
251        set ogr [$layers element -as type $layer.ogr]
252        if { $ogr != "" } {
253            foreach key { url } {
254                set value [$layers get $layer.ogr.$key]
255                $_tree set $child "ogr.$key" $value
256            }
257            set file [$layers get $layer.ogr.file]
258            if { $file != "" } {
259                # FIXME: Add test for valid file path
260                $_tree set $child "ogr.url" $file
261            }
262            foreach key { connection geometry geometry_url layer ogr_driver build_spatial_index } {
263                set value [$layers get $layer.ogr.$key]
264                if { $value != "" } {
265                    $_tree set $child "ogr.$key" $value
266                }
267            }
268            $_tree set $child "driver" "ogr"
269        }
270        set tfs [$layers element -as type $layer.tfs]
271        if { $tfs != "" } {
272            foreach key { url format } {
273                set value [$layers get $layer.tfs.$key]
274                $_tree set $child "tfs.$key" $value
275            }
276            $_tree set $child "driver" "tfs"
277        }
278        set tms [$layers element -as type $layer.tms]
279        if { $tms != "" } {
280            foreach key { url tmsType format } {
281                set value [$layers get $layer.tms.$key]
282                $_tree set $child "tms.$key" $value
283            }
284            $_tree set $child "driver" "tms"
285        }
286        set wcs [$layers element -as type $layer.wcs]
287        if { $wcs != "" } {
288            foreach key { url identifier format elevationUnit rangeSubset } {
289                set value [$layers get $layer.wcs.$key]
290                $_tree set $child "wcs.$key" $value
291            }
292            $_tree set $child "driver" "wcs"
293        }
294        set wfs [$layers element -as type $layer.wfs]
295        if { $wfs != "" } {
296            foreach key { url typename format maxfeatures requestBuffer } {
297                set value [$layers get $layer.wfs.$key]
298                $_tree set $child "wfs.$key" $value
299            }
300            $_tree set $child "driver" "wfs"
301        }
302        set wms [$layers element -as type $layer.wms]
303        if { $wms != "" } {
304            foreach key { url layers format transparent } {
305                set value [$layers get $layer.wms.$key]
306                $_tree set $child "wms.$key" $value
307            }
308            $_tree set $child "driver" "wms"
309        }
310        set xyz [$layers element -as type $layer.xyz]
311        if { $xyz != "" } {
312            foreach key { url } {
313                set value [$layers get $layer.xyz.$key]
314                $_tree set $child "xyz.$key" $value
315            }
316            $_tree set $child "driver" "xyz"
317        }
318    }
319    if {$layers != ""} {
320        rename $layers ""
321    }
322
323    $_tree set root "label"       [$map get "about.label"]
324    $_tree set root "attribution" [$map get "about.attribution"]
325    $_tree set root "style"       [$map get "style"]
326    $_tree set root "camera"      [$map get "camera"]
327    set parent [$_tree insert root -label "viewpoints"]
328    set viewpoints [$map element -as object "viewpoints"]
329    if { $viewpoints != "" } {
330        foreach viewpoint [$viewpoints children -type viewpoint] {
331            set name "viewpoint[incr _nextViewpoint]"
332            set child [$_tree insert $parent -label $name]
333            $_tree set $child "name" $viewpoint
334            set haveX 0
335            set haveZ 0
336            set haveSRS 0
337            set haveVertDatum 0
338            foreach key { label description x y z distance heading pitch srs verticalDatum } {
339                set val [$viewpoints get $viewpoint.$key]
340                if {$val != ""} {
341                    if {$key == "x"} {
342                        set haveX 1
343                    } elseif {$key == "z"} {
344                        set haveZ 1
345                    } elseif {$key == "srs"} {
346                        set haveSRS 1
347                    } elseif {$key == "verticalDatum"} {
348                        set haveVertDatum 1
349                    }
350                    $_tree set $child $key $val
351                }
352            }
353            if {!$haveX} {
354                set lat [$viewpoints get $viewpoint.latitude]
355                set long [$viewpoints get $viewpoint.longitude]
356                $_tree set $child x $long
357                $_tree set $child y $lat
358                if {!$haveSRS} {
359                    $_tree set $child srs wgs84
360                }
361                if {!$haveVertDatum} {
362                    $_tree set $child verticalDatum ""
363                }
364            }
365            if {!$haveZ} {
366                set z [$viewpoints get $viewpoint.altitude]
367                if {$z != ""} {
368                    $_tree set $child z $z
369                }
370            }
371        }
372        rename $viewpoints ""
373    }
374
375    set projection [$map get "projection"]
376    set extents    [$map get "extents"]
377    if { $projection  == "" } {
378        if { $extents != "" } {
379            error "cannot specify extents without a projection"
380        }
381        set projection "global-mercator"; # Default projection.
382    } elseif { $projection == "geodetic" || $projection == "global-geodetic" ||
383           $projection == "wgs84" || $projection == "epsg:4326" ||
384           $projection == "plate-carre" || $projection == "plate-carree" } {
385        # Can't use angular units in projection 
386        error "Geodetic profile not supported as map projection.  Try using an equirectangular (epsg:32663) projection instead."
387    } elseif { $projection == "equirectangular" || $projection == "eqc-wgs84" } {
388        set projection "epsg:32663"
389    }
390    # FIXME: Verify projection is valid.
391    $_tree set root "projection" $projection
392    $_tree set root "extents"    $extents
393
394    set mapType [$map get "type"]
395    if { $mapType == "" } {
396        set mapType "projected";           # Default type is "projected".
397    }
398    if { ![info exists _mapTypes($mapType)] } {
399        error "unknown map type \"$mapType\": should be one of [array names _mapTypes]"
400    }
401    $_tree set root "type" $mapType
402
403    foreach {key path} {
404        toolid          tool.id
405        toolname        tool.name
406        toolcommand     tool.execute
407        tooltitle       tool.title
408        toolrevision    tool.version.application.revision
409    } {
410        set str [$xmlobj get $path]
411        if { "" != $str } {
412            $_tree set root $key $str
413        }
414    }
415    rename $map ""
416    set _isValid 1
417}
418
419itcl::body Rappture::Map::setToolInfo { id name command title revision } {
420    foreach key [list id name command title revision] {
421        set str [set $key]
422        if { "" != $str } {
423            $_tree set root "tool$key" $str
424        }
425    }
426}
427
428itcl::body Rappture::Map::setType { type } {
429    if { ![info exists _mapTypes($type)] } {
430        error "unknown map type \"$mapType\": should be one of [array names _mapTypes]"
431    }
432    $_tree set root "type" $type
433}
434
435itcl::body Rappture::Map::setProjection { projection } {
436    $_tree set root "projection" $projection
437}
438
439itcl::body Rappture::Map::setExtents { xmin ymin xmax ymax {srs "wgs84"} } {
440    $_tree set root "extents" [list $xmin $ymin $xmax $ymax $srs]
441}
442
443itcl::body Rappture::Map::setLabel { label } {
444    $_tree set root "label" $label
445}
446
447itcl::body Rappture::Map::setAttribution { attribution } {
448    $_tree set root "attribution" $attribution
449}
450
451itcl::body Rappture::Map::setStyle { style } {
452    $_tree set root "style" $style
453}
454
455itcl::body Rappture::Map::setCamera { camera } {
456    $_tree set root "camera" $camera
457}
458
459# ----------------------------------------------------------------------
460# USAGE: viewpoints
461#
462# Returns a list of IDs for the viewpoints in the map
463# ----------------------------------------------------------------------
464itcl::body Rappture::Map::viewpoints {} {
465    set list {}
466    catch {
467        foreach node [$_tree children root->"viewpoints"] {
468            lappend list [$_tree label $node]
469        }
470    }
471    return $list
472}
473
474# ----------------------------------------------------------------------
475# USAGE: AddLayer -format <format>
476#
477# Associate a new layer to the map
478# ----------------------------------------------------------------------
479itcl::body Rappture::Map::AddLayer { args } {
480    set layerName ""
481    set valids "-format"
482    set format "blt_tree"
483
484    set layerObj [lrange $args end end]
485    set args [lrange $args 0 end-1]
486
487    while {[llength $args] > 0} {
488        set flag [lindex $args 0]
489        switch -- $flag {
490            "-format" {
491                if {[llength $args] > 1} {
492                    set format [lindex $args 1]
493                    set args [lrange $args 2 end]
494                } else {
495                    error "wrong number args: should be ?-format <format>?"
496                }
497            }
498            default {
499                error "invalid option \"$flag\": should be one of $valids"
500            }
501        }
502    }
503
504    set valids "blt_tree"
505
506    switch -- $format {
507        "blt_tree" {
508            # check if a layer by the same name already exists
509            set layerName "layer[incr _nextLayer]"
510            if {[$_tree findchild root->"layers" $layerName] != -1} {
511                error "key error \"$layerName\": layer name exists"
512            }
513            # copy the incomming layer data into our map object
514            set id [$layerObj copy root $_tree root->"layers"]
515            # give the layer a searchable layer name
516            $_tree label $id $layerName
517        }
518        default {
519            error "bad format \"$format\": should be one of $valids"
520        }
521    }
522
523    return $layerName
524}
525
526# ----------------------------------------------------------------------
527# USAGE: DeleteLayer <layerName>
528#
529# Remove a layer from the map
530# ----------------------------------------------------------------------
531itcl::body Rappture::Map::DeleteLayer { layerName } {
532    set id [$_tree findchild root->"layers" $layerName]
533    if {$id <= 0} {
534        # layer not found
535        error "invalid layer \"$layerName\": should be one of [GetLayerNames]"
536    }
537    # delete the layer
538    $_tree delete $id
539}
540
541
542# ----------------------------------------------------------------------
543# USAGE: GetLayerNames
544# USAGE: layers
545#
546# Returns a list of IDs for the layers in the map
547# ----------------------------------------------------------------------
548itcl::body Rappture::Map::GetLayerNames {} {
549    set list {}
550    foreach node [$_tree children root->"layers"] {
551        lappend list [$_tree label $node]
552    }
553    return $list
554}
555
556# ----------------------------------------------------------------------
557# USAGE: GetLayerSettings <layerName>
558# USAGE: layer <layerName>
559#
560# Returns a list of settings for the named layer
561# ----------------------------------------------------------------------
562itcl::body Rappture::Map::GetLayerSettings { layerName } {
563    set id [$_tree findchild root->"layers" $layerName]
564    if { $id < 0 } {
565        error "unknown layer \"$layerName\""
566    }
567    return [$_tree get $id]
568}
569
570# ----------------------------------------------------------------------
571# USAGE: layer
572#
573#   This public method is called by clients using this widget to manage
574#   layers in the map.
575#
576#       layer add ?-type type? layerData
577#       layer delete layerName
578#       layer names
579#       layer settings layerName
580#
581itcl::body Rappture::Map::layer {option args} {
582    set result ""
583    switch -- $option {
584        "add" {
585            set result [eval AddLayer $args]
586        }
587        "delete" {
588            set result [eval DeleteLayer $args]
589        }
590        "names" {
591            set result [GetLayerNames]
592        }
593        "settings" {
594            set result [GetLayerSettings $args]
595        }
596        default {
597            error "unknown layer option \"$option\""
598        }
599    }
600    return $result
601}
602
603
604# ----------------------------------------------------------------------
605# USAGE: selectors
606#
607# Returns a list of IDs for the selectors in a layer
608# ----------------------------------------------------------------------
609itcl::body Rappture::Map::selectors { layerName } {
610    set list {}
611    catch {
612        foreach node [$_tree children root->"layers"->"$layerName"->"selectors"] {
613            lappend list [$_tree label $node]
614        }
615    }
616    return $list
617}
618
619# ----------------------------------------------------------------------
620# USAGE: selector
621#
622# Returns an array of settings for the named selector in the named
623# layer
624# ----------------------------------------------------------------------
625itcl::body Rappture::Map::selector { layerName selectorName } {
626    set id [$_tree findchild root->"layers"->"$layerName"->"selectors" $selectorName]
627    if { $id < 0 } {
628        error "unknown selector \"$selectorName\""
629    }
630    return [$_tree get $id]
631}
632
633# ----------------------------------------------------------------------
634# USAGE: viewopint <viewopintName>
635#
636# Returns an array of settings for the named viewpoint
637# ----------------------------------------------------------------------
638itcl::body Rappture::Map::viewpoint { viewopintName } {
639    set id [$_tree findchild root->"viewpoints" $viewopintName]
640    if { $id < 0 } {
641        error "unknown viewpoint \"$viewpointName\""
642    }
643    return [$_tree get $id]
644}
645
646itcl::body Rappture::Map::addViewpoint { name props } {
647    set nodeid "viewpoint[incr _nextViewpoint]"
648    set parent [$_tree findchild root "viewpoints"]
649    set child [$_tree insert $parent -label $nodeid]
650    $_tree set $child "name" $name
651    set haveX 0
652    set haveZ 0
653    set haveSRS 0
654    set haveVertDatum 0
655    array set info $props
656    foreach key { label description x y z distance heading pitch srs verticalDatum } {
657        if {[info exists info($key)]} {
658            set val $info($key)
659            if {$key == "x"} {
660                set haveX 1
661            } elseif {$key == "z"} {
662                set haveZ 1
663            } elseif {$key == "srs"} {
664                set haveSRS 1
665            } elseif {$key == "verticalDatum"} {
666                set haveVertDatum 1
667            }
668            $_tree set $child $key $val
669        }
670    }
671    if {!$haveX} {
672        set lat $info(latitude)
673        set long $info(longitude)
674        $_tree set $child x $long
675        $_tree set $child y $lat
676        if {!$haveSRS} {
677            $_tree set $child srs wgs84
678        }
679        if {!$haveVertDatum} {
680            $_tree set $child verticalDatum ""
681        }
682    }
683    if {!$haveZ && [info exists info(altitude)]} {
684        $_tree set $child z $info(altitude)
685    }
686}
687
688# ----------------------------------------------------------------------
689# USAGE: type <layerName>
690#
691# Returns the type of the named layer
692# ----------------------------------------------------------------------
693itcl::body Rappture::Map::type { layerName } {
694    set id [$_tree findchild root->"layers" $layerName]
695    if { $id < 0 } {
696        error "unknown layer \"$layerName\""
697    }
698    return [$_tree get $id "type" ""]
699}
700
701# ----------------------------------------------------------------------
702# USAGE: isGeocentric
703#
704# Returns if the map is geocentric (1) or projected (0)
705# ----------------------------------------------------------------------
706itcl::body Rappture::Map::isGeocentric {} {
707    return [expr {[hints "type"] eq "geocentric"}]
708}
709
710itcl::body Rappture::Map::earthfile {} {
711    array set info [$_tree get root]
712    append out "<map"
713    append out " name=\"$info(label)\""
714    append out " type=\"$info(type)\""
715    append out " version=\"2\""
716    append out ">\n"
717    # Profile is optional
718    if { [info exists info(projection)] } {
719        append out " <options>\n"
720        append out "  <profile"
721        append out " srs=\"$info(projection)\""
722        if { [info exists info(extents)] && $info(extents) != "" } {
723            foreach {x1 y1 x2 y2} $info(extents) break
724            append out " xmin=\"$x1\""
725            append out " ymin=\"$y1\""
726            append out " xmax=\"$x2\""
727            append out " ymax=\"$y2\""
728        }
729        append out "/>\n"
730        append out " </options>\n"
731    }
732    foreach node [$_tree children root->"layers"] {
733        array unset info
734        array set info [$_tree get $node]
735        set label [$_tree label $node]
736        switch -- $info(type) {
737            "image" {
738                append out " <image"
739                append out " name=\"$label\""
740                append out " driver=\"gdal\""
741                if { [info exists info(opacity)] } {
742                    append out " opacity=\"$info(opacity)\""
743                }
744                if { $info(visible) } {
745                    append out " visible=\"true\""
746                } else {
747                    append out " visible=\"false\""
748                }
749                append out ">\n"
750                append out "  <url>$info(url)</url>\n"
751                append out " </image>\n"
752            }
753            "elevation" {
754                append out " <elevation"
755                append out " name=\"$label\""
756                append out " driver=\"gdal\""
757                if { $info(visible) } {
758                    append out " visible=\"true\""
759                } else {
760                    append out " visible=\"false\""
761                }
762                append out ">\n"
763                append out "  <url>$info(url)</url>\n"
764                append out " </elevation>\n"
765            }
766            default {
767                puts stderr "Type $info(type) not implemented in earthfile"
768            }
769        }
770    }
771    append out "</map>\n"
772}
Note: See TracBrowser for help on using the repository browser.