source: trunk/gui/scripts/mapviewer.tcl @ 4974

Last change on this file since 4974 was 4974, checked in by ldelgass, 6 years ago

Add time slider

File size: 72.6 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: mapviewer - Map object viewer
4#
5#  It connects to the GeoVis server running on a rendering farm,
6#  transmits data, and displays the results.
7# ======================================================================
8#  AUTHOR:  Michael McLennan, Purdue University
9#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
10#
11#  See the file "license.terms" for information on usage and
12#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13# ======================================================================
14package require Itk
15package require BLT
16#package require Img
17
18option add *MapViewer.width 4i widgetDefault
19option add *MapViewer*cursor crosshair widgetDefault
20option add *MapViewer.height 4i widgetDefault
21option add *MapViewer.foreground black widgetDefault
22option add *MapViewer.controlBackground gray widgetDefault
23option add *MapViewer.controlDarkBackground #999999 widgetDefault
24option add *MapViewer.plotBackground black widgetDefault
25option add *MapViewer.plotForeground white widgetDefault
26option add *MapViewer.font \
27    -*-helvetica-medium-r-normal-*-12-* widgetDefault
28
29# must use this name -- plugs into Rappture::resources::load
30proc MapViewer_init_resources {} {
31    Rappture::resources::register \
32        geovis_server Rappture::MapViewer::SetServerList
33}
34
35itcl::class Rappture::MapViewer {
36    inherit Rappture::VisViewer
37
38    itk_option define -plotforeground plotForeground Foreground ""
39    itk_option define -plotbackground plotBackground Background ""
40
41    private variable _layersFrame "";   # Name of layers frame widget
42    private variable _mapsettings;      # Global map settings
43
44    constructor { hostlist args } {
45        Rappture::VisViewer::constructor $hostlist
46    } {
47        # defined below
48    }
49    destructor {
50        # defined below
51    }
52    public proc SetServerList { namelist } {
53        Rappture::VisViewer::SetServerList "geovis" $namelist
54    }
55    public method add {dataobj {settings ""}}
56    public method camera {option args}
57    public method delete {args}
58    public method disconnect {}
59    public method download {option args}
60    public method get {args}
61    public method isconnected {}
62    public method parameters {title args} {
63        # do nothing
64    }
65    public method scale {args}
66
67    private method KeyPress { key }
68    private method KeyRelease { key }
69    private method MouseClick { button x y }
70    private method MouseDoubleClick { button x y }
71    private method MouseDrag { button x y }
72    private method MouseMotion {}
73    private method MouseRelease { button x y }
74    private method MouseScroll { direction }
75
76    # The following methods are only used by this class.
77    private method AdjustSetting {what {value ""}}
78    private method BuildCameraTab {}
79    private method BuildDownloadPopup { widget command }
80    private method BuildLayerTab {}
81    private method BuildMapTab {}
82    private method BuildTerrainTab {}
83    private method ChangeLayerVisibility { dataobj layer }
84    private method Connect {}
85    private method CurrentLayers {args}
86    private method Disconnect {}
87    private method DoPan {}
88    private method DoResize {}
89    private method DoRotate {}
90    private method EarthFile {}
91    private method EventuallyHandleMotionEvent { x y }
92    private method EventuallyPan { dx dy }
93    private method EventuallyResize { w h }
94    private method EventuallyRotate { dx dy }
95    private method GetImage { args }
96    private method GetNormalizedMouse { x y }
97    private method InitSettings { args  }
98    private method MapIsGeocentric {}
99    private method Pan {option x y}
100    private method Pin {option x y}
101    private method Rebuild {}
102    private method ReceiveMapInfo { args }
103    private method ReceiveScreenInfo { args }
104    private method ReceiveImage { args }
105    private method Rotate {option x y}
106    private method Select {option x y}
107    private method SetLayerStyle { dataobj layer }
108    private method SetTerrainStyle { style }
109    private method SetOpacity { dataset }
110    private method UpdateLayerControls {}
111    private method Zoom {option {x 0} {y 0}}
112
113    private variable _dlist "";         # list of data objects
114    private variable _obj2datasets
115    private variable _obj2ovride;       # maps dataobj => style override
116    private variable _layers;           # Contains the names of all the
117                                        # layer in the server.
118    private variable _click;            # info used for rotate operations
119    private variable _view;             # view params for 3D view
120    private variable _pan;
121    private variable _rotate;
122    private variable _motion;
123    private variable _settings
124    private variable _visibility
125    private variable _style;            # Array of current component styles.
126    private variable _initialStyle;     # Array of initial component styles.
127    private variable _reset 1;          # Indicates that server was reset and
128                                        # needs to be reinitialized.
129    private variable _initCamera 1;
130    private variable _haveTerrain 0;
131
132    private variable _first ""     ;# This is the topmost dataset.
133    private variable _start 0
134    private variable _title ""
135
136    common _downloadPopup          ;# download options from popup
137    private common _hardcopy
138    private variable _width 0
139    private variable _height 0
140    private variable _resizePending 0
141    private variable _sendEarthFile 0
142    private variable _useServerManip 0
143    private variable _labelCount 0
144    private variable _b1mode "pan"
145}
146
147itk::usual MapViewer {
148    keep -background -foreground -cursor -font
149    keep -plotbackground -plotforeground
150}
151
152# ----------------------------------------------------------------------
153# CONSTRUCTOR
154# ----------------------------------------------------------------------
155itcl::body Rappture::MapViewer::constructor {hostlist args} {
156    set _serverType "geovis"
157
158    if { [catch {
159       
160    # Rebuild event
161    $_dispatcher register !rebuild
162    $_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
163
164    # Resize event
165    $_dispatcher register !resize
166    $_dispatcher dispatch $this !resize "[itcl::code $this DoResize]; list"
167
168    # Pan event
169    $_dispatcher register !pan
170    $_dispatcher dispatch $this !pan "[itcl::code $this DoPan]; list"
171
172    # Rotate event
173    $_dispatcher register !rotate
174    $_dispatcher dispatch $this !rotate "[itcl::code $this DoRotate]; list"
175
176    # <Motion> event
177    $_dispatcher register !motion
178    $_dispatcher dispatch $this !motion "[itcl::code $this MouseMotion]; list"
179
180    #
181    # Populate parser with commands handle incoming requests
182    #
183    $_parser alias image    [itcl::code $this ReceiveImage]
184    $_parser alias map      [itcl::code $this ReceiveMapInfo]
185    $_parser alias camera   [itcl::code $this camera]
186    $_parser alias screen   [itcl::code $this ReceiveScreenInfo]
187
188    # Millisecond delay before animated wait dialog appears
189    set _waitTimeout 500
190
191    # Settings for mouse motion events: these are required
192    # to update the Lat/Long coordinate display
193    array set _motion {
194        compress        1
195        delay           100
196        enable          1
197        pending         0
198        x               0
199        y               0
200    }
201    array set _pan {
202        compress        1
203        delay           100
204        pending         0
205        x               0
206        y               0
207    }
208    array set _rotate {
209        azimuth         0
210        compress        1
211        delay           100
212        elevation       0
213        pending         0
214    }
215    # This array holds the Viewpoint parameters that the
216    # server sends on "camera get".
217    array set _view {
218        distance        1.0
219        heading         0.0
220        pitch           -89.9
221        srs             ""
222        verticalDatum   ""
223        x               0.0
224        y               0.0
225        z               0.0
226    }
227
228    # Note: grid types are "geodetic", "utm" and "mgrs"
229    # Currently only work in geocentric maps
230    array set _settings [subst {
231        camera-throw           0
232        coords-precision       5
233        coords-units           "latlong_decimal_degrees"
234        coords-visible         1
235        grid                   0
236        grid-type              "geodetic"
237        legend                 1
238        terrain-edges          0
239        terrain-lighting       0
240        terrain-vertscale      1.0
241        terrain-wireframe      0
242        time                   12
243    }]
244
245    set _settings(time) [clock format [clock seconds] -format %k]
246
247    itk_component add view {
248        canvas $itk_component(plotarea).view \
249            -highlightthickness 0 -borderwidth 0
250    } {
251        usual
252        ignore -highlightthickness -borderwidth  -background
253    }
254
255    set c $itk_component(view)
256    #bind $c <KeyPress-Left>  [list %W xview scroll 10 units]
257    #bind $c <KeyPress-Right> [list %W xview scroll -10 units]
258    #bind $c <KeyPress-Up>    [list %W yview scroll 10 units]
259    #bind $c <KeyPress-Down>  [list %W yview scroll -10 units]
260    bind $c <Enter> "focus %W"
261    bind $c <Control-F1> [itcl::code $this ToggleConsole]
262
263    # Fix the scrollregion in case we go off screen
264    $c configure -scrollregion [$c bbox all]
265
266    set _map(id) [$c create image 0 0 -anchor nw -image $_image(plot)]
267    set _map(cwidth) -1
268    set _map(cheight) -1
269    set _map(zoom) 1.0
270    set _map(original) ""
271
272    set f [$itk_component(main) component controls]
273    itk_component add reset {
274        button $f.reset -borderwidth 1 -padx 1 -pady 1 \
275            -highlightthickness 0 \
276            -image [Rappture::icon reset-view] \
277            -command [itcl::code $this camera reset]
278    } {
279        usual
280        ignore -highlightthickness
281    }
282    pack $itk_component(reset) -side top -padx 2 -pady 2
283    Rappture::Tooltip::for $itk_component(reset) \
284        "Reset the view to the default zoom level"
285
286    itk_component add zoomin {
287        button $f.zin -borderwidth 1 -padx 1 -pady 1 \
288            -highlightthickness 0 \
289            -image [Rappture::icon zoom-in] \
290            -command [itcl::code $this Zoom in]
291    } {
292        usual
293        ignore -highlightthickness
294    }
295    pack $itk_component(zoomin) -side top -padx 2 -pady 2
296    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
297
298    itk_component add zoomout {
299        button $f.zout -borderwidth 1 -padx 1 -pady 1 \
300            -highlightthickness 0 \
301            -image [Rappture::icon zoom-out] \
302            -command [itcl::code $this Zoom out]
303    } {
304        usual
305        ignore -highlightthickness
306    }
307    pack $itk_component(zoomout) -side top -padx 2 -pady 2
308    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
309
310    BuildLayerTab
311    BuildMapTab
312    BuildTerrainTab
313    BuildCameraTab
314
315    # Legend
316
317    set _image(legend) [image create photo]
318    itk_component add legend {
319        canvas $itk_component(plotarea).legend -width 50 -highlightthickness 0
320    } {
321        usual
322        ignore -highlightthickness
323        rename -background -plotbackground plotBackground Background
324    }
325
326    # Hack around the Tk panewindow.  The problem is that the requested
327    # size of the 3d view isn't set until an image is retrieved from
328    # the server.  So the panewindow uses the tiny size.
329    set w 10000
330    pack forget $itk_component(view)
331    blt::table $itk_component(plotarea) \
332        0,0 $itk_component(view) -fill both -reqwidth $w
333    blt::table configure $itk_component(plotarea) c1 -resize none
334
335    bind $itk_component(view) <Configure> \
336        [itcl::code $this EventuallyResize %w %h]
337
338    if {$_useServerManip} {
339        # Bindings for keyboard events
340        bind $itk_component(view) <KeyPress> \
341            [itcl::code $this KeyPress %N]
342        bind $itk_component(view) <KeyRelease> \
343            [itcl::code $this KeyRelease %N]
344
345        # Bindings for rotation via mouse
346        bind $itk_component(view) <ButtonPress-1> \
347            [itcl::code $this MouseClick 1 %x %y]
348        bind $itk_component(view) <Double-1> \
349            [itcl::code $this MouseDoubleClick 1 %x %y]
350        bind $itk_component(view) <B1-Motion> \
351            [itcl::code $this MouseDrag 1 %x %y]
352        bind $itk_component(view) <ButtonRelease-1> \
353            [itcl::code $this MouseRelease 1 %x %y]
354
355        # Bindings for panning via mouse
356        bind $itk_component(view) <ButtonPress-2> \
357            [itcl::code $this MouseClick 2 %x %y]
358        bind $itk_component(view) <Double-2> \
359            [itcl::code $this MouseDoubleClick 2 %x %y]
360        bind $itk_component(view) <B2-Motion> \
361            [itcl::code $this MouseDrag 2 %x %y]
362        bind $itk_component(view) <ButtonRelease-2> \
363            [itcl::code $this MouseRelease 2 %x %y]
364
365        bind $itk_component(view) <ButtonPress-3> \
366            [itcl::code $this MouseClick 3 %x %y]
367        bind $itk_component(view) <Double-3> \
368            [itcl::code $this MouseDoubleClick 3 %x %y]
369        bind $itk_component(view) <B3-Motion> \
370            [itcl::code $this MouseDrag 3 %x %y]
371        bind $itk_component(view) <ButtonRelease-3> \
372            [itcl::code $this MouseRelease 3 %x %y]
373
374        # Binding for mouse motion events
375        if {$_motion(enable)} {
376            bind $itk_component(view) <Motion> \
377                [itcl::code $this EventuallyHandleMotionEvent %x %y]
378        }
379    } else {
380        # Bindings for panning via mouse
381        bind $itk_component(view) <ButtonPress-1> \
382            [itcl::code $this Pan click %x %y]
383        bind $itk_component(view) <B1-Motion> \
384            [itcl::code $this Pan drag %x %y]
385        bind $itk_component(view) <ButtonRelease-1> \
386            [itcl::code $this Pan release %x %y]
387        bind $itk_component(view) <Button-1> \
388            +[itcl::code $this SendCmd "map setpos %x %y"]
389        bind $itk_component(view) <Double-1> \
390            [itcl::code $this camera go %x %y 0.4]
391
392        # Pin placemark annotations
393        bind $itk_component(view) <Control-ButtonPress-1> \
394            +[itcl::code $this Pin add %x %y]
395        bind $itk_component(view) <Control-ButtonPress-3> \
396            +[itcl::code $this Pin delete %x %y]
397
398        bind $itk_component(view) <Shift-ButtonPress-1> \
399            [itcl::code $this Select click %x %y]
400        bind $itk_component(view) <B1-Motion> \
401            +[itcl::code $this Select drag %x %y]
402        bind $itk_component(view) <Shift-ButtonRelease-1> \
403            +[itcl::code $this Select release %x %y]
404
405        if {1} {
406        # Bindings for rotation via mouse
407        bind $itk_component(view) <ButtonPress-2> \
408            [itcl::code $this Rotate click %x %y]
409        bind $itk_component(view) <B2-Motion> \
410            [itcl::code $this Rotate drag %x %y]
411        bind $itk_component(view) <ButtonRelease-2> \
412            [itcl::code $this Rotate release %x %y]
413        }
414
415        # Bindings for zoom via mouse
416        bind $itk_component(view) <ButtonPress-3> \
417            [itcl::code $this Zoom click %x %y]
418        bind $itk_component(view) <B3-Motion> \
419            [itcl::code $this Zoom drag %x %y]
420        bind $itk_component(view) <ButtonRelease-3> \
421            [itcl::code $this Zoom release %x %y]
422        bind $itk_component(view) <Double-3> \
423            [itcl::code $this camera go %x %y 2.5]
424        bind $itk_component(view) <Double-3> \
425            +[itcl::code $this SendCmd "map setpos %x %y"]
426
427        # Bindings for panning via keyboard
428        bind $itk_component(view) <KeyPress-Left> \
429            [itcl::code $this Pan set 10 0]
430        bind $itk_component(view) <KeyPress-Right> \
431            [itcl::code $this Pan set -10 0]
432        bind $itk_component(view) <KeyPress-Up> \
433            [itcl::code $this Pan set 0 -10]
434        bind $itk_component(view) <KeyPress-Down> \
435            [itcl::code $this Pan set 0 10]
436
437        # Binding for mouse motion events
438        set _motion(compress) 1
439        if {$_motion(enable)} {
440            bind $itk_component(view) <Motion> \
441                [itcl::code $this EventuallyHandleMotionEvent %x %y]
442        }
443        #bind $itk_component(view) <Motion> \
444        #    +[itcl::code $this SendCmd "map pin hover %x %y"]
445    }
446
447    bind $itk_component(view) <Shift-KeyPress-Left> \
448        [itcl::code $this Pan set 2 0]
449    bind $itk_component(view) <Shift-KeyPress-Right> \
450        [itcl::code $this Pan set -2 0]
451    bind $itk_component(view) <Shift-KeyPress-Up> \
452        [itcl::code $this Pan set 0 -2]
453    bind $itk_component(view) <Shift-KeyPress-Down> \
454        [itcl::code $this Pan set 0 2]
455
456    # Bindings for zoom via keyboard
457    bind $itk_component(view) <KeyPress-Prior> \
458        [itcl::code $this Zoom out]
459    bind $itk_component(view) <KeyPress-Next> \
460        [itcl::code $this Zoom in]
461
462    bind $itk_component(view) <Enter> "focus $itk_component(view)"
463
464    if {[string equal "x11" [tk windowingsystem]]} {
465        # Bindings for zoom via mouse
466        if {$_useServerManip} {
467            bind $itk_component(view) <4> [itcl::code $this MouseScroll up]
468            bind $itk_component(view) <5> [itcl::code $this MouseScroll down]
469        } else {
470            bind $itk_component(view) <4> [itcl::code $this Zoom out]
471            bind $itk_component(view) <5> [itcl::code $this Zoom in]
472        }
473    }
474
475    set _image(download) [image create photo]
476
477    eval itk_initialize $args
478    Connect
479} errs] != 0 } {
480        puts stderr errs=$errs
481    }
482}
483
484# ----------------------------------------------------------------------
485# DESTRUCTOR
486# ----------------------------------------------------------------------
487itcl::body Rappture::MapViewer::destructor {} {
488    Disconnect
489    $_dispatcher cancel !rebuild
490    $_dispatcher cancel !resize
491    $_dispatcher cancel !rotate
492    image delete $_image(plot)
493    image delete $_image(download)
494}
495
496itcl::body Rappture::MapViewer::DoResize {} {
497    set sendResize 1
498    if { $_width < 2 } {
499        set _width 500
500        set sendResize 0
501    }
502    if { $_height < 2 } {
503        set _height 500
504        set sendResize 0
505    }
506    #set _start [clock clicks -milliseconds]
507    if {$sendResize} {
508        SendCmd "screen size $_width $_height"
509    }
510    set _resizePending 0
511}
512
513itcl::body Rappture::MapViewer::DoRotate {} {
514    SendCmd "camera rotate $_rotate(azimuth) $_rotate(elevation)"
515    set _rotate(azimuth) 0
516    set _rotate(elevation) 0
517    set _rotate(pending) 0
518}
519
520itcl::body Rappture::MapViewer::EventuallyResize { w h } {
521    set _width $w
522    set _height $h
523    if { !$_resizePending } {
524        set _resizePending 1
525        $_dispatcher event -after 200 !resize
526    }
527}
528
529itcl::body Rappture::MapViewer::DoPan {} {
530    SendCmd "camera pan $_pan(x) $_pan(y)"
531    set _pan(x) 0
532    set _pan(y) 0
533    set _pan(pending) 0
534}
535
536itcl::body Rappture::MapViewer::EventuallyPan { dx dy } {
537    set _pan(x) [expr $_pan(x) + $dx]
538    set _pan(y) [expr $_pan(y) + $dy]
539    if { !$_pan(compress) } {
540        DoPan
541        return
542    }
543    if { !$_pan(pending) } {
544        set _pan(pending) 1
545        $_dispatcher event -after $_pan(delay) !pan
546    }
547}
548
549itcl::body Rappture::MapViewer::EventuallyRotate { dx dy } {
550    set _rotate(azimuth) [expr $_rotate(azimuth) + $dx]
551    set _rotate(elevation) [expr $_rotate(elevation) + $dy]
552    if { !$_rotate(compress) } {
553        DoRotate
554        return
555    }
556    if { !$_rotate(pending) } {
557        set _rotate(pending) 1
558        $_dispatcher event -after $_rotate(delay) !rotate
559    }
560}
561
562# ----------------------------------------------------------------------
563# USAGE: add <dataobj> ?<settings>?
564#
565# Clients use this to add a data object to the plot.  The optional
566# <settings> are used to configure the plot.  Allowed settings are
567# -color, -brightness, -width, -linestyle, and -raise.
568# ----------------------------------------------------------------------
569itcl::body Rappture::MapViewer::add {dataobj {settings ""}} {
570    array set params {
571        -color auto
572        -width 1
573        -linestyle solid
574        -brightness 0
575        -raise 0
576        -description ""
577        -param ""
578        -type ""
579    }
580    array set params $settings
581    set params(-description) ""
582    set params(-param) ""
583    array set params $settings
584
585    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
586        # can't handle -autocolors yet
587        set params(-color) black
588    }
589    set pos [lsearch -exact $_dlist $dataobj]
590    if {$pos < 0} {
591        #if {[llength $_dlist] > 0} {
592        #    error "Can't add more than 1 map to mapviewer"
593        #}
594        lappend _dlist $dataobj
595    }
596    set _obj2ovride($dataobj-color) $params(-color)
597    set _obj2ovride($dataobj-width) $params(-width)
598    set _obj2ovride($dataobj-raise) $params(-raise)
599    $_dispatcher event -idle !rebuild
600}
601
602# ----------------------------------------------------------------------
603# USAGE: delete ?<dataobj1> <dataobj2> ...?
604#
605#       Clients use this to delete a dataobj from the plot.  If no dataobjs
606#       are specified, then all dataobjs are deleted.  No data objects are
607#       deleted.  They are only removed from the display list.
608#
609# ----------------------------------------------------------------------
610itcl::body Rappture::MapViewer::delete {args} {
611    if { [llength $args] == 0} {
612        set args $_dlist
613    }
614    # Delete all specified dataobjs
615    set changed 0
616    foreach dataobj $args {
617        set pos [lsearch -exact $_dlist $dataobj]
618        if { $pos < 0 } {
619            continue;                   # Don't know anything about it.
620        }
621        # When a map is marked deleted, we hide its layers.
622        foreach layer [$dataobj layers] {
623            SendCmd "map layer visible 0 $layer"
624            set _visibility($layer) 0
625        }
626        # Remove it from the dataobj list.
627        set _dlist [lreplace $_dlist $pos $pos]
628        array unset _obj2ovride $dataobj-*
629        array unset _settings $dataobj-*
630        set changed 1
631    }
632    # If anything changed, then rebuild the plot
633    if { $changed } {
634        $_dispatcher event -idle !rebuild
635    }
636}
637
638# ----------------------------------------------------------------------
639# USAGE: get ?-objects?
640# USAGE: get ?-visible?
641# USAGE: get ?-image view?
642#
643# Clients use this to query the list of objects being plotted, in
644# order from bottom to top of this result.  The optional "-image"
645# flag can also request the internal images being shown.
646# ----------------------------------------------------------------------
647itcl::body Rappture::MapViewer::get {args} {
648    if {[llength $args] == 0} {
649        set args "-objects"
650    }
651
652    set op [lindex $args 0]
653    switch -- $op {
654        "-objects" {
655            # put the dataobj list in order according to -raise options
656            set dlist {}
657            foreach dataobj $_dlist {
658                if { ![$dataobj isvalid] } {
659                    continue
660                }
661                if {[info exists _obj2ovride($dataobj-raise)] &&
662                    $_obj2ovride($dataobj-raise)} {
663                    set dlist [linsert $dlist 0 $dataobj]
664                } else {
665                    lappend dlist $dataobj
666                }
667            }
668            return $dlist
669        }
670        "-visible" {
671            set dlist {}
672            foreach dataobj $_dlist {
673                if { ![$dataobj isvalid] } {
674                    continue
675                }
676                if { ![info exists _obj2ovride($dataobj-raise)] } {
677                    # No setting indicates that the object isn't visible.
678                    continue
679                }
680                # Otherwise use the -raise parameter to put the object to
681                # the front of the list.
682                if { $_obj2ovride($dataobj-raise) } {
683                    set dlist [linsert $dlist 0 $dataobj]
684                } else {
685                    lappend dlist $dataobj
686                }
687            }
688            return $dlist
689        }           
690        -image {
691            if {[llength $args] != 2} {
692                error "wrong # args: should be \"get -image view\""
693            }
694            switch -- [lindex $args end] {
695                view {
696                    return $_image(plot)
697                }
698                default {
699                    error "bad image name \"[lindex $args end]\": should be view"
700                }
701            }
702        }
703        default {
704            error "bad option \"$op\": should be -objects or -image"
705        }
706    }
707}
708
709itcl::body Rappture::MapViewer::MapIsGeocentric {} {
710    if { [info exists _mapsettings(type)] } {
711        return [expr {$_mapsettings(type) eq "geocentric"}]
712    } else {
713        return 0
714    }
715}
716
717# ----------------------------------------------------------------------
718# USAGE: scale ?<data1> <data2> ...?
719#
720# Sets the default limits for the overall plot according to the
721# limits of the data for all of the given <data> objects.  This
722# accounts for all objects--even those not showing on the screen.
723# Because of this, the limits are appropriate for all objects as
724# the user scans through data in the ResultSet viewer.
725# ----------------------------------------------------------------------
726itcl::body Rappture::MapViewer::scale {args} {
727    array unset _mapsettings
728    set _haveTerrain 0
729
730    # Verify that all the maps have the same global settings. For example,
731    # you can't have one map type "geocentric" and the other "projected".
732
733    foreach dataobj $args {
734        if { ![$dataobj isvalid] } {
735            continue
736        }
737        array unset hints
738        array set hints [$dataobj hints]
739        if { ![info exists _mapsettings(label)] } {
740            set _mapsettings(label) $hints(label)
741        }
742        if { ![info exists _mapsettings(style)] } {
743            set _mapsettings(style) $hints(style)
744        }
745        if { ![info exists _mapsettings(type)] } {
746            set _mapsettings(type) $hints(type)
747        } elseif { $hints(type) != $_mapsettings(type) } {
748            error "maps \"$hints(label)\" have differing types"
749        }
750        if { ![info exists _mapsettings(projection)] } {
751            set _mapsettings(projection) $hints(projection)
752        } elseif { $hints(projection) != $_mapsettings(projection) } {
753            error "maps \"$hints(label)\" have differing projections"
754        }
755        if { $hints(extents) != "" } {
756            if { ![info exists _mapsettings(extents)] } {
757                set _mapsettings(extents) $hints(extents)
758            }
759            foreach {x1 y1 x2 y2} $hints(extents) break
760            if { ![info exists _mapsettings(x1)] || $x1 < $_mapsettings(x1) } {
761                set _mapsettings(x1) $x1
762            }
763            if { ![info exists _mapsettings(y1)] || $y1 < $_mapsettings(y1) } {
764                set _mapsettings(y1) $y1
765            }
766            if { ![info exists _mapsettings(x2)] || $x2 > $_mapsettings(x2) } {
767                set _mapsettings(x2) $x2
768            }
769            if { ![info exists _mapsettings(y2)] || $y2 > $_mapsettings(y2) } {
770                set _mapsettings(y2) $y2
771            }
772        }
773        foreach layer [$dataobj layers] {
774            if { [$dataobj type $layer] == "elevation" } {
775                set _haveTerrain 1
776                break
777            }
778        }
779    }
780    if { $_haveTerrain } {
781        if { [$itk_component(main) exists "Terrain Settings"] } {
782            # TODO: Enable controls like vertical scale that only have
783            # an effect when terrain is present
784        }
785    }
786}
787
788# ----------------------------------------------------------------------
789# USAGE: download coming
790# USAGE: download controls <downloadCommand>
791# USAGE: download now
792#
793# Clients use this method to create a downloadable representation
794# of the plot.  Returns a list of the form {ext string}, where
795# "ext" is the file extension (indicating the type of data) and
796# "string" is the data itself.
797# ----------------------------------------------------------------------
798itcl::body Rappture::MapViewer::download {option args} {
799    switch $option {
800        coming {
801            if {[catch {
802                blt::winop snap $itk_component(plotarea) $_image(download)
803            }]} {
804                $_image(download) configure -width 1 -height 1
805                $_image(download) put #000000
806            }
807        }
808        controls {
809            set popup .mapviewerdownload
810            if { ![winfo exists .mapviewerdownload] } {
811                set inner [BuildDownloadPopup $popup [lindex $args 0]]
812            } else {
813                set inner [$popup component inner]
814            }
815            set _downloadPopup(image_controls) $inner.image_frame
816            set num [llength [get]]
817            set num [expr {($num == 1) ? "1 result" : "$num results"}]
818            set word [Rappture::filexfer::label downloadWord]
819            $inner.summary configure -text "$word $num in the following format:"
820            update idletasks            ;# Fix initial sizes
821            return $popup
822        }
823        now {
824            set popup .mapviewerdownload
825            if {[winfo exists .mapviewerdownload]} {
826                $popup deactivate
827            }
828            switch -- $_downloadPopup(format) {
829                "image" {
830                    return [$this GetImage [lindex $args 0]]
831                }
832            }
833            return ""
834        }
835        default {
836            error "bad option \"$option\": should be coming, controls, now"
837        }
838    }
839}
840
841# ----------------------------------------------------------------------
842# USAGE: Connect ?<host:port>,<host:port>...?
843#
844# Clients use this method to establish a connection to a new
845# server, or to reestablish a connection to the previous server.
846# Any existing connection is automatically closed.
847# ----------------------------------------------------------------------
848itcl::body Rappture::MapViewer::Connect {} {
849    global readyForNextFrame
850    set readyForNextFrame 1
851    set _reset 1
852    set _hosts [GetServerList "geovis"]
853    if { "" == $_hosts } {
854        return 0
855    }
856    set result [VisViewer::Connect $_hosts]
857    if { $result } {
858        if { $_reportClientInfo }  {
859            # Tell the server the viewer, hub, user and session.
860            # Do this immediately on connect before buffering any commands
861            global env
862
863            set info {}
864            set user "???"
865            if { [info exists env(USER)] } {
866                set user $env(USER)
867            }
868            set session "???"
869            if { [info exists env(SESSION)] } {
870                set session $env(SESSION)
871            }
872            lappend info "version" "$Rappture::version"
873            lappend info "build" "$Rappture::build"
874            lappend info "svnurl" "$Rappture::svnurl"
875            lappend info "installdir" "$Rappture::installdir"
876            lappend info "hub" [exec hostname]
877            lappend info "client" "mapviewer"
878            lappend info "user" $user
879            lappend info "session" $session
880            SendCmd "clientinfo [list $info]"
881        }
882
883        set w [winfo width $itk_component(view)]
884        set h [winfo height $itk_component(view)]
885        EventuallyResize $w $h
886    }
887    return $result
888}
889
890#
891# isconnected --
892#
893#       Indicates if we are currently connected to the visualization server.
894#
895itcl::body Rappture::MapViewer::isconnected {} {
896    return [VisViewer::IsConnected]
897}
898
899#
900# disconnect --
901#
902itcl::body Rappture::MapViewer::disconnect {} {
903    Disconnect
904    set _reset 1
905}
906
907#
908# Disconnect --
909#
910#       Clients use this method to disconnect from the current rendering
911#       server.
912#
913itcl::body Rappture::MapViewer::Disconnect {} {
914    VisViewer::Disconnect
915
916    $_dispatcher cancel !pan
917    $_dispatcher cancel !motion
918    $_dispatcher cancel !rebuild
919    $_dispatcher cancel !resize
920    $_dispatcher cancel !rotate
921    # disconnected -- no more data sitting on server
922    array unset _layers
923    array unset _layersFrame
924    global readyForNextFrame
925    set readyForNextFrame 1
926}
927
928# ----------------------------------------------------------------------
929# USAGE: ReceiveImage -type <type> -token <token> -bytes <size>
930#
931# Invoked automatically whenever the "image" command comes in from
932# the rendering server.  Indicates that binary image data with the
933# specified <size> will follow.
934# ----------------------------------------------------------------------
935itcl::body Rappture::MapViewer::ReceiveImage { args } {
936    global readyForNextFrame
937    set readyForNextFrame 1
938    array set info {
939        -bytes 0
940        -token "???"
941        -type image
942    }
943    array set info $args
944    set bytes [ReceiveBytes $info(-bytes)]
945    if { $info(-type) == "image" } {
946        $_image(plot) configure -data $bytes
947    } elseif { $info(type) == "print" } {
948        set tag $this-print-$info(-token)
949        set _hardcopy($tag) $bytes
950    }
951    set _waitTimeout 0
952}
953
954#
955# ReceiveMapInfo --
956#
957itcl::body Rappture::MapViewer::ReceiveMapInfo { args } {
958    if { ![isconnected] } {
959        return
960    }
961    set timeReceived [clock clicks -milliseconds]
962    set elapsed [expr $timeReceived - $_start]
963    set option [lindex $args 0]
964    switch -- $option {
965        "coords" {
966            set len [llength $args]
967            if {$len < 3} {
968                error "Bad map coords response"
969            } else {
970                set token [lindex $args 1]
971            }
972            foreach { x y z } [lindex $args 2] {
973                puts stderr "\[$token\] Map coords: $x $y $z"
974            }
975            if {$len > 3} {
976                set srs [lindex $args 3]
977                set vert [lindex $args 4]
978                puts stderr "\[$token\] {$srs} {$vert}"
979            }
980        }
981        "names" {
982            foreach { name } [lindex $args 1] {
983                puts stderr "layer: $name"
984            }
985        }
986        default {
987            error "unknown map option \"$option\" from server"
988        }
989    }
990}
991
992#
993# ReceiveScreenInfo --
994#
995itcl::body Rappture::MapViewer::ReceiveScreenInfo { args } {
996    if { ![isconnected] } {
997        return
998    }
999    set option [lindex $args 0]
1000    switch -- $option {
1001        "coords" {
1002            set len [llength $args]
1003            if {$len < 3} {
1004                error "Bad screen coords response"
1005            } else {
1006                set token [lindex $args 1]
1007            }
1008            foreach { x y z } [lindex $args 2] {
1009                puts stderr "\[$token\] Screen coords: $x $y $z"
1010            }
1011        }
1012        default {
1013            error "unknown screen option \"$option\" from server"
1014        }
1015    }
1016}
1017
1018# ----------------------------------------------------------------------
1019# USAGE: Rebuild
1020#
1021# Called automatically whenever something changes that affects the
1022# data in the widget.  Clears any existing data and rebuilds the
1023# widget to display new data.
1024# ----------------------------------------------------------------------
1025itcl::body Rappture::MapViewer::Rebuild {} {
1026    set w [winfo width $itk_component(view)]
1027    set h [winfo height $itk_component(view)]
1028    if { $w < 2 || $h < 2 } {
1029        $_dispatcher event -idle !rebuild
1030        return
1031    }
1032
1033    # Turn on buffering of commands to the server.  We don't want to be
1034    # preempted by a server disconnect/reconnect (which automatically
1035    # generates a new call to Rebuild).
1036    StartBufferingCommands
1037
1038    if { $_reset } {
1039        set _width $w
1040        set _height $h
1041        DoResize
1042
1043        if { [info exists _mapsettings(type)] } {
1044            # The map must be reset once before any layers are added This
1045            # should not be done more than once as it is very expensive.
1046            if {$_sendEarthFile} {
1047                set bytes [EarthFile]
1048                if {0} {
1049                    set f [open "/tmp/map.earth" "w"]
1050                    puts $f $bytes
1051                    close $f
1052                }
1053                set length [string length $bytes]
1054                SendCmd "map load data follows $length"
1055                append _outbuf $bytes
1056            } else {
1057                if { $_mapsettings(type) == "geocentric" } {
1058                    $itk_component(grid) configure -state normal
1059                    SendCmd "map reset geocentric"
1060                }  else {
1061                    $itk_component(grid) configure -state disabled
1062                    set proj $_mapsettings(projection)
1063                    if { $proj == "" } {
1064                        SendCmd "map reset projected global-mercator"
1065                    } elseif { ![info exists _mapsettings(extents)] || $_mapsettings(extents) == "" } {
1066                        SendCmd [list map reset "projected" $proj]
1067                    } else {
1068                        #foreach {x1 y1 x2 y2} $_mapsettings(extents) break
1069                        foreach key "x1 y1 x2 y2" {
1070                            set $key $_mapsettings($key)
1071                        }
1072                        SendCmd [list map reset "projected" $proj $x1 $y1 $x2 $y2]
1073                    }
1074                }
1075                # XXX: Remove these after implementing batch load of layers with reset
1076                SendCmd "map layer delete base"
1077            }
1078
1079            # Most terrain settings are global to the map and apply even
1080            # if there is no elevation layer.  The exception is the
1081            # vertical scale, which only applies if there is an elevation
1082            # layer
1083            if { [info exists _mapsettings(style)] } {
1084                SetTerrainStyle $_mapsettings(style)
1085            } else {
1086                InitSettings terrain-edges terrain-lighting \
1087                    terrain-vertscale terrain-wireframe
1088            }
1089            InitSettings coords-visible
1090        } else {
1091            error "No map settings on reset"
1092        }
1093    }
1094
1095    set _first ""
1096    set count 0
1097
1098    foreach dataobj [get -objects] {
1099        set _obj2datasets($dataobj) ""
1100        foreach layer [$dataobj layers] {
1101            array unset info
1102            array set info [$dataobj layer $layer]
1103            if { ![info exists _layers($layer)] } {
1104                if { $_reportClientInfo }  {
1105                    set cinfo {}
1106                    lappend cinfo "tool_id"       [$dataobj hints toolid]
1107                    lappend cinfo "tool_name"     [$dataobj hints toolname]
1108                    lappend cinfo "tool_title"    [$dataobj hints tooltitle]
1109                    lappend cinfo "tool_command"  [$dataobj hints toolcommand]
1110                    lappend cinfo "tool_revision" [$dataobj hints toolrevision]
1111                    lappend cinfo "dataset_label" [$dataobj hints label]
1112                    lappend cinfo "dataset_tag"   $layer
1113                    SendCmd "clientinfo [list $cinfo]"
1114                }
1115                set _layers($layer) 1
1116                SetLayerStyle $dataobj $layer
1117            }
1118            lappend _obj2datasets($dataobj) $layer
1119            # FIXME: This is overriding all layers' initial visibility setting
1120            if { [info exists _obj2ovride($dataobj-raise)] } {
1121                SendCmd "map layer visible 1 $layer"
1122                set _visibility($layer) 1
1123                #SetLayerOpacity $layer
1124            }
1125        }
1126    }
1127
1128    if {$_reset} {
1129        if {$_initCamera} {
1130            # If this is the first Rebuild, we need to
1131            # set up the initial view settings if there
1132            # are any
1133            if { [info exists _mapsettings(camera)] } {
1134                set location $_mapsettings(camera)
1135                if { $location != "" } {
1136                    array set _view $location
1137                    camera set all
1138                }
1139            }
1140            set _initCamera 0
1141        } else {
1142            # Restore view from before reconnect
1143            camera set all
1144        }
1145    }
1146
1147    UpdateLayerControls
1148    set _reset 0
1149    global readyForNextFrame
1150    set readyForNextFrame 0;            # Don't advance to the next frame
1151                                        # until we get an image.
1152
1153    # Actually write the commands to the server socket.  If it fails, we
1154    # don't care.  We're finished here.
1155    blt::busy hold $itk_component(hull)
1156    StopBufferingCommands
1157    blt::busy release $itk_component(hull)
1158}
1159
1160# ----------------------------------------------------------------------
1161# USAGE: CurrentLayers ?-all -visible? ?dataobjs?
1162#
1163# Returns a list of server IDs for the current datasets being displayed.
1164# This is normally a single ID, but it might be a list of IDs if the
1165# current data object has multiple components.
1166# ----------------------------------------------------------------------
1167itcl::body Rappture::MapViewer::CurrentLayers {args} {
1168    set flag [lindex $args 0]
1169    switch -- $flag {
1170        "-all" {
1171            if { [llength $args] > 1 } {
1172                error "CurrentLayers: can't specify dataobj after \"-all\""
1173            }
1174            set dlist [get -objects]
1175        }
1176        "-visible" {
1177            if { [llength $args] > 1 } {
1178                set dlist {}
1179                set args [lrange $args 1 end]
1180                foreach dataobj $args {
1181                    if { [info exists _obj2ovride($dataobj-raise)] } {
1182                        lappend dlist $dataobj
1183                    }
1184                }
1185            } else {
1186                set dlist [get -visible]
1187            }
1188        }           
1189        default {
1190            set dlist $args
1191        }
1192    }
1193    set rlist ""
1194    foreach dataobj $dlist {
1195        foreach layer [$dataobj layers] {
1196            if { [info exists _layers($layer)] && $_layers($layer) } {
1197                lappend rlist $layer
1198            }
1199        }
1200    }
1201    return $rlist
1202}
1203
1204itcl::body Rappture::MapViewer::KeyPress {k} {
1205    SendCmd "key press $k"
1206}
1207
1208itcl::body Rappture::MapViewer::KeyRelease {k} {
1209    SendCmd "key release $k"
1210}
1211
1212itcl::body Rappture::MapViewer::GetNormalizedMouse {x y} {
1213    set w [winfo width $itk_component(view)]
1214    set h [winfo height $itk_component(view)]
1215    set x [expr {(2.0 * double($x)/$w) - 1.0}]
1216    set y [expr {(2.0 * double($y)/$h) - 1.0}]
1217    return [list $x $y]
1218}
1219
1220itcl::body Rappture::MapViewer::MouseClick {button x y} {
1221    SendCmd "mouse click $button $x $y"
1222}
1223
1224itcl::body Rappture::MapViewer::MouseDoubleClick {button x y} {
1225    SendCmd "mouse dblclick $button $x $y"
1226}
1227
1228itcl::body Rappture::MapViewer::MouseDrag {button x y} {
1229    SendCmd "mouse drag $button $x $y"
1230}
1231
1232itcl::body Rappture::MapViewer::MouseRelease {button x y} {
1233    SendCmd "mouse release $button $x $y"
1234}
1235
1236itcl::body Rappture::MapViewer::MouseMotion {} {
1237    #SendCmd "mouse motion $_motion(x) $_motion(y)"
1238    SendCmd "map pin hover $_motion(x) $_motion(y)"
1239    set _motion(pending) 0
1240}
1241
1242itcl::body Rappture::MapViewer::MouseScroll {direction} {
1243    switch -- $direction {
1244        "up" {
1245            SendCmd "mouse scroll 1"
1246        }
1247        "down" {
1248            SendCmd "mouse scroll -1"
1249        }
1250    }
1251}
1252
1253#
1254# EventuallyHandleMotionEvent --
1255#
1256#       This routine compresses (no button press) motion events.  It
1257#       delivers a server mouse command once every 100 milliseconds (if a
1258#       motion event is pending).
1259#
1260itcl::body Rappture::MapViewer::EventuallyHandleMotionEvent {x y} {
1261    set _motion(x) $x
1262    set _motion(y) $y
1263    if { !$_motion(compress) } {
1264        MouseMotion
1265        return
1266    }
1267    if { !$_motion(pending) } {
1268        set _motion(pending) 1
1269        $_dispatcher event -after $_motion(delay) !motion
1270    }
1271}
1272
1273# ----------------------------------------------------------------------
1274# USAGE: Zoom in
1275# USAGE: Zoom out
1276# USAGE: Zoom reset
1277#        $this Zoom click x y
1278#        $this Zoom drag x y
1279#        $this Zoom release x y
1280#
1281# Called automatically when the user clicks on one of the zoom
1282# controls for this widget.  Changes the zoom for the current view.
1283# Also implements mouse zoom.
1284# ----------------------------------------------------------------------
1285itcl::body Rappture::MapViewer::Zoom {option {x 0} {y 0}} {
1286    switch -- $option {
1287        "in" {
1288            # z here is normalized mouse Y delta
1289            set z -0.25
1290            SendCmd "camera zoom $z"
1291        }
1292        "out" {
1293            # z here is normalized mouse Y delta
1294            set z 0.25
1295            SendCmd "camera zoom $z"
1296        }
1297        "reset" {
1298            SendCmd "camera dist $_view(distance)"
1299        }
1300        "click" {
1301            set _click(x) $x
1302            set _click(y) $y
1303            $itk_component(view) configure -cursor hand1
1304        }
1305        "drag" {
1306            if { ![info exists _click(x)] } {
1307                set _click(x) $x
1308            }
1309            if { ![info exists _click(y)] } {
1310                set _click(y) $y
1311            }
1312            set h [winfo height $itk_component(view)]
1313            set dy [expr ($_click(y) - $y)/double($h)]
1314            set _click(x) $x
1315            set _click(y) $y
1316            if {[expr (abs($dy) > 0.0)]} {
1317                SendCmd "camera zoom $dy"
1318            }
1319        }
1320        "release" {
1321            Zoom drag $x $y
1322            $itk_component(view) configure -cursor ""
1323        }
1324    }
1325}
1326
1327# ----------------------------------------------------------------------
1328# USAGE: Rotate click <x> <y>
1329# USAGE: Rotate drag <x> <y>
1330# USAGE: Rotate release <x> <y>
1331#
1332# Called automatically when the user clicks/drags/releases in the
1333# plot area.  Moves the plot according to the user's actions.
1334# ----------------------------------------------------------------------
1335itcl::body Rappture::MapViewer::Rotate {option x y} {
1336    switch -- $option {
1337        "click" {
1338            $itk_component(view) configure -cursor fleur
1339            set _click(x) $x
1340            set _click(y) $y
1341            set _rotate(azimuth) 0
1342            set _rotate(elevation) 0
1343        }
1344        "drag" {
1345            if {[array size _click] == 0} {
1346                Rotate click $x $y
1347            } else {
1348                set w [winfo width $itk_component(view)]
1349                set h [winfo height $itk_component(view)]
1350                if {$w <= 0 || $h <= 0} {
1351                    return
1352                }
1353                set dx [expr ($x - $_click(x))/double($w)]
1354                set dy [expr ($_click(y) - $y)/double($h)]
1355                set _click(x) $x
1356                set _click(y) $y
1357                if {[expr (abs($dx) > 0.0 || abs($dy) > 0.0)]} {
1358                    #SendCmd "camera rotate $dx $dy"
1359                    EventuallyRotate $dx $dy
1360                }
1361            }
1362        }
1363        "release" {
1364            Rotate drag $x $y
1365            $itk_component(view) configure -cursor ""
1366            catch {unset _click}
1367        }
1368        default {
1369            error "bad option \"$option\": should be click, drag, release"
1370        }
1371    }
1372}
1373
1374itcl::body Rappture::MapViewer::Select {option x y} {
1375    switch -- $option {
1376        "click" {
1377            set _click(x) $x
1378            set _click(y) $y
1379            set _b1mode "select"
1380            SendCmd "map box init $x $y"
1381        }
1382        "drag" {
1383            if {$_b1mode == "select"} {
1384                SendCmd "map box update $x $y"
1385            }
1386        }
1387        "release" {
1388            set _b1mode ""
1389            if {$_click(x) == $x &&
1390                $_click(y) == $y} {
1391                SendCmd "map box clear"
1392            }
1393        }
1394    }
1395}
1396
1397itcl::body Rappture::MapViewer::Pin {option x y} {
1398    set _click(x) $x
1399    set _click(y) $y
1400    switch -- $option {
1401        "add" {
1402            incr _labelCount
1403            set label "Label $_labelCount"
1404            SendCmd [list "map" "pin" "add" $x $y $label]
1405        }
1406        "delete" {
1407            SendCmd "map pin delete $x $y"
1408        }
1409    }
1410}
1411
1412# ----------------------------------------------------------------------
1413# USAGE: $this Pan set x y
1414#        $this Pan click x y
1415#        $this Pan drag x y
1416#        $this Pan release x y
1417#
1418# Called automatically when the user clicks on one of the zoom
1419# controls for this widget.  Changes the zoom for the current view.
1420# ----------------------------------------------------------------------
1421itcl::body Rappture::MapViewer::Pan {option x y} {
1422    switch -- $option {
1423        "set" {
1424            set w [winfo width $itk_component(view)]
1425            set h [winfo height $itk_component(view)]
1426            set x [expr $x / double($w)]
1427            set y [expr $y / double($h)]
1428            if {[expr (abs($x) > 0.0 || abs($y) > 0.0)]} {
1429                SendCmd "camera pan $x $y"
1430            }
1431            return
1432        }
1433        "click" {
1434            set _click(x) $x
1435            set _click(y) $y
1436            set _pan(x) 0
1437            set _pan(y) 0
1438            $itk_component(view) configure -cursor hand1
1439            set _b1mode "pan"
1440        }
1441        "drag" {
1442            if {$_b1mode != "pan"} {
1443                return
1444            }
1445            if { ![info exists _click(x)] } {
1446                set _click(x) $x
1447            }
1448            if { ![info exists _click(y)] } {
1449                set _click(y) $y
1450            }
1451            set w [winfo width $itk_component(view)]
1452            set h [winfo height $itk_component(view)]
1453            set dx [expr ($x - $_click(x))/double($w)]
1454            set dy [expr ($_click(y) - $y)/double($h)]
1455            set _click(x) $x
1456            set _click(y) $y
1457            if {[expr (abs($dx) > 0.0 || abs($dy) > 0.0)]} {
1458                EventuallyPan $dx $dy
1459                #SendCmd "camera pan $dx $dy"
1460            }
1461        }
1462        "release" {
1463            Pan drag $x $y
1464            $itk_component(view) configure -cursor ""
1465            set _b1mode ""
1466        }
1467        default {
1468            error "unknown option \"$option\": should set, click, drag, or release"
1469        }
1470    }
1471}
1472
1473# ----------------------------------------------------------------------
1474# USAGE: InitSettings <what> ?<value>?
1475#
1476# Used internally to update rendering settings whenever parameters
1477# change in the popup settings panel.  Sends the new settings off
1478# to the back end.
1479# ----------------------------------------------------------------------
1480itcl::body Rappture::MapViewer::InitSettings { args } {
1481    foreach setting $args {
1482        AdjustSetting $setting
1483    }
1484}
1485
1486#
1487# AdjustSetting --
1488#
1489#       Changes/updates a specific setting in the widget.  There are
1490#       usually user-setable option.  Commands are sent to the render
1491#       server.
1492#
1493itcl::body Rappture::MapViewer::AdjustSetting {what {value ""}} {
1494    if { ![isconnected] } {
1495        return
1496    }
1497    switch -- $what {
1498        "coords-visible" - "coords-precision" - "coords-units" {
1499            set bool $_settings(coords-visible)
1500            set units $_settings(coords-units)
1501            set precision $_settings(coords-precision)
1502            SendCmd "map posdisp $bool $units $precision"
1503        }
1504        "grid" - "grid-type" {
1505            set bool $_settings(grid)
1506            set gridType $_settings(grid-type)
1507            SendCmd "map grid $bool $gridType"
1508        }
1509        "camera-throw" {
1510            set bool $_settings($what)
1511            SendCmd "camera throw $bool"
1512        }
1513        "terrain-edges" {
1514            set bool $_settings($what)
1515            SendCmd "map terrain edges $bool"
1516        }
1517        "terrain-lighting" {
1518            set bool $_settings($what)
1519            SendCmd "map terrain lighting $bool"
1520        }
1521        "terrain-palette" {
1522            set cmap [$itk_component(terrainpalette) value]
1523            #SendCmd "map terrain colormap $cmap"
1524        }
1525        "terrain-vertscale" {
1526            set val $_settings($what)
1527            SendCmd "map terrain vertscale $val"
1528        }
1529        "terrain-wireframe" {
1530            set bool $_settings($what)
1531            SendCmd "map terrain wireframe $bool"
1532        }
1533        "time" {
1534            set val $_settings($what)
1535            SendCmd "map time $val"
1536        }
1537        default {
1538            error "don't know how to fix $what"
1539        }
1540    }
1541}
1542
1543# ----------------------------------------------------------------------
1544# CONFIGURATION OPTION: -plotbackground
1545# ----------------------------------------------------------------------
1546itcl::configbody Rappture::MapViewer::plotbackground {
1547    if { [isconnected] } {
1548        set rgb [Color2RGB $itk_option(-plotbackground)]
1549        SendCmd "screen bgcolor $rgb"
1550    }
1551}
1552
1553# ----------------------------------------------------------------------
1554# CONFIGURATION OPTION: -plotforeground
1555# ----------------------------------------------------------------------
1556itcl::configbody Rappture::MapViewer::plotforeground {
1557    if { [isconnected] } {
1558        set rgb [Color2RGB $itk_option(-plotforeground)]
1559        # FIXME: Set font foreground colors
1560    }
1561}
1562
1563itcl::body Rappture::MapViewer::BuildMapTab {} {
1564
1565    set fg [option get $itk_component(hull) font Font]
1566    #set bfg [option get $itk_component(hull) boldFont Font]
1567
1568    set inner [$itk_component(main) insert end \
1569        -title "Map Settings" \
1570        -icon [Rappture::icon wrench]]
1571    $inner configure -borderwidth 4
1572
1573    checkbutton $inner.posdisp \
1574        -text "Show Coordinate Readout" \
1575        -variable [itcl::scope _settings(coords-visible)] \
1576        -command [itcl::code $this AdjustSetting coords-visible] \
1577        -font "Arial 9" -anchor w
1578
1579    itk_component add grid {
1580        checkbutton $inner.grid \
1581        -text "Show Graticule" \
1582        -variable [itcl::scope _settings(grid)] \
1583        -command [itcl::code $this AdjustSetting grid] \
1584        -font "Arial 9" -anchor w
1585    } {
1586        ignore -font
1587    }
1588
1589    checkbutton $inner.wireframe \
1590        -text "Show Wireframe" \
1591        -variable [itcl::scope _settings(terrain-wireframe)] \
1592        -command [itcl::code $this AdjustSetting terrain-wireframe] \
1593        -font "Arial 9" -anchor w
1594
1595    checkbutton $inner.lighting \
1596        -text "Enable Lighting" \
1597        -variable [itcl::scope _settings(terrain-lighting)] \
1598        -command [itcl::code $this AdjustSetting terrain-lighting] \
1599        -font "Arial 9" -anchor w
1600
1601    checkbutton $inner.edges \
1602        -text "Show Edges" \
1603        -variable [itcl::scope _settings(terrain-edges)] \
1604        -command [itcl::code $this AdjustSetting terrain-edges] \
1605        -font "Arial 9" -anchor w
1606
1607    itk_component add time_l {
1608        label $inner.time_l -text "Time" -font "Arial 9"
1609    } {
1610        ignore -font
1611    }
1612    itk_component add time {
1613        ::scale $inner.time -from 0 -to 23.9 -orient horizontal \
1614            -resolution 0.1 \
1615            -variable [itcl::scope _settings(time)] \
1616            -showvalue on \
1617            -command [itcl::code $this AdjustSetting time]
1618    }
1619
1620    blt::table $inner \
1621        0,0 $inner.posdisp   -cspan 2 -anchor w -pady 2 \
1622        1,0 $inner.grid      -cspan 2 -anchor w -pady 2 \
1623        2,0 $inner.wireframe -cspan 2 -anchor w -pady 2 \
1624        3,0 $inner.lighting  -cspan 2 -anchor w -pady 2 \
1625        4,0 $inner.time_l    -cspan 2 -anchor w -pady 2 \
1626        4,1 $inner.time      -cspan 2 -fill x   -pady 2
1627#        4,0 $inner.edges     -cspan 2  -anchor w -pady 2
1628
1629    blt::table configure $inner r* c* -resize none
1630    blt::table configure $inner r5 c1 -resize expand
1631}
1632
1633itcl::body Rappture::MapViewer::BuildTerrainTab {} {
1634
1635    set fg [option get $itk_component(hull) font Font]
1636    #set bfg [option get $itk_component(hull) boldFont Font]
1637
1638    set inner [$itk_component(main) insert end \
1639        -title "Terrain Settings" \
1640        -icon [Rappture::icon surface]]
1641    $inner configure -borderwidth 4
1642
1643    label $inner.palette_l -text "Palette" -font "Arial 9" -anchor w
1644    itk_component add terrainpalette {
1645        Rappture::Combobox $inner.palette -width 10 -editable no
1646    }
1647    $inner.palette choices insert end [GetColormapList]
1648
1649    $itk_component(terrainpalette) value "BCGYR"
1650    bind $inner.palette <<Value>> \
1651        [itcl::code $this AdjustSetting terrain-palette]
1652
1653    label $inner.vscale_l -text "Vertical Scale" -font "Arial 9" -anchor w
1654    ::scale $inner.vscale -from 0 -to 10 -orient horizontal \
1655        -variable [itcl::scope _settings(terrain-vertscale)] \
1656        -width 10 \
1657        -resolution 0.1 \
1658        -showvalue on \
1659        -command [itcl::code $this AdjustSetting terrain-vertscale]
1660    $inner.vscale set $_settings(terrain-vertscale)
1661
1662    blt::table $inner \
1663        0,0 $inner.vscale_l  -anchor w -pady 2 \
1664        0,1 $inner.vscale    -fill x   -pady 2 \
1665        1,0 $inner.palette_l -anchor w -pady 2 \
1666        1,1 $inner.palette   -fill x   -pady 2 
1667
1668    blt::table configure $inner r* c* -resize none
1669    blt::table configure $inner r3 c1 -resize expand
1670}
1671
1672itcl::body Rappture::MapViewer::BuildLayerTab {} {
1673
1674    set fg [option get $itk_component(hull) font Font]
1675    #set bfg [option get $itk_component(hull) boldFont Font]
1676
1677    set inner [$itk_component(main) insert end \
1678        -title "Layers" \
1679        -icon [Rappture::icon layers]]
1680    $inner configure -borderwidth 4
1681    set f [frame $inner.layers]
1682    blt::table $inner \
1683        0,0 $f -fill both
1684    set _layersFrame $inner
1685}
1686
1687itcl::body Rappture::MapViewer::BuildCameraTab {} {
1688    set inner [$itk_component(main) insert end \
1689        -title "Camera Settings" \
1690        -icon [Rappture::icon camera]]
1691    $inner configure -borderwidth 4
1692
1693    set row 0
1694
1695    set labels { x y z heading pitch distance }
1696    foreach tag $labels {
1697        label $inner.${tag}label -text $tag -font "Arial 9"
1698        entry $inner.${tag} -font "Arial 9"  -bg white \
1699            -textvariable [itcl::scope _view($tag)]
1700        bind $inner.${tag} <KeyPress-Return> \
1701            [itcl::code $this camera set ${tag}]
1702        bind $inner.${tag} <KP_Enter> \
1703            [itcl::code $this camera set ${tag}]
1704        blt::table $inner \
1705            $row,0 $inner.${tag}label -anchor e -pady 2 \
1706            $row,1 $inner.${tag} -anchor w -pady 2
1707        blt::table configure $inner r$row -resize none
1708        incr row
1709    }
1710    set labels { srs verticalDatum }
1711    foreach tag $labels {
1712        label $inner.${tag}label -text $tag -font "Arial 9"
1713        entry $inner.${tag} -font "Arial 9"  -bg white \
1714            -textvariable [itcl::scope _view($tag)]
1715        bind $inner.${tag} <KeyPress-Return> \
1716            [itcl::code $this camera set ${tag}]
1717        bind $inner.${tag} <KP_Enter> \
1718            [itcl::code $this camera set ${tag}]
1719        blt::table $inner \
1720            $row,0 $inner.${tag}label -anchor e -pady 2 \
1721            $row,1 $inner.${tag} -anchor w -pady 2
1722        blt::table configure $inner r$row -resize none
1723        incr row
1724    }
1725
1726    if {0} {
1727    button $inner.get \
1728        -text "Get Camera Settings" \
1729        -font "Arial 9" \
1730        -command [itcl::code $this SendCmd "camera get"]
1731    blt::table $inner \
1732        $row,0 $inner.get -anchor w -pady 2 -cspan 2
1733    blt::table configure $inner r$row -resize none
1734    incr row
1735
1736    button $inner.set \
1737        -text "Apply Camera Settings" \
1738        -font "Arial 9" \
1739        -command [itcl::code $this camera set all]
1740    blt::table $inner \
1741        $row,0 $inner.set -anchor w -pady 2 -cspan 2
1742    blt::table configure $inner r$row -resize none
1743    incr row
1744    }
1745
1746    if {$_useServerManip} {
1747        checkbutton $inner.throw \
1748            -text "Enable Throw" \
1749            -font "Arial 9" \
1750            -variable [itcl::scope _settings(camera-throw)] \
1751            -command [itcl::code $this AdjustSetting camera-throw]
1752        blt::table $inner \
1753            $row,0 $inner.throw -anchor w -pady 2 -cspan 2
1754        blt::table configure $inner r$row -resize none
1755        incr row
1756    }
1757
1758    blt::table configure $inner c* r* -resize none
1759    blt::table configure $inner c2 -resize expand
1760    blt::table configure $inner r$row -resize expand
1761}
1762
1763#
1764#  camera --
1765#
1766# USAGE: camera get
1767#        This is called by the server to transfer the
1768#        current Viewpoint settings
1769# USAGE: camera reset
1770#        Reset the camera to the default view
1771#
1772itcl::body Rappture::MapViewer::camera {option args} {
1773    switch -- $option {
1774        "get" {
1775            # We got the camera settings from the server
1776            foreach name {x y z heading pitch distance srs verticalDatum} value $args {
1777                set _view($name) $value
1778            }
1779            puts stderr "view: $_view(x), $_view(y), $_view(z), $_view(heading), $_view(pitch), $_view(distance), {$_view(srs)}, {$_view(verticalDatum)}"
1780        }
1781        "go" {
1782            SendCmd "camera go $args"
1783        }
1784        "reset" {
1785            array set _view {
1786                x               0.0
1787                y               0.0
1788                z               0.0
1789                heading         0.0
1790                pitch           -89.9
1791                distance        1.0
1792                srs             ""
1793                verticalDatum   ""
1794            }
1795            if { [info exists _mapsettings(camera)] } {
1796                # Check if the tool specified a default
1797                set location $_mapsettings(camera)
1798                if { $location != "" } {
1799                    array set _view $location
1800                    set duration 0.0
1801                    SendCmd [list camera set $_view(x) $_view(y) $_view(z) $_view(heading) $_view(pitch) $_view(distance) $duration $_view(srs) $_view(verticalDatum)]
1802                } else {
1803                    SendCmd "camera reset"
1804                    # Retrieve the settings
1805                    #SendCmd "camera get"
1806                }
1807            } else {
1808                SendCmd "camera reset"
1809                # Retrieve the settings
1810               # SendCmd "camera get"
1811            }
1812        }
1813        "set" {
1814            set who [lindex $args 0]
1815            if {$who != "all" && $who != "srs" && $who != "verticalDatum"} {
1816                set val $_view($who)
1817                set code [catch { string is double $val } result]
1818                if { $code != 0 || !$result } {
1819                    return
1820                }
1821            }
1822            switch -- $who {
1823                "distance" {
1824                    SendCmd [list camera dist $_view(distance)]
1825                }
1826                "all" - "x" - "y" - "z" - "heading" - "pitch" - "srs" - "verticalDatum" {
1827                    set duration 0.0
1828                    SendCmd [list camera set $_view(x) $_view(y) $_view(z) $_view(heading) $_view(pitch) $_view(distance) $duration $_view(srs) $_view(verticalDatum)]
1829                }
1830            }
1831        }
1832    }
1833}
1834
1835itcl::body Rappture::MapViewer::GetImage { args } {
1836    if { [image width $_image(download)] > 0 &&
1837         [image height $_image(download)] > 0 } {
1838        set bytes [$_image(download) data -format "jpeg -quality 100"]
1839        set bytes [Rappture::encoding::decode -as b64 $bytes]
1840        return [list .jpg $bytes]
1841    }
1842    return ""
1843}
1844
1845itcl::body Rappture::MapViewer::BuildDownloadPopup { popup command } {
1846    Rappture::Balloon $popup \
1847        -title "[Rappture::filexfer::label downloadWord] as..."
1848    set inner [$popup component inner]
1849    label $inner.summary -text "" -anchor w
1850
1851    radiobutton $inner.image_button -text "Image File" \
1852        -variable [itcl::scope _downloadPopup(format)] \
1853        -value image
1854    Rappture::Tooltip::for $inner.image_button \
1855        "Save as digital image."
1856
1857    button $inner.ok -text "Save" \
1858        -highlightthickness 0 -pady 2 -padx 3 \
1859        -command $command \
1860        -compound left \
1861        -image [Rappture::icon download]
1862
1863    button $inner.cancel -text "Cancel" \
1864        -highlightthickness 0 -pady 2 -padx 3 \
1865        -command [list $popup deactivate] \
1866        -compound left \
1867        -image [Rappture::icon cancel]
1868
1869    blt::table $inner \
1870        0,0 $inner.summary -cspan 2  \
1871        2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \
1872        4,1 $inner.cancel -width .9i -fill y \
1873        4,0 $inner.ok -padx 2 -width .9i -fill y
1874    blt::table configure $inner r3 -height 4
1875    blt::table configure $inner r4 -pady 4
1876    raise $inner.image_button
1877    $inner.image_button invoke
1878    return $inner
1879}
1880
1881itcl::body Rappture::MapViewer::SetTerrainStyle { style } {
1882    array set settings {
1883        -color white
1884        -edgecolor black
1885        -edges 0
1886        -lighting 0
1887        -linewidth 1.0
1888        -vertscale 1.0
1889        -wireframe 0
1890    }
1891    array set settings $style
1892
1893    SendCmd "map terrain edges $settings(-edges)"
1894    set _settings(terrain-edges) $settings(-edges)
1895    #SendCmd "map terrain color [Color2RGB $settings(-color)]"
1896    #SendCmd "map terrain colormode constant"
1897    SendCmd "map terrain lighting $settings(-lighting)"
1898    set _settings(terrain-lighting) $settings(-lighting)
1899    SendCmd "map terrain linecolor [Color2RGB $settings(-edgecolor)]"
1900    #SendCmd "map terrain linewidth $settings(-linewidth)"
1901    SendCmd "map terrain vertscale $settings(-vertscale)"
1902    set _settings(terrain-vertscale) $settings(-vertscale)
1903    SendCmd "map terrain wireframe $settings(-wireframe)"
1904    set _settings(terrain-wireframe) $settings(-wireframe)
1905}
1906
1907itcl::body Rappture::MapViewer::SetLayerStyle { dataobj layer } {
1908    array set info [$dataobj layer $layer]
1909    set _visibility($layer) 1
1910
1911    switch -- $info(type) {
1912        "image" {
1913            array set settings {
1914                -min_level 0
1915                -max_level 23
1916                -opacity 1.0
1917            }
1918            if { [info exists info(style)] } {
1919                array set settings $info(style)
1920            }
1921            if { [info exists info(opacity)] } {
1922                set settings(-opacity) $info(opacity)
1923            }
1924            if {!$_sendEarthFile} {
1925                switch -- $info(driver)  {
1926                    "debug" {
1927                        SendCmd [list map layer add image debug $layer]
1928                    }
1929                    "gdal" {
1930                        SendCmd [list map layer add image gdal \
1931                                     $info(gdal.url) $info(cache) $layer]
1932                    }
1933                    "tms" {
1934                        SendCmd [list map layer add image tms \
1935                                     $info(tms.url) $info(cache) $layer]
1936                    }
1937                    "wms" {
1938                        SendCmd [list map layer add image wms \
1939                                     $info(wms.url) $info(cache)\
1940                                     $info(wms.layers) \
1941                                     $info(wms.format) \
1942                                     $info(wms.transparent) \
1943                                     $layer]
1944                    }
1945                    "xyz" {
1946                        SendCmd [list map layer add image xyz \
1947                                     $info(xyz.url) $info(cache) \
1948                                     $layer]
1949                    }
1950                }                       
1951            }
1952            SendCmd "map layer opacity $settings(-opacity) $layer"
1953        }
1954        "elevation" {
1955            array set settings {
1956                -min_level 0
1957                -max_level 23
1958            }
1959            if { [info exists info(style)] } {
1960                array set settings $info(style)
1961            }
1962            if {!$_sendEarthFile} {
1963                switch -- $info(driver)  {
1964                    "gdal" {
1965                        SendCmd [list map layer add elevation gdal \
1966                                     $info(gdal.url) $layer]
1967                    }
1968                    "tms" {
1969                        SendCmd [list map layer add elevation tms \
1970                                     $info(tms.url) $layer]
1971                    }
1972                }
1973            }
1974        }
1975        "line" {
1976            array set settings {
1977                -color black
1978                -minbias 1000
1979                -opacity 1.0
1980                -width 1
1981            }
1982            if { [info exists info(style)] } {
1983                array set settings $info(style)
1984            }
1985            if { [info exists info(opacity)] } {
1986                set settings(-opacity) $info(opacity)
1987            }
1988            SendCmd [list map layer add line $info(ogr.url) $layer]
1989            SendCmd "map layer opacity $settings(-opacity) $layer"
1990        }
1991        "polygon" {
1992            array set settings {
1993                -color white
1994                -minbias 1000
1995                -opacity 1.0
1996            }
1997            if { [info exists info(style)] } {
1998                array set settings $info(style)
1999            }
2000            if { [info exists info(opacity)] } {
2001                set settings(-opacity) $info(opacity)
2002            }
2003            SendCmd [list map layer add polygon $info(ogr.url) $layer]
2004            SendCmd "map layer opacity $settings(-opacity) $layer"
2005        }
2006        "label" {
2007            array set settings {
2008                -align "center-center"
2009                -color black
2010                -declutter 1
2011                -font Arial
2012                -fontsize 16.0
2013                -halocolor white
2014                -halowidth 2.0
2015                -layout "ltr"
2016                -minbias 1000
2017                -opacity 1.0
2018                -removedupe 1
2019            }
2020            if { [info exists info(style)] } {
2021                array set settings $info(style)
2022            }
2023            if { [info exists info(opacity)] } {
2024                set settings(-opacity) $info(opacity)
2025            }
2026            set contentExpr $info(content)
2027            if {[info exists info(priority)]} {
2028                set priorityExpr $info(priority)
2029            } else {
2030                set priorityExpr ""
2031            }
2032            SendCmd [list map layer add text $info(ogr.url) $contentExpr $priorityExpr $layer]
2033            SendCmd "map layer opacity $settings(-opacity) $layer"
2034        }
2035    }
2036
2037    if { [info exists info(visible)] } {
2038        if { !$info(visible) } {
2039            set _visibility($layer) 0
2040            SendCmd "map layer visible 0 $layer"
2041        }
2042    }
2043}
2044
2045itcl::body Rappture::MapViewer::SetOpacity { dataset } {
2046    foreach {dataobj layer} [split $dataset -] break
2047    set type [$dataobj type $layer]
2048    set val $_settings(-opacity)
2049    set sval [expr { 0.01 * double($val) }]
2050    if { !$_obj2ovride($dataobj-raise) } {
2051        # This is wrong.  Need to figure out why raise isn't set with 1
2052        #set sval [expr $sval * .6]
2053    }
2054    SendCmd "$type opacity $sval $dataset"
2055}
2056
2057itcl::body Rappture::MapViewer::ChangeLayerVisibility { dataobj layer } {
2058    set bool $_visibility($layer)
2059    SendCmd "map layer visible $bool $layer"
2060}
2061
2062itcl::body Rappture::MapViewer::UpdateLayerControls {} {
2063    set row 0
2064    set inner $_layersFrame
2065    if { [winfo exists $inner.layers] } {
2066        foreach w [winfo children $inner.layers] {
2067            destroy $w
2068        }
2069    }
2070    set f $inner.layers
2071    foreach dataobj [get -objects] {
2072        foreach layer [$dataobj layers] {
2073            array unset info
2074            array set info [$dataobj layer $layer]
2075            checkbutton $f.$layer \
2076                -text $info(label) \
2077                -variable [itcl::scope _visibility($layer)] \
2078                -command [itcl::code $this \
2079                              ChangeLayerVisibility $dataobj $layer] \
2080                    -font "Arial 9" -anchor w
2081            blt::table $f $row,0 $f.$layer -anchor w -pady 2
2082            Rappture::Tooltip::for $f.$layer $info(description)
2083            incr row
2084        }
2085    }
2086    if { $row > 0 } {
2087        blt::table configure $f r* c* -resize none
2088        blt::table configure $f r$row c1 -resize expand
2089    }
2090}
2091
2092#
2093# Generate an OSG Earth file to send to server.  This is inteneded
2094# as a stopgap and testing tool until the protocol is fleshed out.
2095#
2096# Note that the lighting settings are required to be "hard-coded"
2097# as below for the runtime control to work.  Don't make those user
2098# configurable.
2099#
2100# Also note: Use "true"/"false" for boolean settings.  Not sure if
2101# the parser in OSG Earth accepts all of Tcl's forms of boolean vals.
2102#
2103itcl::body Rappture::MapViewer::EarthFile {} {
2104    append out "<map"
2105    append out " name=\"$_mapsettings(label)\""
2106    append out " type=\"$_mapsettings(type)\""
2107    append out " version=\"2\""
2108    append out ">\n"
2109    append out " <options lighting=\"true\">\n"
2110    # FIXME: convert color setting to hex
2111    # array set style $_mapsettings(style)
2112    # if {[info exists style(-color)]} {
2113    #     set color "?"
2114    # }
2115    set color "#ffffffff"
2116    append out "  <terrain lighting=\"false\" color=\"$color\"/>\n"
2117    if { [info exists _mapsettings(projection)] } {
2118        append out "  <profile"
2119        append out " srs=\"$_mapsettings(projection)\""
2120        if { [info exists _mapsettings(extents)] } {
2121            append out " xmin=\"$_mapsettings(x1)\""
2122            append out " ymin=\"$_mapsettings(y1)\""
2123            append out " xmax=\"$_mapsettings(x2)\""
2124            append out " ymax=\"$_mapsettings(y2)\""
2125        }
2126        append out "/>\n"
2127    }
2128    append out " </options>\n"
2129
2130    foreach dataobj [get -objects] {
2131        foreach layer [$dataobj layers] {
2132            set _layers($layer) 1
2133            array unset info
2134            array set info [$dataobj layer $layer]
2135            switch -- $info(type) {
2136                "image" {
2137                    append out " <image"
2138                    append out " name=\"$layer\""
2139                    append out " driver=\"gdal\""
2140                    if { [info exists info(opacity)] } {
2141                        append out " opacity=\"$info(opacity)\""
2142                    }
2143                    if { $info(visible) } {
2144                        append out " visible=\"true\""
2145                    } else {
2146                        append out " visible=\"false\""
2147                    }
2148                    append out ">\n"
2149                    append out "  <url>$info(url)</url>\n"
2150                    append out " </image>\n"
2151                }
2152                "elevation" {
2153                    append out " <elevation"
2154                    append out " name=\"$layer\""
2155                    append out " driver=\"gdal\""
2156                    if { $info(visible) } {
2157                        append out " visible=\"true\""
2158                    } else {
2159                        append out " visible=\"false\""
2160                    }
2161                    append out ">\n"
2162                    append out "  <url>$info(url)</url>\n"
2163                    append out " </elevation>\n"
2164                }
2165                default {
2166                    puts stderr "Type $info(type) not implemented in MapViewer::EarthFile"
2167                }
2168            }
2169        }
2170    }
2171    append out "</map>\n"
2172    return $out
2173}
Note: See TracBrowser for help on using the repository browser.