source: branches/geomap/gui/scripts/map.tcl @ 5949

Last change on this file since 5949 was 5949, checked in by dkearney, 7 years ago

adding data provider and layer objects, updating mapviewer to remove layers from client and server.

File size: 25.5 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: map - extracts data from an XML description of a field
4#
5#  This object represents a map of data in an XML description of
6#  simulator output.  A map is similar to a field, but a field is
7#  a quantity versus position in device.  A map is any quantity
8#  versus any other quantity.  This class simplifies the process of
9#  extracting data vectors that represent the map.
10# ======================================================================
11#  AUTHOR:  Michael McLennan, Purdue University
12#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
13#
14#  See the file "license.terms" for information on usage and
15#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
16# ======================================================================
17package require Itcl
18package require BLT
19
20namespace eval Rappture {
21    # forward declaration
22}
23
24itcl::class Rappture::Map {
25    constructor {args} {
26        # defined below
27    }
28    destructor {
29        # defined below
30    }
31
32    public method 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 }
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            $_tree set $child "driver" "ogr"
263        }
264        set tfs [$layers element -as type $layer.tfs]
265        if { $tfs != "" } {
266            foreach key { url format } {
267                set value [$layers get $layer.tfs.$key]
268                $_tree set $child "tfs.$key" $value
269            }
270            $_tree set $child "driver" "tfs"
271        }
272        set tms [$layers element -as type $layer.tms]
273        if { $tms != "" } {
274            foreach key { url tmsType format } {
275                set value [$layers get $layer.tms.$key]
276                $_tree set $child "tms.$key" $value
277            }
278            $_tree set $child "driver" "tms"
279        }
280        set wcs [$layers element -as type $layer.wcs]
281        if { $wcs != "" } {
282            foreach key { url identifier format elevationUnit rangeSubset } {
283                set value [$layers get $layer.wcs.$key]
284                $_tree set $child "wcs.$key" $value
285            }
286            $_tree set $child "driver" "wcs"
287        }
288        set wfs [$layers element -as type $layer.wfs]
289        if { $wfs != "" } {
290            foreach key { url typename format maxfeatures requestBuffer } {
291                set value [$layers get $layer.wfs.$key]
292                $_tree set $child "wfs.$key" $value
293            }
294            $_tree set $child "driver" "wfs"
295        }
296        set wms [$layers element -as type $layer.wms]
297        if { $wms != "" } {
298            foreach key { url layers format transparent } {
299                set value [$layers get $layer.wms.$key]
300                $_tree set $child "wms.$key" $value
301            }
302            $_tree set $child "driver" "wms"
303        }
304        set xyz [$layers element -as type $layer.xyz]
305        if { $xyz != "" } {
306            foreach key { url } {
307                set value [$layers get $layer.xyz.$key]
308                $_tree set $child "xyz.$key" $value
309            }
310            $_tree set $child "driver" "xyz"
311        }
312    }
313    if {$layers != ""} {
314        rename $layers ""
315    }
316
317    $_tree set root "label"       [$map get "about.label"]
318    $_tree set root "attribution" [$map get "about.attribution"]
319    $_tree set root "style"       [$map get "style"]
320    $_tree set root "camera"      [$map get "camera"]
321    set parent [$_tree insert root -label "viewpoints"]
322    set viewpoints [$map element -as object "viewpoints"]
323    if { $viewpoints != "" } {
324        foreach viewpoint [$viewpoints children -type viewpoint] {
325            set name "viewpoint[incr _nextViewpoint]"
326            set child [$_tree insert $parent -label $name]
327            $_tree set $child "name" $viewpoint
328            set haveX 0
329            set haveZ 0
330            set haveSRS 0
331            set haveVertDatum 0
332            foreach key { label description x y z distance heading pitch srs verticalDatum } {
333                set val [$viewpoints get $viewpoint.$key]
334                if {$val != ""} {
335                    if {$key == "x"} {
336                        set haveX 1
337                    } elseif {$key == "z"} {
338                        set haveZ 1
339                    } elseif {$key == "srs"} {
340                        set haveSRS 1
341                    } elseif {$key == "verticalDatum"} {
342                        set haveVertDatum 1
343                    }
344                    $_tree set $child $key $val
345                }
346            }
347            if {!$haveX} {
348                set lat [$viewpoints get $viewpoint.latitude]
349                set long [$viewpoints get $viewpoint.longitude]
350                $_tree set $child x $long
351                $_tree set $child y $lat
352                if {!$haveSRS} {
353                    $_tree set $child srs wgs84
354                }
355                if {!$haveVertDatum} {
356                    $_tree set $child verticalDatum ""
357                }
358            }
359            if {!$haveZ} {
360                set z [$viewpoints get $viewpoint.altitude]
361                if {$z != ""} {
362                    $_tree set $child z $z
363                }
364            }
365        }
366        rename $viewpoints ""
367    }
368
369    set projection [$map get "projection"]
370    set extents    [$map get "extents"]
371    if { $projection  == "" } {
372        if { $extents != "" } {
373            error "cannot specify extents without a projection"
374        }
375        set projection "global-mercator"; # Default projection.
376    } elseif { $projection == "geodetic" || $projection == "global-geodetic" ||
377           $projection == "wgs84" || $projection == "epsg:4326" ||
378           $projection == "plate-carre" || $projection == "plate-carree" } {
379        # Can't use angular units in projection 
380        error "Geodetic profile not supported as map projection.  Try using an equirectangular (epsg:32663) projection instead."
381    } elseif { $projection == "equirectangular" || $projection == "eqc-wgs84" } {
382        set projection "epsg:32663"
383    }
384    # FIXME: Verify projection is valid.
385    $_tree set root "projection" $projection
386    $_tree set root "extents"    $extents
387
388    set mapType [$map get "type"]
389    if { $mapType == "" } {
390        set mapType "projected";           # Default type is "projected".
391    }
392    if { ![info exists _mapTypes($mapType)] } {
393        error "unknown map type \"$mapType\": should be one of [array names _mapTypes]"
394    }
395    $_tree set root "type" $mapType
396
397    foreach {key path} {
398        toolid          tool.id
399        toolname        tool.name
400        toolcommand     tool.execute
401        tooltitle       tool.title
402        toolrevision    tool.version.application.revision
403    } {
404        set str [$xmlobj get $path]
405        if { "" != $str } {
406            $_tree set root $key $str
407        }
408    }
409    rename $map ""
410    set _isValid 1
411}
412
413itcl::body Rappture::Map::setToolInfo { id name command title revision } {
414    foreach key [list id name command title revision] {
415        set str [set $key]
416        if { "" != $str } {
417            $_tree set root "tool$key" $str
418        }
419    }
420}
421
422itcl::body Rappture::Map::setType { type } {
423    if { ![info exists _mapTypes($type)] } {
424        error "unknown map type \"$mapType\": should be one of [array names _mapTypes]"
425    }
426    $_tree set root "type" $type
427}
428
429itcl::body Rappture::Map::setProjection { projection } {
430    $_tree set root "projection" $projection
431}
432
433itcl::body Rappture::Map::setExtents { xmin ymin xmax ymax } {
434    $_tree set root "extents" "$xmin $ymin $xmax $ymax"
435}
436
437itcl::body Rappture::Map::setLabel { label } {
438    $_tree set root "label" $label
439}
440
441itcl::body Rappture::Map::setAttribution { attribution } {
442    $_tree set root "attribution" $attribution
443}
444
445itcl::body Rappture::Map::setStyle { style } {
446    $_tree set root "style" $style
447}
448
449itcl::body Rappture::Map::setCamera { camera } {
450    $_tree set root "camera" $camera
451}
452
453# ----------------------------------------------------------------------
454# USAGE: viewpoints
455#
456# Returns a list of IDs for the viewpoints in the map
457# ----------------------------------------------------------------------
458itcl::body Rappture::Map::viewpoints {} {
459    set list {}
460    foreach node [$_tree children root->"viewpoints"] {
461        lappend list [$_tree label $node]
462    }
463    return $list
464}
465
466# ----------------------------------------------------------------------
467# USAGE: AddLayer -format <format>
468#
469# Associate a new layer to the map
470# ----------------------------------------------------------------------
471itcl::body Rappture::Map::AddLayer { args } {
472    set layerName ""
473    set valids "-format"
474    set format "blt_tree"
475
476    set layerObj [lrange $args end end]
477    set args [lrange $args 0 end-1]
478
479    while {[llength $args] > 0} {
480        set flag [lindex $args 0]
481        switch -- $flag {
482            "-format" {
483                if {[llength $args] > 1} {
484                    set format [lindex $args 1]
485                    set args [lrange $args 2 end]
486                } else {
487                    error "wrong number args: should be ?-format <format>?"
488                }
489            }
490            default {
491                error "invalid option \"$flag\": should be one of $valids"
492            }
493        }
494    }
495
496    set valids "blt_tree"
497
498    switch -- $format {
499        "blt_tree" {
500            # check if a layer by the same name already exists
501            set layerName "layer[incr _nextLayer]"
502            if {[$_tree findchild root->"layers" $layerName] != -1} {
503                error "key error \"$layerName\": layer name exists"
504            }
505            # copy the incomming layer data into our map object
506            set id [$layerObj copy root $_tree root->"layers"]
507            # give the layer a searchable layer name
508            $_tree label $id $layerName
509        }
510        default {
511            error "bad format \"$format\": should be one of $valids"
512        }
513    }
514
515    return $layerName
516}
517
518# ----------------------------------------------------------------------
519# USAGE: DeleteLayer <layerName>
520#
521# Remove a layer from the map
522# ----------------------------------------------------------------------
523itcl::body Rappture::Map::DeleteLayer { layerName } {
524    set id [$_tree findchild root->"layers" $layerName]
525    if {$id <= 0} {
526        # layer not found
527        error "invalid layer \"$layerName\": should be one of [GetLayerNames]"
528    }
529    # delete the layer
530    $_tree delete $id
531}
532
533
534# ----------------------------------------------------------------------
535# USAGE: GetLayerNames
536# USAGE: layers
537#
538# Returns a list of IDs for the layers in the map
539# ----------------------------------------------------------------------
540itcl::body Rappture::Map::GetLayerNames {} {
541    set list {}
542    foreach node [$_tree children root->"layers"] {
543        lappend list [$_tree label $node]
544    }
545    return $list
546}
547
548# ----------------------------------------------------------------------
549# USAGE: GetLayerSettings <layerName>
550# USAGE: layer <layerName>
551#
552# Returns a list of settings for the named layer
553# ----------------------------------------------------------------------
554itcl::body Rappture::Map::GetLayerSettings { layerName } {
555    set id [$_tree findchild root->"layers" $layerName]
556    if { $id < 0 } {
557        error "unknown layer \"$layerName\""
558    }
559    return [$_tree get $id]
560}
561
562# ----------------------------------------------------------------------
563# USAGE: layer
564#
565#   This public method is called by clients using this widget to manage
566#   layers in the map.
567#
568#       layer add ?-type type? layerData
569#       layer delete layerName
570#       layer names
571#       layer settings layerName
572#
573itcl::body Rappture::Map::layer {option args} {
574    set result ""
575    switch -- $option {
576        "add" {
577            set result [eval AddLayer $args]
578        }
579        "delete" {
580            set result [eval DeleteLayer $args]
581        }
582        "names" {
583            set result [GetLayerNames]
584        }
585        "settings" {
586            set result [GetLayerSettings $args]
587        }
588        default {
589            error "unknown layer option \"$option\""
590        }
591    }
592    return $result
593}
594
595
596# ----------------------------------------------------------------------
597# USAGE: selectors
598#
599# Returns a list of IDs for the selectors in a layer
600# ----------------------------------------------------------------------
601itcl::body Rappture::Map::selectors { layerName } {
602    set list {}
603    foreach node [$_tree children root->"layers"->"$layerName"->"selectors"] {
604        lappend list [$_tree label $node]
605    }
606    return $list
607}
608
609# ----------------------------------------------------------------------
610# USAGE: selector
611#
612# Returns an array of settings for the named selector in the named
613# layer
614# ----------------------------------------------------------------------
615itcl::body Rappture::Map::selector { layerName selectorName } {
616    set id [$_tree findchild root->"layers"->"$layerName"->"selectors" $selectorName]
617    if { $id < 0 } {
618        error "unknown selector \"$selectorName\""
619    }
620    return [$_tree get $id]
621}
622
623# ----------------------------------------------------------------------
624# USAGE: viewopint <viewopintName>
625#
626# Returns an array of settings for the named viewpoint
627# ----------------------------------------------------------------------
628itcl::body Rappture::Map::viewpoint { viewopintName } {
629    set id [$_tree findchild root->"viewpoints" $viewopintName]
630    if { $id < 0 } {
631        error "unknown viewpoint \"$viewpointName\""
632    }
633    return [$_tree get $id]
634}
635
636itcl::body Rappture::Map::addViewpoint { name props } {
637    set nodeid "viewpoint[incr _nextViewpoint]"
638    set parent [$_tree findchild root "viewpoints"]
639    set child [$_tree insert $parent -label $nodeid]
640    $_tree set $child "name" $name
641    set haveX 0
642    set haveZ 0
643    set haveSRS 0
644    set haveVertDatum 0
645    array set info $props
646    foreach key { label description x y z distance heading pitch srs verticalDatum } {
647        if {[info exists info($key)]} {
648            set val $info($key)
649            if {$key == "x"} {
650                set haveX 1
651            } elseif {$key == "z"} {
652                set haveZ 1
653            } elseif {$key == "srs"} {
654                set haveSRS 1
655            } elseif {$key == "verticalDatum"} {
656                set haveVertDatum 1
657            }
658            $_tree set $child $key $val
659        }
660    }
661    if {!$haveX} {
662        set lat $info(latitude)
663        set long $info(longitude)
664        $_tree set $child x $long
665        $_tree set $child y $lat
666        if {!$haveSRS} {
667            $_tree set $child srs wgs84
668        }
669        if {!$haveVertDatum} {
670            $_tree set $child verticalDatum ""
671        }
672    }
673    if {!$haveZ && [info exists info(altitude)]} {
674        $_tree set $child z $info(altitude)
675    }
676}
677
678# ----------------------------------------------------------------------
679# USAGE: type <layerName>
680#
681# Returns the type of the named layer
682# ----------------------------------------------------------------------
683itcl::body Rappture::Map::type { layerName } {
684    set id [$_tree findchild root->"layers" $layerName]
685    if { $id < 0 } {
686        error "unknown layer \"$layerName\""
687    }
688    return [$_tree get $id "type" ""]
689}
690
691# ----------------------------------------------------------------------
692# USAGE: isGeocentric
693#
694# Returns if the map is geocentric (1) or projected (0)
695# ----------------------------------------------------------------------
696itcl::body Rappture::Map::isGeocentric {} {
697    return [expr {[hints "type"] eq "geocentric"}]
698}
699
700itcl::body Rappture::Map::earthfile {} {
701    array set info [$_tree get root]
702    append out "<map"
703    append out " name=\"$info(label)\""
704    append out " type=\"$info(type)\""
705    append out " version=\"2\""
706    append out ">\n"
707    # Profile is optional
708    if { [info exists info(projection)] } {
709        append out " <options>\n"
710        append out "  <profile"
711        append out " srs=\"$info(projection)\""
712        if { [info exists info(extents)] && $info(extents) != "" } {
713            foreach {x1 y1 x2 y2} $info(extents) break
714            append out " xmin=\"$x1\""
715            append out " ymin=\"$y1\""
716            append out " xmax=\"$x2\""
717            append out " ymax=\"$y2\""
718        }
719        append out "/>\n"
720        append out " </options>\n"
721    }
722    foreach node [$_tree children root->"layers"] {
723        array unset info
724        array set info [$_tree get $node]
725        set label [$_tree label $node]
726        switch -- $info(type) {
727            "image" {
728                append out " <image"
729                append out " name=\"$label\""
730                append out " driver=\"gdal\""
731                if { [info exists info(opacity)] } {
732                    append out " opacity=\"$info(opacity)\""
733                }
734                if { $info(visible) } {
735                    append out " visible=\"true\""
736                } else {
737                    append out " visible=\"false\""
738                }
739                append out ">\n"
740                append out "  <url>$info(url)</url>\n"
741                append out " </image>\n"
742            }
743            "elevation" {
744                append out " <elevation"
745                append out " name=\"$label\""
746                append out " driver=\"gdal\""
747                if { $info(visible) } {
748                    append out " visible=\"true\""
749                } else {
750                    append out " visible=\"false\""
751                }
752                append out ">\n"
753                append out "  <url>$info(url)</url>\n"
754                append out " </elevation>\n"
755            }
756            default {
757                puts stderr "Type $info(type) not implemented in earthfile"
758            }
759        }
760    }
761    append out "</map>\n"
762}
Note: See TracBrowser for help on using the repository browser.