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

Last change on this file since 4789 was 4789, checked in by ldelgass, 7 years ago

Make tool hints in map match other data objects

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.