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

Last change on this file since 4661 was 4576, checked in by ldelgass, 10 years ago

Update client to handle new server protocol (map coords returns srs info, new
screen coords reply). Also, in map XML parser, if profile is set to "geodetic"
with no extents, convert to "global-geodetic" named profile.
File size: 12.1 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2
3# ----------------------------------------------------------------------
4#  COMPONENT: map - extracts data from an XML description of a field
5#
6#  This object represents a map of data in an XML description of
7#  simulator output.  A map is similar to a field, but a field is
8#  a quantity versus position in device.  A map is any quantity
9#  versus any other quantity.  This class simplifies the process of
10#  extracting data vectors that represent the map.
11# ======================================================================
12#  AUTHOR:  Michael McLennan, Purdue University
13#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
14#
15#  See the file "license.terms" for information on usage and
16#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
17# ======================================================================
18package require Itcl
19package require BLT
20
21namespace eval Rappture {
22    # forward declaration
23}
24
25itcl::class Rappture::Map {
26    private variable _tree "";         # Tree of information about the map.
27    private variable _isValid 0;
28    private common _nextLayer 0;        # Counter used to generate unique
29                                       # layer names.
30    private common _layerTypes
31    private common _mapTypes
32    array set _layerTypes {
33        "image"         0
34        "elevation"     1
35        "polygon"       2
36        "points"        3
37        "icon"          4
38        "line"          5
39        "label"         6
40    }
41    array set _mapTypes {
42        "geocentric"    0
43        "projected"     1
44    }
45    protected method Parse { xmlobj path }
46
47    constructor {xmlobj path} {
48        # defined below
49    }
50    destructor {
51        # defined below
52    }
53
54    public method isGeocentric {}
55    public method layers {}
56    public method layer { layerName }
57    public method hints { args }
58    public method isvalid {} {
59        return $_isValid;
60    }
61    public method type { layerName }
62    public method earthfile {}
63}
64
65# ----------------------------------------------------------------------
66# CONSTRUCTOR
67# ----------------------------------------------------------------------
68itcl::body Rappture::Map::constructor {xmlobj path} {
69    if {![Rappture::library isvalid $xmlobj]} {
70        error "bad value \"$xmlobj\": should be LibraryObj"
71    }
72    Parse $xmlobj $path
73}
74
75# ----------------------------------------------------------------------
76# DESTRUCTOR
77# ----------------------------------------------------------------------
78itcl::body Rappture::Map::destructor {} {
79    if { $_tree != "" } {
80        blt::tree destroy $_tree
81    }
82}
83
84#
85# hints --
86#
87itcl::body Rappture::Map::hints { args } {
88    switch -- [llength $args] {
89        0 {
90            return [$_tree get root]
91        }
92        1 {
93            set field [lindex $args 0]
94            return [$_tree get root $field ""]
95        }
96        default {
97            error "wrong # args: should \"hints ?name?\""
98        }
99    }
100}
101
102#
103# Parse --
104#
105#       Parses the map description in the XML object.
106#
107itcl::body Rappture::Map::Parse { xmlobj path } {
108
109    set map [$xmlobj element -as object $path]
110
111    if { $_tree != "" } {
112        blt::tree destroy $_tree
113    }
114    set _tree [blt::tree create]
115    set parent [$_tree insert root -label "layers"]
116    set layers [$map element -as object "layers"]
117    foreach layer [$layers children -type layer] {
118        # Unique identifier for layer.
119        set name "layer[incr _nextLayer]"
120        set child [$_tree insert $parent -label $name]
121        set layerType [$layers get $layer.type]
122        if { ![info exists _layerTypes($layerType)] } {
123            error "invalid layer type \"$layerType\": should be one of [array names _layerTypes]"
124        }
125        $_tree set $child "name" $layer
126        $_tree set $child "type" $layerType
127        foreach key { label description } {
128            $_tree set $child $key [$layers get $layer.$key]
129        }
130        # Common settings (for all layer types) with defaults
131        foreach { key defval } { visible true } {
132            $_tree set $child $key $defval
133            set val [$layers get $layer.$key]
134            if {$val != ""} {
135                $_tree set $child $key $val
136            }
137        }
138        # These are settings for which there should be no default
139        # We want to know if they have been set by the user or not
140        # Not all layer types use these
141        foreach key { opacity content priority style } {
142            set val [$layers get $layer.$key]
143            if {$val != ""} {
144                $_tree set $child $key $val
145            }
146        }
147        $_tree set $child "driver" "debug"
148        set gdal [$layers element -as type $layer.gdal]
149        if { $gdal != "" } {
150            foreach key { url } {
151                set value [$layers get $layer.gdal.$key]
152                $_tree set $child "gdal.$key" $value
153            }
154            set file [$layers get $layer.gdal.file]
155            if { $file != "" } {
156                # FIXME: Add test for valid file path
157                $_tree set $child "gdal.url" $file
158            }
159            $_tree set $child "driver" "gdal"
160        }
161        set ogr [$layers element -as type $layer.ogr]
162        if { $ogr != "" } {
163            foreach key { url } {
164                set value [$layers get $layer.ogr.$key]
165                $_tree set $child "ogr.$key" $value
166            }
167            set file [$layers get $layer.ogr.file]
168            if { $file != "" } {
169                # FIXME: Add test for valid file path
170                $_tree set $child "ogr.url" $file
171            }
172            $_tree set $child "driver" "ogr"
173        }
174        set tfs [$layers element -as type $layer.tfs]
175        if { $tfs != "" } {
176            foreach key { url format } {
177                set value [$layers get $layer.tfs.$key]
178                $_tree set $child "tfs.$key" $value
179            }
180            $_tree set $child "driver" "tfs"
181        }
182        set tms [$layers element -as type $layer.tms]
183        if { $tms != "" } {
184            foreach key { url tmsType format } {
185                set value [$layers get $layer.tms.$key]
186                $_tree set $child "tms.$key" $value
187            }
188            $_tree set $child "driver" "tms"
189        }
190        set wfs [$layers element -as type $layer.wfs]
191        if { $wfs != "" } {
192            foreach key { url typename outputformat maxfeatures request_buffer } {
193                set value [$layers get $layer.wfs.$key]
194                $_tree set $child "wfs.$key" $value
195            }
196            $_tree set $child "driver" "wfs"
197        }
198        set wms [$layers element -as type $layer.wms]
199        if { $wms != "" } {
200            foreach key { url layers format transparent } {
201                set value [$layers get $layer.wms.$key]
202                $_tree set $child "wms.$key" $value
203            }
204            $_tree set $child "driver" "wms"
205        }
206        set xyz [$layers element -as type $layer.xyz]
207        if { $xyz != "" } {
208            foreach key { url } {
209                set value [$layers get $layer.xyz.$key]
210                $_tree set $child "xyz.$key" $value
211            }
212            $_tree set $child "driver" "xyz"
213        }
214    }
215    $_tree set root "label"       [$map get "about.label"]
216    $_tree set root "style"       [$map get "style"]
217 
218    set projection [$map get "projection"]
219    set extents    [$map get "extents"]
220    if { $projection  == "" } {
221        if {$extents != ""} {
222            error "cannot specify extents without a projection"
223        }
224        set projection "global-mercator"; # Default projection.
225    } elseif { $projection == "geodetic" && $extents == "" } {
226        set projection "global-geodetic"
227    }
228    # FIXME: Verify projection is valid.
229    $_tree set root "projection" $projection
230    $_tree set root "extents"    $extents
231
232    set mapType [$map get "type"]
233    if { $mapType == "" } {
234        set mapType "projected";           # Default type is "projected".
235    }
236    if { ![info exists _mapTypes($mapType)] } {
237        error "unknown map type \"$mapType\": should be one of [array names _mapTypes]"
238    }
239    $_tree set root "type" $mapType
240
241    foreach {key path} {
242        toolId          tool.id
243        toolName        tool.name
244        toolCommand     tool.execute
245        toolTitle       tool.title
246        toolRevision    tool.version.application.revision
247    } {
248        set str [$xmlobj get $path]
249        if { "" != $str } {
250            $_tree set root $key $str
251        }
252    }
253    set _isValid 1
254}
255
256# ----------------------------------------------------------------------
257# USAGE: layers
258#
259# Returns a list of IDs for the layers in the map
260# ----------------------------------------------------------------------
261itcl::body Rappture::Map::layers {} {
262    set list {}
263    foreach node [$_tree children root->"layers"] {
264        lappend list [$_tree label $node]
265    }
266    return $list
267}
268
269# ----------------------------------------------------------------------
270# USAGE: layer <layerName>
271#
272# Returns an array of settings for the named layer
273# ----------------------------------------------------------------------
274itcl::body Rappture::Map::layer { layerName } {
275    set id [$_tree findchild root->"layers" $layerName]
276    if { $id < 0 } {
277        error "unknown layer \"$layerName\""
278    }
279    return [$_tree get $id]
280}
281
282# ----------------------------------------------------------------------
283# USAGE: type <layerName>
284#
285# Returns the type of the named layer
286# ----------------------------------------------------------------------
287itcl::body Rappture::Map::type { layerName } {
288    set id [$_tree findchild root->"layers" $layerName]
289    if { $id < 0 } {
290        error "unknown layer \"$layerName\""
291    }
292    return [$_tree get $id "type" ""]
293}
294
295# ----------------------------------------------------------------------
296# USAGE: isGeocentric
297#
298# Returns if the map is geocentric (1) or projected (0)
299# ----------------------------------------------------------------------
300itcl::body Rappture::Map::isGeocentric {} {
301    return [expr {[hints "type"] eq "geocentric"}]
302}
303
304itcl::body Rappture::Map::earthfile {} {
305    array set info [$_tree get root]
306    append out "<map"
307    append out " name=\"$info(label)\""
308    append out " type=\"$info(type)\""
309    append out " version=\"2\""
310    append out ">\n"
311    # Profile is optional
312    if { [info exists info(projection)] } {
313        append out " <options>\n"
314        append out "  <profile"
315        append out " srs=\"$info(projection)\""
316        if { [info exists info(extents)] && $info(extents) != "" } {
317            foreach {x1 y1 x2 y2} $info(extents) break
318            append out " xmin=\"$x1\""
319            append out " ymin=\"$y1\""
320            append out " xmax=\"$x2\""
321            append out " ymax=\"$y2\""
322        }
323        append out "/>\n"
324        append out " </options>\n"
325    }
326    foreach node [$_tree children root->"layers"] {
327        array unset info
328        array set info [$_tree get $node]
329        set label [$_tree label $node]
330        switch -- $info(type) {
331            "image" {
332                append out " <image"
333                append out " name=\"$label\""
334                append out " driver=\"gdal\""
335                if { [info exists info(opacity)] } {
336                    append out " opacity=\"$info(opacity)\""
337                }
338                if { $info(visible) } {
339                    append out " visible=\"true\""
340                } else {
341                    append out " visible=\"false\""
342                }
343                append out ">\n"
344                append out "  <url>$info(url)</url>\n"
345                append out " </image>\n"
346            }
347            "elevation" {
348                append out " <elevation"
349                append out " name=\"$label\""
350                append out " driver=\"gdal\""
351                if { $info(visible) } {
352                    append out " visible=\"true\""
353                } else {
354                    append out " visible=\"false\""
355                }
356                append out ">\n"
357                append out "  <url>$info(url)</url>\n"
358                append out " </elevation>\n"
359            }
360            default {
361                puts stderr "Type $info(type) not implemented in earthfile"
362            }
363        }
364    }
365    append out "</map>\n"
366}
Note: See TracBrowser for help on using the repository browser.