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

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

Layer opacity sliders, disable some controls based on map/layer types.

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