source: branches/1.3/gui/scripts/map.tcl @ 4666

Last change on this file since 4666 was 4512, checked in by gah, 10 years ago

test and fixes for meshviewer, add rappture (non-viewer) bug fixes and features
File size: 12.0 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    }
226    # FIXME: Verify projection is valid.
227    $_tree set root "projection" $projection
228    $_tree set root "extents"    $extents
229
230    set mapType [$map get "type"]
231    if { $mapType == "" } {
232        set mapType "projected";           # Default type is "projected".
233    }
234    if { ![info exists _mapTypes($mapType)] } {
235        error "unknown map type \"$mapType\": should be one of [array names _mapTypes]"
236    }
237    $_tree set root "type" $mapType
238
239    foreach {key path} {
240        toolId          tool.id
241        toolName        tool.name
242        toolCommand     tool.execute
243        toolTitle       tool.title
244        toolRevision    tool.version.application.revision
245    } {
246        set str [$xmlobj get $path]
247        if { "" != $str } {
248            $_tree set root $key $str
249        }
250    }
251    set _isValid 1
252}
253
254# ----------------------------------------------------------------------
255# USAGE: layers
256#
257# Returns a list of IDs for the layers in the map
258# ----------------------------------------------------------------------
259itcl::body Rappture::Map::layers {} {
260    set list {}
261    foreach node [$_tree children root->"layers"] {
262        lappend list [$_tree label $node]
263    }
264    return $list
265}
266
267# ----------------------------------------------------------------------
268# USAGE: layer <layerName>
269#
270# Returns an array of settings for the named layer
271# ----------------------------------------------------------------------
272itcl::body Rappture::Map::layer { layerName } {
273    set id [$_tree findchild root->"layers" $layerName]
274    if { $id < 0 } {
275        error "unknown layer \"$layerName\""
276    }
277    return [$_tree get $id]
278}
279
280# ----------------------------------------------------------------------
281# USAGE: type <layerName>
282#
283# Returns the type of the named layer
284# ----------------------------------------------------------------------
285itcl::body Rappture::Map::type { layerName } {
286    set id [$_tree findchild root->"layers" $layerName]
287    if { $id < 0 } {
288        error "unknown layer \"$layerName\""
289    }
290    return [$_tree get $id "type" ""]
291}
292
293# ----------------------------------------------------------------------
294# USAGE: isGeocentric
295#
296# Returns if the map is geocentric (1) or projected (0)
297# ----------------------------------------------------------------------
298itcl::body Rappture::Map::isGeocentric {} {
299    return [expr {[hints "type"] eq "geocentric"}]
300}
301
302itcl::body Rappture::Map::earthfile {} {
303    array set info [$_tree get root]
304    append out "<map"
305    append out " name=\"$info(label)\""
306    append out " type=\"$info(type)\""
307    append out " version=\"2\""
308    append out ">\n"
309    # Profile is optional
310    if { [info exists info(projection)] } {
311        append out " <options>\n"
312        append out "  <profile"
313        append out " srs=\"$info(projection)\""
314        if { [info exists info(extents)] && $info(extents) != "" } {
315            foreach {x1 y1 x2 y2} $info(extents) break
316            append out " xmin=\"$x1\""
317            append out " ymin=\"$y1\""
318            append out " xmax=\"$x2\""
319            append out " ymax=\"$y2\""
320        }
321        append out "/>\n"
322        append out " </options>\n"
323    }
324    foreach node [$_tree children root->"layers"] {
325        array unset info
326        array set info [$_tree get $node]
327        set label [$_tree label $node]
328        switch -- $info(type) {
329            "image" {
330                append out " <image"
331                append out " name=\"$label\""
332                append out " driver=\"gdal\""
333                if { [info exists info(opacity)] } {
334                    append out " opacity=\"$info(opacity)\""
335                }
336                if { $info(visible) } {
337                    append out " visible=\"true\""
338                } else {
339                    append out " visible=\"false\""
340                }
341                append out ">\n"
342                append out "  <url>$info(url)</url>\n"
343                append out " </image>\n"
344            }
345            "elevation" {
346                append out " <elevation"
347                append out " name=\"$label\""
348                append out " driver=\"gdal\""
349                if { $info(visible) } {
350                    append out " visible=\"true\""
351                } else {
352                    append out " visible=\"false\""
353                }
354                append out ">\n"
355                append out "  <url>$info(url)</url>\n"
356                append out " </elevation>\n"
357            }
358            default {
359                puts stderr "Type $info(type) not implemented in earthfile"
360            }
361        }
362    }
363    append out "</map>\n"
364}
Note: See TracBrowser for help on using the repository browser.