source: branches/geomap/gui/scripts/mapviewer.tcl @ 5949

Last change on this file since 5949 was 5949, checked in by dkearney, 7 years ago

adding data provider and layer objects, updating mapviewer to remove layers from client and server.

File size: 110.2 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    constructor { hostlist args } {
42        Rappture::VisViewer::constructor $hostlist
43    } {
44        # defined below
45    }
46    destructor {
47        # defined below
48    }
49    public proc SetServerList { namelist } {
50        Rappture::VisViewer::SetServerList "geovis" $namelist
51    }
52    public method add {dataobj {settings ""}}
53    public method camera {option args}
54    public method delete {args}
55    public method remove {args}
56    public method disconnect {}
57    public method download {option args}
58    public method get {args}
59    public method isconnected {}
60    public method parameters {title args} {
61        # do nothing
62    }
63    public method scale {args}
64    public method select {option {args ""}}
65
66    public method send { cmd }
67
68    private method KeyPress { key }
69    private method KeyRelease { key }
70    private method MouseClick { button x y }
71    private method MouseDoubleClick { button x y }
72    private method MouseDrag { button x y }
73    private method MouseMotion {}
74    private method MouseRelease { button x y }
75    private method MouseScroll { direction }
76
77    # The following methods are only used by this class.
78    private method AdjustSetting {what {value ""}}
79    private method BuildCameraTab {}
80    private method BuildDownloadPopup { widget command }
81    private method BuildHelpTab {}
82    private method BuildLayerTab {}
83    private method BuildMapTab {}
84    private method BuildTerrainTab {}
85    private method BuildViewpointsTab {}
86    private method Connect {}
87    private method CurrentLayers {args}
88    private method DisablePanningMouseBindings {}
89    private method DisableRotationMouseBindings {}
90    private method DisableZoomMouseBindings {}
91    private method Disconnect {}
92    private method DoPan {}
93    private method DoResize {}
94    private method DoRotate {}
95    private method DoSelect {}
96    private method DrawLegend { colormap min max }
97    private method EarthFile {}
98    private method EnablePanningMouseBindings {}
99    private method EnableRotationMouseBindings {}
100    private method EnableZoomMouseBindings {}
101    private method EventuallyHandleMotionEvent { x y }
102    private method EventuallyPan { dx dy }
103    private method EventuallyResize { w h }
104    private method EventuallyRotate { dx dy }
105    private method EventuallySelect { x y }
106    private method GetImage { args }
107    private method GetNormalizedMouse { x y }
108    private method GoToViewpoint { dataobj viewpoint }
109    private method InitSettings { args  }
110    private method MapIsGeocentric {}
111    private method Pan {option x y}
112    private method Pin {option x y}
113    private method Rebuild {}
114    private method ReceiveImage { args }
115    private method ReceiveLegend { args }
116    private method ReceiveMapInfo { args }
117    private method ReceiveScreenInfo { args }
118    private method RequestLegend { colormap w h }
119    private method Rotate {option x y}
120    private method Select {option x y}
121    private method SendFiles { path }
122    private method SetHeading { {value 0} }
123    private method SetLayerOpacity { dataobj layer {value 100} }
124    private method SetLayerStyle { dataobj layer }
125    private method SetLayerVisibility { dataobj layer }
126    private method SetPitch { {value -89.999} }
127    private method SetTerrainStyle { style }
128    private method ToggleGrid {}
129    private method ToggleLighting {}
130    private method ToggleWireframe {}
131    private method UpdateLayerControls {}
132    private method UpdateViewpointControls {}
133    private method Zoom {option {x 0} {y 0}}
134
135    private variable _layersFrame "";     # Name of layers frame widget
136    private variable _viewpointsFrame ""; # Name of viewpoints frame widget
137    private variable _mapsettings;        # Global map settings
138
139    private variable _dlist "";         # list of data objects
140    private variable _obj2ovride;       # maps dataobj => style override
141    private variable _layers;           # Contains the names of all the
142                                        # layer in the server.
143    private variable _viewpoints;
144    private variable _click;            # info used for rotate operations
145    private variable _view;             # view params for 3D view
146    private variable _pan;
147    private variable _rotate;
148    private variable _select;
149    private variable _motion;
150    private variable _settings
151    private variable _opacity
152    private variable _visibility
153    private variable _reset 1;          # Indicates that server was reset and
154                                        # needs to be reinitialized.
155    private variable _initCamera 1;
156    private variable _haveTerrain 0;
157
158    private variable _first "";         # This is the topmost dataset.
159    private variable _start 0
160    private variable _title ""
161
162    private variable _width 0
163    private variable _height 0
164    private variable _resizePending 0
165    private variable _sendEarthFile 0
166    private variable _useServerManip 0
167    private variable _labelCount 0
168    private variable _b1mode "pan"
169
170    private common _downloadPopup;      # download options from popup
171    private common _hardcopy
172}
173
174itk::usual MapViewer {
175    keep -background -foreground -cursor -font
176    keep -plotbackground -plotforeground
177}
178
179# ----------------------------------------------------------------------
180# CONSTRUCTOR
181# ----------------------------------------------------------------------
182itcl::body Rappture::MapViewer::constructor {hostlist args} {
183    set _serverType "geovis"
184    #DebugOn
185
186    if { [catch {
187
188    # Rebuild event
189    $_dispatcher register !rebuild
190    $_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
191
192    # Resize event
193    $_dispatcher register !resize
194    $_dispatcher dispatch $this !resize "[itcl::code $this DoResize]; list"
195
196    # Pan event
197    $_dispatcher register !pan
198    $_dispatcher dispatch $this !pan "[itcl::code $this DoPan]; list"
199
200    # Rotate event
201    $_dispatcher register !rotate
202    $_dispatcher dispatch $this !rotate "[itcl::code $this DoRotate]; list"
203
204    # Select event
205    $_dispatcher register !select
206    $_dispatcher dispatch $this !select "[itcl::code $this DoSelect]; list"
207
208    # <Motion> event
209    $_dispatcher register !motion
210    $_dispatcher dispatch $this !motion "[itcl::code $this MouseMotion]; list"
211
212    #
213    # Populate parser with commands handle incoming requests
214    #
215    $_parser alias image    [itcl::code $this ReceiveImage]
216    $_parser alias legend   [itcl::code $this ReceiveLegend]
217    $_parser alias map      [itcl::code $this ReceiveMapInfo]
218    $_parser alias camera   [itcl::code $this camera]
219    $_parser alias screen   [itcl::code $this ReceiveScreenInfo]
220    $_parser alias select   [itcl::code $this select]
221
222    # Millisecond delay before animated wait dialog appears
223    set _waitTimeout 900
224
225    # Settings for mouse motion events: these are required
226    # to update the Lat/Long coordinate display
227    array set _motion {
228        compress        1
229        delay           100
230        enable          1
231        pending         0
232        x               0
233        y               0
234    }
235    array set _pan {
236        compress        1
237        delay           100
238        pending         0
239        x               0
240        y               0
241    }
242    array set _rotate {
243        azimuth         0
244        compress        1
245        delay           100
246        elevation       0
247        pending         0
248    }
249    array set _select {
250        compress        1
251        delay           100
252        pending         0
253        x               0
254        y               0
255    }
256    # This array holds the Viewpoint parameters that the
257    # server sends on "camera get".
258    array set _view {
259        distance        1.0
260        heading         0.0
261        pitch           -89.9
262        srs             ""
263        verticalDatum   ""
264        x               0.0
265        y               0.0
266        z               0.0
267    }
268
269    # Note: grid types are "geodetic", "utm" and "mgrs"
270    # Currently only work in geocentric maps
271    array set _settings [subst {
272        camera-throw           0
273        coords-precision       5
274        coords-units           "latlong_decimal_degrees"
275        coords-visible         1
276        grid                   0
277        grid-type              "geodetic"
278        legend                 1
279        terrain-ambient        0.03
280        terrain-edges          0
281        terrain-lighting       0
282        terrain-vertscale      1.0
283        terrain-wireframe      0
284        time                   12
285    }]
286
287    set _settings(time) [clock format [clock seconds] -format %k -gmt 1]
288
289    itk_component add view {
290        canvas $itk_component(plotarea).view \
291            -highlightthickness 0 -borderwidth 0
292    } {
293        usual
294        ignore -highlightthickness -borderwidth  -background
295    }
296
297    set c $itk_component(view)
298    bind $c <Enter> "focus %W"
299    bind $c <Control-F1> [itcl::code $this ToggleConsole]
300
301    # Fix the scrollregion in case we go off screen
302    $c configure -scrollregion [$c bbox all]
303
304    set _map(id) [$c create image 0 0 -anchor nw -image $_image(plot)]
305    set _map(cwidth) -1
306    set _map(cheight) -1
307    set _map(zoom) 1.0
308    set _map(original) ""
309
310    set f [$itk_component(main) component controls]
311    itk_component add reset {
312        button $f.reset -borderwidth 1 -padx 1 -pady 1 \
313            -highlightthickness 0 \
314            -image [Rappture::icon reset-view] \
315            -command [itcl::code $this camera reset]
316    } {
317        usual
318        ignore -highlightthickness
319    }
320    pack $itk_component(reset) -side top -padx 2 -pady 2
321    Rappture::Tooltip::for $itk_component(reset) \
322        "Reset the view to the default zoom level"
323
324    itk_component add zoomin {
325        button $f.zin -borderwidth 1 -padx 1 -pady 1 \
326            -highlightthickness 0 \
327            -image [Rappture::icon zoom-in] \
328            -command [itcl::code $this Zoom in]
329    } {
330        usual
331        ignore -highlightthickness
332    }
333    pack $itk_component(zoomin) -side top -padx 2 -pady 2
334    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
335
336    itk_component add zoomout {
337        button $f.zout -borderwidth 1 -padx 1 -pady 1 \
338            -highlightthickness 0 \
339            -image [Rappture::icon zoom-out] \
340            -command [itcl::code $this Zoom out]
341    } {
342        usual
343        ignore -highlightthickness
344    }
345    pack $itk_component(zoomout) -side top -padx 2 -pady 2
346    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
347
348    BuildLayerTab
349    BuildViewpointsTab
350    BuildMapTab
351    BuildTerrainTab
352    BuildCameraTab
353    BuildHelpTab
354
355    # Legend
356
357    set _image(legend) [image create photo]
358    itk_component add legend {
359        canvas $itk_component(plotarea).legend -width 50 -highlightthickness 0
360    } {
361        usual
362        ignore -highlightthickness
363        rename -background -plotbackground plotBackground Background
364    }
365
366    # Hack around the Tk panewindow.  The problem is that the requested
367    # size of the 3d view isn't set until an image is retrieved from
368    # the server.  So the panewindow uses the tiny size.
369    pack forget $itk_component(view)
370    blt::table $itk_component(plotarea) \
371        0,0 $itk_component(view) -fill both -reqwidth 10000
372    blt::table configure $itk_component(plotarea) c1 -resize none
373
374    bind $itk_component(view) <Configure> \
375        [itcl::code $this EventuallyResize %w %h]
376
377    set _useServerManip 1
378    EnablePanningMouseBindings
379    EnableRotationMouseBindings
380    EnableZoomMouseBindings
381    set _useServerManip 0
382
383    if {$_useServerManip} {
384        # Bindings for keyboard events
385        bind $itk_component(view) <KeyPress> \
386            [itcl::code $this KeyPress %N]
387        bind $itk_component(view) <KeyRelease> \
388            [itcl::code $this KeyRelease %N]
389
390        # Zoom to point
391        bind $itk_component(view) <Double-1> \
392            [itcl::code $this MouseDoubleClick 1 %x %y]
393        bind $itk_component(view) <Double-3> \
394            [itcl::code $this MouseDoubleClick 3 %x %y]
395
396        # Unused
397        bind $itk_component(view) <Double-2> \
398            [itcl::code $this MouseDoubleClick 2 %x %y]
399
400        # Binding for mouse motion events
401        if {$_motion(enable)} {
402            bind $itk_component(view) <Motion> \
403                [itcl::code $this EventuallyHandleMotionEvent %x %y]
404        }
405    } else {
406        # Zoom to point
407        bind $itk_component(view) <Double-1> \
408            [itcl::code $this camera go %x %y 0.4]
409        # Travel to point (no zoom)
410        bind $itk_component(view) <Shift-Double-1> \
411            [itcl::code $this camera go %x %y 1.0]
412        # Zoom out centered on point
413        bind $itk_component(view) <Double-3> \
414            [itcl::code $this camera go %x %y 2.5]
415
416        # Pin placemark annotations
417        bind $itk_component(view) <Control-ButtonPress-1> \
418            [itcl::code $this Pin add %x %y]
419        bind $itk_component(view) <Control-ButtonPress-3> \
420            [itcl::code $this Pin delete %x %y]
421
422        # Draw selection rectangle
423        bind $itk_component(view) <Shift-ButtonPress-1> \
424            [itcl::code $this Select click %x %y]
425        bind $itk_component(view) <B1-Motion> \
426            +[itcl::code $this Select drag %x %y]
427        bind $itk_component(view) <Shift-ButtonRelease-1> \
428            [itcl::code $this Select release %x %y]
429
430        # Update coordinate readout
431        bind $itk_component(view) <ButtonPress-1> \
432            +[itcl::code $this SendCmd "map setpos %x %y"]
433        bind $itk_component(view) <Double-3> \
434            +[itcl::code $this SendCmd "map setpos %x %y"]
435
436        # Bindings for panning via keyboard
437        bind $itk_component(view) <KeyPress-Left> \
438            [itcl::code $this Pan set 10 0]
439        bind $itk_component(view) <KeyPress-Right> \
440            [itcl::code $this Pan set -10 0]
441        bind $itk_component(view) <KeyPress-Up> \
442            [itcl::code $this Pan set 0 -10]
443        bind $itk_component(view) <KeyPress-Down> \
444            [itcl::code $this Pan set 0 10]
445
446        bind $itk_component(view) <Shift-KeyPress-Left> \
447            [itcl::code $this Pan set 2 0]
448        bind $itk_component(view) <Shift-KeyPress-Right> \
449            [itcl::code $this Pan set -2 0]
450        bind $itk_component(view) <Shift-KeyPress-Up> \
451            [itcl::code $this Pan set 0 -2]
452        bind $itk_component(view) <Shift-KeyPress-Down> \
453            [itcl::code $this Pan set 0 2]
454
455        # Bindings for rotation via keyboard
456        bind $itk_component(view) <Control-Left> \
457            [itcl::code $this Rotate set 10 0]
458        bind $itk_component(view) <Control-Right> \
459            [itcl::code $this Rotate set -10 0]
460        bind $itk_component(view) <Control-Up> \
461            [itcl::code $this Rotate set 0 -10]
462        bind $itk_component(view) <Control-Down> \
463            [itcl::code $this Rotate set 0 10]
464
465        bind $itk_component(view) <Control-Shift-Left> \
466            [itcl::code $this Rotate set 2 0]
467        bind $itk_component(view) <Control-Shift-Right> \
468            [itcl::code $this Rotate set -2 0]
469        bind $itk_component(view) <Control-Shift-Up> \
470            [itcl::code $this Rotate set 0 -2]
471        bind $itk_component(view) <Control-Shift-Down> \
472            [itcl::code $this Rotate set 0 2]
473
474        # Bindings for zoom via keyboard
475        bind $itk_component(view) <KeyPress-Prior> \
476            [itcl::code $this Zoom out]
477        bind $itk_component(view) <KeyPress-Next> \
478            [itcl::code $this Zoom in]
479        bind $itk_component(view) <KeyPress-Home> \
480            [itcl::code $this camera reset]
481
482        # Keyboard shortcuts
483        # Reset heading to North
484        bind $itk_component(view) <n> \
485            [itcl::code $this SetHeading]
486        # Reset pitch to top-down (2D) view
487        bind $itk_component(view) <p> \
488            [itcl::code $this SetPitch]
489        bind $itk_component(view) <g> \
490            [itcl::code $this ToggleGrid]
491        bind $itk_component(view) <l> \
492            [itcl::code $this ToggleLighting]
493        bind $itk_component(view) <w> \
494            [itcl::code $this ToggleWireframe]
495
496        # Binding for mouse motion events
497        set _motion(compress) 1
498        if {$_motion(enable)} {
499            bind $itk_component(view) <Motion> \
500                [itcl::code $this EventuallyHandleMotionEvent %x %y]
501        }
502        #bind $itk_component(view) <Motion> \
503        #    +[itcl::code $this SendCmd "map pin hover %x %y"]
504    }
505
506    bind $itk_component(view) <Enter> "focus $itk_component(view)"
507
508    if {[string equal "x11" [tk windowingsystem]]} {
509        # Bindings for zoom via mouse
510        if {$_useServerManip} {
511            bind $itk_component(view) <4> [itcl::code $this MouseScroll up]
512            bind $itk_component(view) <5> [itcl::code $this MouseScroll down]
513        } else {
514            bind $itk_component(view) <4> [itcl::code $this Zoom out]
515            bind $itk_component(view) <5> [itcl::code $this Zoom in]
516        }
517    }
518
519    set _image(download) [image create photo]
520
521    eval itk_initialize $args
522    Connect
523} errs] != 0 } {
524        puts stderr errs=$errs
525    }
526}
527
528# ----------------------------------------------------------------------
529# DESTRUCTOR
530# ----------------------------------------------------------------------
531itcl::body Rappture::MapViewer::destructor {} {
532    Disconnect
533    $_dispatcher cancel !rebuild
534    $_dispatcher cancel !resize
535    $_dispatcher cancel !rotate
536    image delete $_image(plot)
537    image delete $_image(download)
538}
539
540#
541# send --
542#
543#   Test method for dsk
544#
545#       send [list my command]
546#
547itcl::body Rappture::MapViewer::send {cmd} {
548    puts "sending: \"$cmd\""
549    SendCmd $cmd
550}
551
552itcl::body Rappture::MapViewer::DoResize {} {
553    set sendResize 1
554    if { $_width < 2 } {
555        set _width 500
556        set sendResize 0
557    }
558    if { $_height < 2 } {
559        set _height 500
560        set sendResize 0
561    }
562    #set _start [clock clicks -milliseconds]
563    if {$sendResize} {
564        SendCmd "screen size $_width $_height"
565    }
566    set _resizePending 0
567}
568
569itcl::body Rappture::MapViewer::DoRotate {} {
570    SendCmd "camera rotate $_rotate(azimuth) $_rotate(elevation)"
571    set _rotate(azimuth) 0
572    set _rotate(elevation) 0
573    set _rotate(pending) 0
574}
575
576itcl::body Rappture::MapViewer::DoSelect {} {
577    SendCmd "map box update $_select(x) $_select(y)"
578    set _select(x) 0
579    set _select(y) 0
580    set _select(pending) 0
581}
582
583itcl::body Rappture::MapViewer::EventuallyResize { w h } {
584    set _width $w
585    set _height $h
586    if { !$_resizePending } {
587        set _resizePending 1
588        $_dispatcher event -after 200 !resize
589    }
590}
591
592itcl::body Rappture::MapViewer::DoPan {} {
593    SendCmd "camera pan $_pan(x) $_pan(y)"
594    set _pan(x) 0
595    set _pan(y) 0
596    set _pan(pending) 0
597}
598
599itcl::body Rappture::MapViewer::EventuallyPan { dx dy } {
600    set _pan(x) [expr $_pan(x) + $dx]
601    set _pan(y) [expr $_pan(y) + $dy]
602    if { !$_pan(compress) } {
603        DoPan
604        return
605    }
606    if { !$_pan(pending) } {
607        set _pan(pending) 1
608        $_dispatcher event -after $_pan(delay) !pan
609    }
610}
611
612itcl::body Rappture::MapViewer::EventuallyRotate { dx dy } {
613    set _rotate(azimuth) [expr $_rotate(azimuth) + $dx]
614    set _rotate(elevation) [expr $_rotate(elevation) + $dy]
615    if { !$_rotate(compress) } {
616        DoRotate
617        return
618    }
619    if { !$_rotate(pending) } {
620        set _rotate(pending) 1
621        $_dispatcher event -after $_rotate(delay) !rotate
622    }
623}
624
625itcl::body Rappture::MapViewer::EventuallySelect { x y } {
626    set _select(x) $x
627    set _select(y) $y
628    if { !$_select(compress) } {
629        DoSelect
630        return
631    }
632    if { !$_select(pending) } {
633        set _select(pending) 1
634        $_dispatcher event -after $_select(delay) !select
635    }
636}
637
638itcl::body Rappture::MapViewer::DrawLegend { colormap min max } {
639    if { [info exists itk_component(legend-$colormap) ] } {
640        $itk_component(legend-$colormap-min) configure -text $min
641        $itk_component(legend-$colormap-max) configure -text $max
642        $itk_component(legend-$colormap) configure -image $_image(legend-$colormap)
643    }
644}
645
646itcl::body Rappture::MapViewer::RequestLegend { colormap w h } {
647    SendCmd "legend $colormap $w $h 0 [Color2RGB #d9d9d9]"
648}
649
650# ----------------------------------------------------------------------
651# USAGE: add <dataobj> ?<settings>?
652#
653# Clients use this to add a data object to the plot.  The optional
654# <settings> are used to configure the plot.  Allowed settings are
655# -color, -brightness, -width, -linestyle, and -raise.
656# ----------------------------------------------------------------------
657itcl::body Rappture::MapViewer::add {dataobj {settings ""}} {
658    DebugTrace "Enter"
659    array set params {
660        -brightness 0
661        -color auto
662        -description ""
663        -linestyle solid
664        -param ""
665        -raise 0
666        -simulation 0
667        -type ""
668        -width 1
669    }
670    array set params $settings
671    set params(-description) ""
672    set params(-param) ""
673    array set params $settings
674
675    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
676        # can't handle -autocolors yet
677        set params(-color) black
678    }
679    set pos [lsearch -exact $_dlist $dataobj]
680    if {$pos < 0} {
681        #if {[llength $_dlist] > 0} {
682        #    error "Can't add more than 1 map to mapviewer"
683        #}
684        lappend _dlist $dataobj
685    }
686    set _obj2ovride($dataobj-raise) $params(-raise)
687    $_dispatcher event -idle !rebuild
688}
689
690# ----------------------------------------------------------------------
691# USAGE: delete ?<dataobj1> <dataobj2> ...?
692#
693# Clients use this to delete a dataobj from the plot.  If no dataobjs
694# are specified, then all dataobjs are deleted.  No data objects are
695# deleted.  They are only removed from the display list.
696# ----------------------------------------------------------------------
697itcl::body Rappture::MapViewer::delete {args} {
698    DebugTrace "Enter"
699    if { [llength $args] == 0} {
700        set args $_dlist
701    }
702    # Delete all specified dataobjs
703    set changed 0
704    foreach dataobj $args {
705        set pos [lsearch -exact $_dlist $dataobj]
706        if { $pos < 0 } {
707            continue;                   # Don't know anything about it.
708        }
709        # When a map is marked deleted, we hide its layers.
710        foreach layer [$dataobj layer names] {
711            SendCmd "map layer visible 0 $layer"
712            set _visibility($layer) 0
713        }
714        # Remove it from the dataobj list.
715        set _dlist [lreplace $_dlist $pos $pos]
716        array unset _obj2ovride $dataobj-*
717        array unset _settings $dataobj-*
718        set changed 1
719    }
720    # If anything changed, then rebuild the plot
721    if { $changed } {
722        $_dispatcher event -idle !rebuild
723    }
724}
725
726# ----------------------------------------------------------------------
727# USAGE: remove ?<dataobj1> <dataobj2> ...?
728#
729# Clients use this to permanantly remove a dataobj from the client
730# and the server. If no dataobjs are specified, then all dataobjs
731# are removed. Unlike the delete method, dataobjects are permenantly
732# removed from both the client and the server and it is safe to add
733# them again without conflict in layer names.
734# ----------------------------------------------------------------------
735itcl::body Rappture::MapViewer::remove {args} {
736    DebugTrace "Enter"
737    if { [llength $args] == 0} {
738        set args $_dlist
739    }
740    # Remove all specified dataobjs
741    set changed 0
742    foreach dataobj $args {
743        set pos [lsearch -exact $_dlist $dataobj]
744        if { $pos < 0 } {
745            continue;                   # Don't know anything about it.
746        }
747        # Remove the layers from the client and server.
748        foreach layer [$dataobj layer names] {
749            SendCmd "map layer delete $layer"
750            if { [info exists _layers($layer)] } {
751                array unset _layers $layer
752            }
753            if { [info exists _opacity($layer)] } {
754                array unset _opacity $layer
755            }
756            if { [info exists _visibility($layer)] } {
757                array unset _visibility $layer
758            }
759        }
760        # Remove it from the dataobj list.
761        set _dlist [lreplace $_dlist $pos $pos]
762        array unset _obj2ovride $dataobj-*
763        array unset _settings $dataobj-*
764        set changed 1
765    }
766    # If anything changed, then rebuild the plot
767    if { $changed } {
768        $_dispatcher event -idle !rebuild
769    }
770}
771
772# ----------------------------------------------------------------------
773# USAGE: get ?-objects?
774# USAGE: get ?-visible?
775# USAGE: get ?-image view?
776#
777# Clients use this to query the list of objects being plotted, in
778# order from bottom to top of this result.  The optional "-image"
779# flag can also request the internal images being shown.
780# ----------------------------------------------------------------------
781itcl::body Rappture::MapViewer::get {args} {
782    if {[llength $args] == 0} {
783        set args "-objects"
784    }
785
786    set op [lindex $args 0]
787    switch -- $op {
788        "-objects" {
789            # put the dataobj list in order according to -raise options
790            set dlist {}
791            foreach dataobj $_dlist {
792                if { ![$dataobj isvalid] } {
793                    continue
794                }
795                if {[info exists _obj2ovride($dataobj-raise)] &&
796                    $_obj2ovride($dataobj-raise)} {
797                    set dlist [linsert $dlist 0 $dataobj]
798                } else {
799                    lappend dlist $dataobj
800                }
801            }
802            return $dlist
803        }
804        "-visible" {
805            set dlist {}
806            foreach dataobj $_dlist {
807                if { ![$dataobj isvalid] } {
808                    continue
809                }
810                if { ![info exists _obj2ovride($dataobj-raise)] } {
811                    # No setting indicates that the object isn't visible.
812                    continue
813                }
814                # Otherwise use the -raise parameter to put the object to
815                # the front of the list.
816                if { $_obj2ovride($dataobj-raise) } {
817                    set dlist [linsert $dlist 0 $dataobj]
818                } else {
819                    lappend dlist $dataobj
820                }
821            }
822            return $dlist
823        }
824        -image {
825            if {[llength $args] != 2} {
826                error "wrong # args: should be \"get -image view\""
827            }
828            switch -- [lindex $args end] {
829                view {
830                    return $_image(plot)
831                }
832                default {
833                    error "bad image name \"[lindex $args end]\": should be view"
834                }
835            }
836        }
837        default {
838            error "bad option \"$op\": should be -objects or -image"
839        }
840    }
841}
842
843itcl::body Rappture::MapViewer::MapIsGeocentric {} {
844    if { [info exists _mapsettings(type)] } {
845        return [expr {$_mapsettings(type) eq "geocentric"}]
846    } else {
847        return 0
848    }
849}
850
851# ----------------------------------------------------------------------
852# USAGE: scale ?<data1> <data2> ...?
853#
854# Sets the default limits for the overall plot according to the
855# limits of the data for all of the given <data> objects.  This
856# accounts for all objects--even those not showing on the screen.
857# Because of this, the limits are appropriate for all objects as
858# the user scans through data in the ResultSet viewer.
859# ----------------------------------------------------------------------
860itcl::body Rappture::MapViewer::scale {args} {
861    DebugTrace "Enter"
862    array unset _mapsettings
863    set _haveTerrain 0
864
865    # Verify that all the maps have the same global settings. For example,
866    # you can't have one map type "geocentric" and the other "projected".
867
868    foreach dataobj $args {
869        if { ![$dataobj isvalid] } {
870            continue
871        }
872        array unset hints
873        array set hints [$dataobj hints]
874        if { ![info exists _mapsettings(label)] } {
875            set _mapsettings(label) $hints(label)
876        }
877        if { ![info exists _mapsettings(style)] } {
878            DebugTrace "map style: $hints(style)"
879            set _mapsettings(style) $hints(style)
880        }
881        if { ![info exists _mapsettings(type)] } {
882            set _mapsettings(type) $hints(type)
883        } elseif { $hints(type) != $_mapsettings(type) } {
884            error "maps \"$hints(label)\" have differing types"
885        }
886        if { ![info exists _mapsettings(projection)] } {
887            set _mapsettings(projection) $hints(projection)
888        } elseif { $hints(projection) != $_mapsettings(projection) } {
889            error "maps \"$hints(label)\" have differing projections"
890        }
891        if { $hints(extents) != "" } {
892            if { ![info exists _mapsettings(extents)] } {
893                set _mapsettings(extents) $hints(extents)
894            }
895            foreach {x1 y1 x2 y2} $hints(extents) break
896            if { ![info exists _mapsettings(x1)] || $x1 < $_mapsettings(x1) } {
897                set _mapsettings(x1) $x1
898            }
899            if { ![info exists _mapsettings(y1)] || $y1 < $_mapsettings(y1) } {
900                set _mapsettings(y1) $y1
901            }
902            if { ![info exists _mapsettings(x2)] || $x2 > $_mapsettings(x2) } {
903                set _mapsettings(x2) $x2
904            }
905            if { ![info exists _mapsettings(y2)] || $y2 > $_mapsettings(y2) } {
906                set _mapsettings(y2) $y2
907            }
908        }
909        if { [info exists hints(camera)] } {
910            if { ![info exists _mapsettings(camera)] } {
911                set _mapsettings(camera) $hints(camera)
912            }
913        }
914        foreach layer [$dataobj layer names] {
915            if { [$dataobj type $layer] == "elevation" } {
916                set _haveTerrain 1
917                break
918            }
919        }
920        foreach viewpoint [$dataobj viewpoints] {
921            set _viewpoints($viewpoint) [$dataobj viewpoint $viewpoint]
922            if 0 {
923                array set vp $_viewpoints($viewpoint)
924                foreach key { label description x y z distance heading pitch srs verticalDatum } {
925                    if { [info exists vp($key)] } {
926                        puts stderr "$viewpoint $key $vp($key)"
927                    }
928                }
929            }
930        }
931    }
932    if { $_haveTerrain } {
933        if { [$itk_component(main) exists "Terrain Settings"] } {
934            # TODO: Enable controls like vertical scale that only have
935            # an effect when terrain is present
936        }
937    }
938}
939
940# ----------------------------------------------------------------------
941# USAGE: select clear
942# USAGE: select feature
943# USAGE: select annotation
944# ----------------------------------------------------------------------
945itcl::body Rappture::MapViewer::select {option {args ""}} {
946    DebugTrace "Enter"
947    switch $option {
948        "annotation" {
949            puts stderr "select annotation $args"
950        }
951        "clear" {
952             puts stderr "select clear"
953        }
954        "feature" {
955             puts stderr "select feature $args"
956        }
957    }
958}
959
960# ----------------------------------------------------------------------
961# USAGE: download coming
962# USAGE: download controls <downloadCommand>
963# USAGE: download now
964#
965# Clients use this method to create a downloadable representation
966# of the plot.  Returns a list of the form {ext string}, where
967# "ext" is the file extension (indicating the type of data) and
968# "string" is the data itself.
969# ----------------------------------------------------------------------
970itcl::body Rappture::MapViewer::download {option args} {
971    switch $option {
972        coming {
973            if {[catch {
974                blt::winop snap $itk_component(plotarea) $_image(download)
975            }]} {
976                $_image(download) configure -width 1 -height 1
977                $_image(download) put #000000
978            }
979        }
980        controls {
981            set popup .mapviewerdownload
982            if { ![winfo exists .mapviewerdownload] } {
983                set inner [BuildDownloadPopup $popup [lindex $args 0]]
984            } else {
985                set inner [$popup component inner]
986            }
987            set _downloadPopup(image_controls) $inner.image_frame
988            set num [llength [get]]
989            set num [expr {($num == 1) ? "1 result" : "$num results"}]
990            set word [Rappture::filexfer::label downloadWord]
991            $inner.summary configure -text "$word $num in the following format:"
992            update idletasks            ;# Fix initial sizes
993            return $popup
994        }
995        now {
996            set popup .mapviewerdownload
997            if {[winfo exists .mapviewerdownload]} {
998                $popup deactivate
999            }
1000            switch -- $_downloadPopup(format) {
1001                "image" {
1002                    return [$this GetImage [lindex $args 0]]
1003                }
1004            }
1005            return ""
1006        }
1007        default {
1008            error "bad option \"$option\": should be coming, controls, now"
1009        }
1010    }
1011}
1012
1013# ----------------------------------------------------------------------
1014# USAGE: Connect ?<host:port>,<host:port>...?
1015#
1016# Clients use this method to establish a connection to a new
1017# server, or to reestablish a connection to the previous server.
1018# Any existing connection is automatically closed.
1019# ----------------------------------------------------------------------
1020itcl::body Rappture::MapViewer::Connect {} {
1021    global readyForNextFrame
1022    set readyForNextFrame 1
1023    set _reset 1
1024    set _hosts [GetServerList "geovis"]
1025    if { "" == $_hosts } {
1026        return 0
1027    }
1028    set result [VisViewer::Connect $_hosts]
1029    if { $result } {
1030        if { $_reportClientInfo }  {
1031            # Tell the server the viewer, hub, user and session.
1032            # Do this immediately on connect before buffering any commands
1033            global env
1034
1035            set info {}
1036            set user "???"
1037            if { [info exists env(USER)] } {
1038                set user $env(USER)
1039            }
1040            set session "???"
1041            if { [info exists env(SESSION)] } {
1042                set session $env(SESSION)
1043            }
1044            lappend info "version" "$Rappture::version"
1045            lappend info "build" "$Rappture::build"
1046            lappend info "svnurl" "$Rappture::svnurl"
1047            lappend info "installdir" "$Rappture::installdir"
1048            lappend info "hub" [exec hostname]
1049            lappend info "client" "mapviewer"
1050            lappend info "user" $user
1051            lappend info "session" $session
1052            SendCmd "clientinfo [list $info]"
1053        }
1054
1055        set w [winfo width $itk_component(view)]
1056        set h [winfo height $itk_component(view)]
1057        EventuallyResize $w $h
1058    }
1059    return $result
1060}
1061
1062#
1063# isconnected --
1064#
1065#   Indicates if we are currently connected to the visualization server.
1066#
1067itcl::body Rappture::MapViewer::isconnected {} {
1068    return [VisViewer::IsConnected]
1069}
1070
1071#
1072# disconnect --
1073#
1074itcl::body Rappture::MapViewer::disconnect {} {
1075    Disconnect
1076    set _reset 1
1077}
1078
1079#
1080# Disconnect --
1081#
1082#   Clients use this method to disconnect from the current rendering
1083#   server.
1084#
1085itcl::body Rappture::MapViewer::Disconnect {} {
1086    VisViewer::Disconnect
1087
1088    $_dispatcher cancel !pan
1089    $_dispatcher cancel !motion
1090    $_dispatcher cancel !rebuild
1091    $_dispatcher cancel !resize
1092    $_dispatcher cancel !rotate
1093    # disconnected -- no more data sitting on server
1094    array unset _layers
1095    array unset _layersFrame
1096    global readyForNextFrame
1097    set readyForNextFrame 1
1098}
1099
1100# ----------------------------------------------------------------------
1101# USAGE: ReceiveImage -type <type> -token <token> -bytes <size>
1102#
1103# Invoked automatically whenever the "image" command comes in from
1104# the rendering server.  Indicates that binary image data with the
1105# specified <size> will follow.
1106# ----------------------------------------------------------------------
1107itcl::body Rappture::MapViewer::ReceiveImage { args } {
1108    global readyForNextFrame
1109    set readyForNextFrame 1
1110    array set info {
1111        -bytes 0
1112        -token "???"
1113        -type image
1114    }
1115    array set info $args
1116    set bytes [ReceiveBytes $info(-bytes)]
1117    if { $info(-type) == "image" } {
1118        $_image(plot) configure -data $bytes
1119    } elseif { $info(type) == "print" } {
1120        set tag $this-print-$info(-token)
1121        set _hardcopy($tag) $bytes
1122    }
1123    set _waitTimeout 0
1124}
1125
1126#
1127# ReceiveLegend
1128#
1129# Invoked automatically whenever the "legend" command comes in from
1130# the rendering server.  Indicates that binary image data with the
1131# specified <size> will follow.
1132#
1133itcl::body Rappture::MapViewer::ReceiveLegend { colormap min max size } {
1134    DebugTrace "ReceiveLegend colormap=$colormap range=$min,$max size=$size"
1135    if { [IsConnected] } {
1136        set bytes [ReceiveBytes $size]
1137        if { ![info exists _image(legend)] } {
1138            set _image(legend-$colormap) [image create photo]
1139        }
1140        if 0 {
1141            set f [open "/tmp/legend-${colormap}.ppm" "w"]
1142            fconfigure $f -translation binary -encoding binary
1143            puts $f $bytes
1144            close $f
1145        }
1146        $_image(legend-$colormap) configure -data $bytes
1147        #puts stderr "read $size bytes for [image width $_image(legend-$colormap)]x[image height $_image(legend-$colormap)] legend>"
1148        if { [catch {DrawLegend $colormap $min $max} errs] != 0 } {
1149            global errorInfo
1150            puts stderr "errs=$errs errorInfo=$errorInfo"
1151        }
1152    }
1153}
1154
1155#
1156# ReceiveMapInfo --
1157#
1158itcl::body Rappture::MapViewer::ReceiveMapInfo { args } {
1159    if { ![isconnected] } {
1160        return
1161    }
1162    set timeReceived [clock clicks -milliseconds]
1163    set elapsed [expr $timeReceived - $_start]
1164    set option [lindex $args 0]
1165    switch -- $option {
1166        "coords" {
1167            set len [llength $args]
1168            if {$len < 3} {
1169                error "Bad map coords response"
1170            } else {
1171                set token [lindex $args 1]
1172            }
1173            foreach { x y z } [lindex $args 2] {
1174                puts stderr "\[$token\] Map coords: $x $y $z"
1175            }
1176            if {$len > 3} {
1177                set srs [lindex $args 3]
1178                set vert [lindex $args 4]
1179                puts stderr "\[$token\] {$srs} {$vert}"
1180            }
1181        }
1182        "names" {
1183            foreach { name } [lindex $args 1] {
1184                puts stderr "layer: $name"
1185            }
1186        }
1187        default {
1188            error "unknown map option \"$option\" from server"
1189        }
1190    }
1191}
1192
1193#
1194# ReceiveScreenInfo --
1195#
1196itcl::body Rappture::MapViewer::ReceiveScreenInfo { args } {
1197    if { ![isconnected] } {
1198        return
1199    }
1200    set option [lindex $args 0]
1201    switch -- $option {
1202        "coords" {
1203            set len [llength $args]
1204            if {$len < 3} {
1205                error "Bad screen coords response"
1206            } else {
1207                set token [lindex $args 1]
1208            }
1209            foreach { x y z } [lindex $args 2] {
1210                puts stderr "\[$token\] Screen coords: $x $y $z"
1211            }
1212        }
1213        default {
1214            error "unknown screen option \"$option\" from server"
1215        }
1216    }
1217}
1218
1219# ----------------------------------------------------------------------
1220# USAGE: Rebuild
1221#
1222# Called automatically whenever something changes that affects the
1223# data in the widget.  Clears any existing data and rebuilds the
1224# widget to display new data.
1225# ----------------------------------------------------------------------
1226itcl::body Rappture::MapViewer::Rebuild {} {
1227    set w [winfo width $itk_component(view)]
1228    set h [winfo height $itk_component(view)]
1229    if { $w < 2 || $h < 2 } {
1230        update idletasks
1231        $_dispatcher event -idle !rebuild
1232        return
1233    }
1234
1235    # Turn on buffering of commands to the server.  We don't want to be
1236    # preempted by a server disconnect/reconnect (which automatically
1237    # generates a new call to Rebuild).
1238    StartBufferingCommands
1239
1240    if { $_reset } {
1241        set _width $w
1242        set _height $h
1243        DoResize
1244
1245        if { [info exists _mapsettings(type)] } {
1246            # The map must be reset once before any layers are added This
1247            # should not be done more than once as it is very expensive.
1248            if {$_sendEarthFile} {
1249                set bytes [EarthFile]
1250                if {0} {
1251                    set f [open "/tmp/map.earth" "w"]
1252                    puts $f $bytes
1253                    close $f
1254                }
1255                set length [string length $bytes]
1256                SendCmd "map load data follows $length"
1257                SendData $bytes
1258            } else {
1259                if { [info exists _mapsettings(style)] } {
1260                    array set settings {
1261                        -color white
1262                    }
1263                    array set settings $_mapsettings(style)
1264                }
1265                set bgcolor [Color2RGB $settings(-color)]
1266                if { $_mapsettings(type) == "geocentric" } {
1267                    $itk_component(grid) configure -state normal
1268                    $itk_component(time_l) configure -state normal
1269                    $itk_component(time) configure -state normal
1270                    $itk_component(pitch_slider_l) configure -state normal
1271                    $itk_component(pitch_slider) configure -state normal
1272                    EnableRotationMouseBindings
1273                    SendCmd "map reset geocentric $bgcolor"
1274                }  else {
1275                    $itk_component(grid) configure -state disabled
1276                    $itk_component(time_l) configure -state disabled
1277                    $itk_component(time) configure -state disabled
1278                    $itk_component(pitch_slider_l) configure -state disabled
1279                    $itk_component(pitch_slider) configure -state disabled
1280                    DisableRotationMouseBindings
1281                    set proj $_mapsettings(projection)
1282                    SendCmd "screen bgcolor $bgcolor"
1283                    if { $proj == "" } {
1284                        SendCmd "map reset projected $bgcolor global-mercator"
1285                    } elseif { ![info exists _mapsettings(extents)] || $_mapsettings(extents) == "" } {
1286                        SendCmd "map reset projected $bgcolor [list $proj]"
1287                    } else {
1288                        #foreach {x1 y1 x2 y2} $_mapsettings(extents) break
1289                        foreach key "x1 y1 x2 y2" {
1290                            set $key $_mapsettings($key)
1291                        }
1292                        SendCmd "map reset projected $bgcolor [list $proj] $x1 $y1 $x2 $y2"
1293                    }
1294                }
1295                # XXX: Remove these after implementing batch load of layers with reset
1296                SendCmd "map layer delete base"
1297            }
1298
1299            # Most terrain settings are global to the map and apply even
1300            # if there is no elevation layer.  The exception is the
1301            # vertical scale, which only applies if there is an elevation
1302            # layer
1303            if { [info exists _mapsettings(style)] } {
1304                SetTerrainStyle $_mapsettings(style)
1305            } else {
1306                InitSettings terrain-ambient terrain-edges terrain-lighting \
1307                    terrain-vertscale terrain-wireframe
1308            }
1309            InitSettings coords-visible
1310        } else {
1311            error "No map settings on reset"
1312        }
1313    }
1314
1315    set _first ""
1316    set haveTerrain 0
1317    foreach dataobj [get -objects] {
1318        if { [info exists _obj2ovride($dataobj-raise)] &&  $_first == "" } {
1319            set _first $dataobj
1320        }
1321        foreach layer [$dataobj layer names] {
1322            array unset info
1323            array set info [$dataobj layer settings $layer]
1324            if { ![info exists _layers($layer)] } {
1325                if { $_reportClientInfo }  {
1326                    set cinfo {}
1327                    lappend cinfo "tool_id"       [$dataobj hints toolid]
1328                    lappend cinfo "tool_name"     [$dataobj hints toolname]
1329                    lappend cinfo "tool_title"    [$dataobj hints tooltitle]
1330                    lappend cinfo "tool_command"  [$dataobj hints toolcommand]
1331                    lappend cinfo "tool_revision" [$dataobj hints toolrevision]
1332                    lappend cinfo "dataset_label" [encoding convertto utf-8 $info(label)]
1333                    lappend cinfo "dataset_tag"   $layer
1334                    SendCmd "clientinfo [list $cinfo]"
1335                }
1336                set _layers($layer) 1
1337                SetLayerStyle $dataobj $layer
1338            }
1339            if {$info(type) == "elevation"} {
1340                set haveTerrain 1
1341            }
1342            # FIXME: This is overriding all layers' initial visibility setting
1343            if { [info exists _obj2ovride($dataobj-raise)] &&
1344                 $_obj2ovride($dataobj-raise)} {
1345                SendCmd "map layer visible 1 $layer"
1346                set _visibility($layer) 1
1347            }
1348        }
1349    }
1350
1351    if ($haveTerrain) {
1352        $itk_component(vscale_l) configure -state normal
1353        $itk_component(vscale) configure -state normal
1354    } else {
1355        $itk_component(vscale_l) configure -state disabled
1356        $itk_component(vscale) configure -state disabled
1357    }
1358
1359    if {$_reset} {
1360        if {$_initCamera} {
1361            # If this is the first Rebuild, we need to
1362            # set up the initial view settings if there
1363            # are any
1364            camera reset
1365            set _initCamera 0
1366        } else {
1367            # Restore view from before reconnect
1368            camera set all
1369        }
1370    }
1371
1372    UpdateLayerControls
1373    UpdateViewpointControls
1374    set _reset 0
1375    global readyForNextFrame
1376    set readyForNextFrame 0;            # Don't advance to the next frame
1377                                        # until we get an image.
1378
1379    # Actually write the commands to the server socket.  If it fails, we
1380    # don't care.  We're finished here.
1381    blt::busy hold $itk_component(hull)
1382    StopBufferingCommands
1383    blt::busy release $itk_component(hull)
1384}
1385
1386itcl::body Rappture::MapViewer::EnablePanningMouseBindings {} {
1387    if {$_useServerManip} {
1388        bind $itk_component(view) <ButtonPress-1> \
1389            [itcl::code $this MouseClick 1 %x %y]
1390        bind $itk_component(view) <B1-Motion> \
1391            [itcl::code $this MouseDrag 1 %x %y]
1392        bind $itk_component(view) <ButtonRelease-1> \
1393            [itcl::code $this MouseRelease 1 %x %y]
1394    } else {
1395        bind $itk_component(view) <ButtonPress-1> \
1396            [itcl::code $this Pan click %x %y]
1397        bind $itk_component(view) <B1-Motion> \
1398            [itcl::code $this Pan drag %x %y]
1399        bind $itk_component(view) <ButtonRelease-1> \
1400            [itcl::code $this Pan release %x %y]
1401    }
1402}
1403
1404itcl::body Rappture::MapViewer::DisablePanningMouseBindings {} {
1405    bind $itk_component(view) <ButtonPress-1> {}
1406    bind $itk_component(view) <B1-Motion> {}
1407    bind $itk_component(view) <ButtonRelease-1> {}
1408}
1409
1410itcl::body Rappture::MapViewer::EnableRotationMouseBindings {} {
1411    if {$_useServerManip} {
1412        bind $itk_component(view) <ButtonPress-2> \
1413            [itcl::code $this Rotate click %x %y]
1414        bind $itk_component(view) <B2-Motion> \
1415            [itcl::code $this Rotate drag %x %y]
1416        bind $itk_component(view) <ButtonRelease-2> \
1417            [itcl::code $this Rotate release %x %y]
1418    } else {
1419        # Bindings for rotation via mouse
1420        bind $itk_component(view) <ButtonPress-2> \
1421            [itcl::code $this MouseClick 2 %x %y]
1422        bind $itk_component(view) <B2-Motion> \
1423            [itcl::code $this MouseDrag 2 %x %y]
1424        bind $itk_component(view) <ButtonRelease-2> \
1425            [itcl::code $this MouseRelease 2 %x %y]
1426    }
1427}
1428
1429itcl::body Rappture::MapViewer::DisableRotationMouseBindings {} {
1430    bind $itk_component(view) <ButtonPress-2> {}
1431    bind $itk_component(view) <B2-Motion> {}
1432    bind $itk_component(view) <ButtonRelease-2> {}
1433}
1434
1435itcl::body Rappture::MapViewer::EnableZoomMouseBindings {} {
1436    if {$_useServerManip} {
1437        bind $itk_component(view) <ButtonPress-3> \
1438            [itcl::code $this MouseClick 3 %x %y]
1439        bind $itk_component(view) <B3-Motion> \
1440            [itcl::code $this MouseDrag 3 %x %y]
1441        bind $itk_component(view) <ButtonRelease-3> \
1442            [itcl::code $this MouseRelease 3 %x %y]
1443    } else {
1444        bind $itk_component(view) <ButtonPress-3> \
1445            [itcl::code $this Zoom click %x %y]
1446        bind $itk_component(view) <B3-Motion> \
1447            [itcl::code $this Zoom drag %x %y]
1448        bind $itk_component(view) <ButtonRelease-3> \
1449            [itcl::code $this Zoom release %x %y]
1450    }
1451}
1452
1453itcl::body Rappture::MapViewer::DisableZoomMouseBindings {} {
1454    bind $itk_component(view) <ButtonPress-3> {}
1455    bind $itk_component(view) <B3-Motion> {}
1456    bind $itk_component(view) <ButtonRelease-3> {}
1457}
1458# ----------------------------------------------------------------------
1459# USAGE: CurrentLayers ?-all -visible? ?dataobjs?
1460#
1461# Returns a list of server IDs for the current datasets being displayed.
1462# This is normally a single ID, but it might be a list of IDs if the
1463# current data object has multiple components.
1464# ----------------------------------------------------------------------
1465itcl::body Rappture::MapViewer::CurrentLayers {args} {
1466    set flag [lindex $args 0]
1467    switch -- $flag {
1468        "-all" {
1469            if { [llength $args] > 1 } {
1470                error "CurrentLayers: can't specify dataobj after \"-all\""
1471            }
1472            set dlist [get -objects]
1473        }
1474        "-visible" {
1475            if { [llength $args] > 1 } {
1476                set dlist {}
1477                set args [lrange $args 1 end]
1478                foreach dataobj $args {
1479                    if { [info exists _obj2ovride($dataobj-raise)] } {
1480                        lappend dlist $dataobj
1481                    }
1482                }
1483            } else {
1484                set dlist [get -visible]
1485            }
1486        }
1487        default {
1488            set dlist $args
1489        }
1490    }
1491    set rlist ""
1492    foreach dataobj $dlist {
1493        foreach layer [$dataobj layer names] {
1494            if { [info exists _layers($layer)] && $_layers($layer) } {
1495                lappend rlist $layer
1496            }
1497        }
1498    }
1499    return $rlist
1500}
1501
1502itcl::body Rappture::MapViewer::KeyPress {k} {
1503    SendCmd "key press $k"
1504}
1505
1506itcl::body Rappture::MapViewer::KeyRelease {k} {
1507    SendCmd "key release $k"
1508}
1509
1510itcl::body Rappture::MapViewer::GetNormalizedMouse {x y} {
1511    set w [winfo width $itk_component(view)]
1512    set h [winfo height $itk_component(view)]
1513    set x [expr {(2.0 * double($x)/$w) - 1.0}]
1514    set y [expr {(2.0 * double($y)/$h) - 1.0}]
1515    return [list $x $y]
1516}
1517
1518itcl::body Rappture::MapViewer::MouseClick {button x y} {
1519    SendCmd "mouse click $button $x $y"
1520}
1521
1522itcl::body Rappture::MapViewer::MouseDoubleClick {button x y} {
1523    SendCmd "mouse dblclick $button $x $y"
1524}
1525
1526itcl::body Rappture::MapViewer::MouseDrag {button x y} {
1527    SendCmd "mouse drag $button $x $y"
1528}
1529
1530itcl::body Rappture::MapViewer::MouseRelease {button x y} {
1531    SendCmd "mouse release $button $x $y"
1532}
1533
1534itcl::body Rappture::MapViewer::MouseMotion {} {
1535    SendCmd "mouse motion $_motion(x) $_motion(y)"
1536    #SendCmd "map pin hover $_motion(x) $_motion(y)"
1537    set _motion(pending) 0
1538}
1539
1540itcl::body Rappture::MapViewer::MouseScroll {direction} {
1541    switch -- $direction {
1542        "up" {
1543            SendCmd "mouse scroll 1"
1544        }
1545        "down" {
1546            SendCmd "mouse scroll -1"
1547        }
1548    }
1549}
1550
1551#
1552# EventuallyHandleMotionEvent --
1553#
1554#   This routine compresses (no button press) motion events.  It
1555#   delivers a server mouse command once every 100 milliseconds (if a
1556#   motion event is pending).
1557#
1558itcl::body Rappture::MapViewer::EventuallyHandleMotionEvent {x y} {
1559    set _motion(x) $x
1560    set _motion(y) $y
1561    if { !$_motion(compress) } {
1562        MouseMotion
1563        return
1564    }
1565    if { !$_motion(pending) } {
1566        set _motion(pending) 1
1567        $_dispatcher event -after $_motion(delay) !motion
1568    }
1569}
1570
1571# ----------------------------------------------------------------------
1572# USAGE: Zoom in
1573# USAGE: Zoom out
1574# USAGE: Zoom reset
1575#        $this Zoom click x y
1576#        $this Zoom drag x y
1577#        $this Zoom release x y
1578#
1579# Called automatically when the user clicks on one of the zoom
1580# controls for this widget.  Changes the zoom for the current view.
1581# Also implements mouse zoom.
1582# ----------------------------------------------------------------------
1583itcl::body Rappture::MapViewer::Zoom {option {x 0} {y 0}} {
1584    switch -- $option {
1585        "in" {
1586            # z here is normalized mouse Y delta
1587            set z -0.25
1588            SendCmd "camera zoom $z"
1589        }
1590        "out" {
1591            # z here is normalized mouse Y delta
1592            set z 0.25
1593            SendCmd "camera zoom $z"
1594        }
1595        "reset" {
1596            SendCmd "camera dist $_view(distance)"
1597        }
1598        "click" {
1599            set _click(x) $x
1600            set _click(y) $y
1601            $itk_component(view) configure -cursor hand1
1602        }
1603        "drag" {
1604            if { ![info exists _click(x)] } {
1605                set _click(x) $x
1606            }
1607            if { ![info exists _click(y)] } {
1608                set _click(y) $y
1609            }
1610            set h [winfo height $itk_component(view)]
1611            set dy [expr ($_click(y) - $y)/double($h)]
1612            set _click(x) $x
1613            set _click(y) $y
1614            if {[expr (abs($dy) > 0.0)]} {
1615                SendCmd "camera zoom $dy"
1616            }
1617        }
1618        "release" {
1619            Zoom drag $x $y
1620            $itk_component(view) configure -cursor ""
1621        }
1622    }
1623}
1624
1625# ----------------------------------------------------------------------
1626# USAGE: Rotate click <x> <y>
1627# USAGE: Rotate drag <x> <y>
1628# USAGE: Rotate release <x> <y>
1629#
1630# Called automatically when the user clicks/drags/releases in the
1631# plot area.  Moves the plot according to the user's actions.
1632# ----------------------------------------------------------------------
1633itcl::body Rappture::MapViewer::Rotate {option x y} {
1634    switch -- $option {
1635        "click" {
1636            $itk_component(view) configure -cursor fleur
1637            set _click(x) $x
1638            set _click(y) $y
1639            set _rotate(azimuth) 0
1640            set _rotate(elevation) 0
1641        }
1642        "drag" {
1643            if {[array size _click] == 0} {
1644                Rotate click $x $y
1645            } else {
1646                set w [winfo width $itk_component(view)]
1647                set h [winfo height $itk_component(view)]
1648                if {$w <= 0 || $h <= 0} {
1649                    return
1650                }
1651                set dx [expr ($x - $_click(x))/double($w)]
1652                set dy [expr ($_click(y) - $y)/double($h)]
1653                set _click(x) $x
1654                set _click(y) $y
1655                if {[expr (abs($dx) > 0.0 || abs($dy) > 0.0)]} {
1656                    #SendCmd "camera rotate $dx $dy"
1657                    EventuallyRotate $dx $dy
1658                }
1659            }
1660        }
1661        "release" {
1662            Rotate drag $x $y
1663            $itk_component(view) configure -cursor ""
1664            catch {unset _click}
1665        }
1666        "set" {
1667            set w [winfo width $itk_component(view)]
1668            set h [winfo height $itk_component(view)]
1669            set dx [expr $x / double($w)]
1670            set dy [expr $y / double($h)]
1671            if {[expr (abs($dx) > 0.0 || abs($dy) > 0.0)]} {
1672                EventuallyRotate $dx $dy
1673            }
1674        }
1675        default {
1676            error "bad option \"$option\": should be click, drag, release"
1677        }
1678    }
1679}
1680
1681itcl::body Rappture::MapViewer::Select {option x y} {
1682    switch -- $option {
1683        "click" {
1684            set _click(x) $x
1685            set _click(y) $y
1686            set _b1mode "select"
1687            SendCmd "map box init $x $y"
1688        }
1689        "drag" {
1690            if {$_b1mode == "select"} {
1691                EventuallySelect $x $y
1692            }
1693        }
1694        "release" {
1695            set _b1mode ""
1696            if {$_click(x) == $x &&
1697                $_click(y) == $y} {
1698                SendCmd "map box clear"
1699            }
1700        }
1701    }
1702}
1703
1704itcl::body Rappture::MapViewer::Pin {option x y} {
1705    set _click(x) $x
1706    set _click(y) $y
1707    switch -- $option {
1708        "add" {
1709            incr _labelCount
1710            set label "Label $_labelCount"
1711            SendCmd [list "map" "pin" "add" $x $y [encoding convertto utf-8 $label]]
1712        }
1713        "delete" {
1714            SendCmd "map pin delete $x $y"
1715        }
1716    }
1717}
1718
1719# ----------------------------------------------------------------------
1720# USAGE: $this Pan set x y
1721#        $this Pan click x y
1722#        $this Pan drag x y
1723#        $this Pan release x y
1724#
1725# Called automatically when the user clicks on one of the zoom
1726# controls for this widget.  Changes the zoom for the current view.
1727# ----------------------------------------------------------------------
1728itcl::body Rappture::MapViewer::Pan {option x y} {
1729    switch -- $option {
1730        "set" {
1731            set w [winfo width $itk_component(view)]
1732            set h [winfo height $itk_component(view)]
1733            set x [expr $x / double($w)]
1734            set y [expr $y / double($h)]
1735            if {[expr (abs($x) > 0.0 || abs($y) > 0.0)]} {
1736                SendCmd "camera pan $x $y"
1737            }
1738            return
1739        }
1740        "click" {
1741            set _click(x) $x
1742            set _click(y) $y
1743            set _pan(x) 0
1744            set _pan(y) 0
1745            $itk_component(view) configure -cursor hand1
1746            set _b1mode "pan"
1747        }
1748        "drag" {
1749            if {$_b1mode != "pan"} {
1750                return
1751            }
1752            if { ![info exists _click(x)] } {
1753                set _click(x) $x
1754            }
1755            if { ![info exists _click(y)] } {
1756                set _click(y) $y
1757            }
1758            set w [winfo width $itk_component(view)]
1759            set h [winfo height $itk_component(view)]
1760            set dx [expr ($x - $_click(x))/double($w)]
1761            set dy [expr ($_click(y) - $y)/double($h)]
1762            set _click(x) $x
1763            set _click(y) $y
1764            if {[expr (abs($dx) > 0.0 || abs($dy) > 0.0)]} {
1765                EventuallyPan $dx $dy
1766                #SendCmd "camera pan $dx $dy"
1767            }
1768        }
1769        "release" {
1770            Pan drag $x $y
1771            $itk_component(view) configure -cursor ""
1772            set _b1mode ""
1773        }
1774        default {
1775            error "unknown option \"$option\": should set, click, drag, or release"
1776        }
1777    }
1778}
1779
1780itcl::body Rappture::MapViewer::SetHeading { {value 0} } {
1781    set _view(heading) $value
1782    camera set heading
1783}
1784
1785itcl::body Rappture::MapViewer::SetPitch { {value -89.999} } {
1786    set _view(pitch) $value
1787    camera set pitch
1788}
1789
1790# ----------------------------------------------------------------------
1791# USAGE: InitSettings <what> ?<value>?
1792#
1793# Used internally to update rendering settings whenever parameters
1794# change in the popup settings panel.  Sends the new settings off
1795# to the back end.
1796# ----------------------------------------------------------------------
1797itcl::body Rappture::MapViewer::InitSettings { args } {
1798    foreach setting $args {
1799        AdjustSetting $setting
1800    }
1801}
1802
1803#
1804# AdjustSetting --
1805#
1806#   Changes/updates a specific setting in the widget.  There are
1807#   usually user-setable option.  Commands are sent to the render
1808#   server.
1809#
1810itcl::body Rappture::MapViewer::AdjustSetting {what {value ""}} {
1811    if { ![isconnected] } {
1812        return
1813    }
1814    switch -- $what {
1815        "coords-visible" - "coords-precision" - "coords-units" {
1816            set bool $_settings(coords-visible)
1817            set units $_settings(coords-units)
1818            set precision $_settings(coords-precision)
1819            SendCmd "map posdisp $bool $units $precision"
1820        }
1821        "grid" - "grid-type" {
1822            set bool $_settings(grid)
1823            set gridType $_settings(grid-type)
1824            SendCmd "map grid $bool $gridType"
1825        }
1826        "camera-throw" {
1827            set bool $_settings($what)
1828            SendCmd "camera throw $bool"
1829        }
1830        "terrain-ambient" {
1831            set val $_settings($what)
1832            SendCmd "map terrain ambient $val"
1833        }
1834        "terrain-edges" {
1835            set bool $_settings($what)
1836            SendCmd "map terrain edges $bool"
1837        }
1838        "terrain-lighting" {
1839            set bool $_settings($what)
1840            SendCmd "map terrain lighting $bool"
1841        }
1842        "terrain-palette" {
1843            set cmap [$itk_component(terrainpalette) value]
1844            #SendCmd "map terrain colormap $cmap"
1845        }
1846        "terrain-vertscale" {
1847            set val $_settings($what)
1848            SendCmd "map terrain vertscale $val"
1849        }
1850        "terrain-wireframe" {
1851            set bool $_settings($what)
1852            SendCmd "map terrain wireframe $bool"
1853        }
1854        "time" {
1855            set val $_settings($what)
1856            SendCmd "map time $val"
1857        }
1858        default {
1859            error "don't know how to fix $what"
1860        }
1861    }
1862}
1863
1864# ----------------------------------------------------------------------
1865# CONFIGURATION OPTION: -plotbackground
1866# ----------------------------------------------------------------------
1867itcl::configbody Rappture::MapViewer::plotbackground {
1868    if { [isconnected] } {
1869        set rgb [Color2RGB $itk_option(-plotbackground)]
1870        SendCmd "screen bgcolor $rgb"
1871    }
1872}
1873
1874# ----------------------------------------------------------------------
1875# CONFIGURATION OPTION: -plotforeground
1876# ----------------------------------------------------------------------
1877itcl::configbody Rappture::MapViewer::plotforeground {
1878    if { [isconnected] } {
1879        set rgb [Color2RGB $itk_option(-plotforeground)]
1880        # FIXME: Set font foreground colors
1881    }
1882}
1883
1884itcl::body Rappture::MapViewer::BuildMapTab {} {
1885    set fg [option get $itk_component(hull) font Font]
1886    #set bfg [option get $itk_component(hull) boldFont Font]
1887
1888    set inner [$itk_component(main) insert end \
1889        -title "Map Settings" \
1890        -icon [Rappture::icon wrench]]
1891    $inner configure -borderwidth 4
1892
1893    checkbutton $inner.posdisp \
1894        -text "Show Coordinate Readout" \
1895        -variable [itcl::scope _settings(coords-visible)] \
1896        -command [itcl::code $this AdjustSetting coords-visible] \
1897        -font "Arial 9" -anchor w
1898
1899    itk_component add grid {
1900        checkbutton $inner.grid \
1901        -text "Show Graticule" \
1902        -variable [itcl::scope _settings(grid)] \
1903        -command [itcl::code $this AdjustSetting grid] \
1904        -font "Arial 9" -anchor w
1905    } {
1906        ignore -font
1907    }
1908    Rappture::Tooltip::for $inner.grid "Toggle graticule (grid) display <g>"
1909
1910    checkbutton $inner.wireframe \
1911        -text "Show Wireframe" \
1912        -variable [itcl::scope _settings(terrain-wireframe)] \
1913        -command [itcl::code $this AdjustSetting terrain-wireframe] \
1914        -font "Arial 9" -anchor w
1915    Rappture::Tooltip::for $inner.wireframe "Toggle wireframe rendering of terrain geometry <w>"
1916
1917    checkbutton $inner.lighting \
1918        -text "Enable Lighting" \
1919        -variable [itcl::scope _settings(terrain-lighting)] \
1920        -command [itcl::code $this AdjustSetting terrain-lighting] \
1921        -font "Arial 9" -anchor w
1922    Rappture::Tooltip::for $inner.lighting "Toggle sky lighting of terrain <l>"
1923
1924    checkbutton $inner.edges \
1925        -text "Show Edges" \
1926        -variable [itcl::scope _settings(terrain-edges)] \
1927        -command [itcl::code $this AdjustSetting terrain-edges] \
1928        -font "Arial 9" -anchor w
1929
1930    itk_component add time_l {
1931        label $inner.time_l -text "Time (UTC)" -font "Arial 9"
1932    } {
1933        ignore -font
1934    }
1935    itk_component add time {
1936        ::scale $inner.time -from 0 -to 23.9 -orient horizontal \
1937            -resolution 0.1 \
1938            -variable [itcl::scope _settings(time)] \
1939            -width 10 \
1940            -showvalue on \
1941            -command [itcl::code $this AdjustSetting time]
1942    }
1943
1944    itk_component add ambient_l {
1945        label $inner.ambient_l -text "Ambient min." -font "Arial 9"
1946    } {
1947        ignore -font
1948    }
1949    itk_component add ambient {
1950        ::scale $inner.ambient -from 0 -to 1.0 -orient horizontal \
1951            -resolution 0.01 \
1952            -variable [itcl::scope _settings(terrain-ambient)] \
1953            -width 10 \
1954            -showvalue on \
1955            -command [itcl::code $this AdjustSetting terrain-ambient]
1956    }
1957
1958    blt::table $inner \
1959        0,0 $inner.posdisp   -cspan 2 -anchor w -pady 2 \
1960        1,0 $inner.grid      -cspan 2 -anchor w -pady 2 \
1961        2,0 $inner.wireframe -cspan 2 -anchor w -pady 2 \
1962        3,0 $inner.lighting  -cspan 2 -anchor w -pady 2 \
1963        4,0 $inner.time_l    -cspan 2 -anchor w -pady 2 \
1964        4,1 $inner.time      -cspan 2 -fill x   -pady 2 \
1965        5,0 $inner.ambient_l -cspan 2 -anchor w -pady 2 \
1966        5,1 $inner.ambient   -cspan 2 -fill x   -pady 2
1967#        4,0 $inner.edges     -cspan 2  -anchor w -pady 2
1968
1969    blt::table configure $inner r* c* -resize none
1970    blt::table configure $inner r6 c1 -resize expand
1971}
1972
1973itcl::body Rappture::MapViewer::BuildTerrainTab {} {
1974    set fg [option get $itk_component(hull) font Font]
1975    #set bfg [option get $itk_component(hull) boldFont Font]
1976
1977    set inner [$itk_component(main) insert end \
1978        -title "Terrain Settings" \
1979        -icon [Rappture::icon terrain]]
1980    $inner configure -borderwidth 4
1981
1982    label $inner.palette_l -text "Palette" -font "Arial 9" -anchor w
1983    itk_component add terrainpalette {
1984        Rappture::Combobox $inner.palette -width 10 -editable no
1985    }
1986    $inner.palette choices insert end [GetColormapList]
1987
1988    $itk_component(terrainpalette) value "BCGYR"
1989    bind $inner.palette <<Value>> \
1990        [itcl::code $this AdjustSetting terrain-palette]
1991
1992    itk_component add vscale_l {
1993        label $inner.vscale_l -text "Vertical Scale" -font "Arial 9" -anchor w
1994    }
1995    itk_component add vscale {
1996        ::scale $inner.vscale -from 0 -to 10 -orient horizontal \
1997            -variable [itcl::scope _settings(terrain-vertscale)] \
1998            -width 10 \
1999            -resolution 0.1 \
2000            -showvalue on \
2001            -command [itcl::code $this AdjustSetting terrain-vertscale]
2002    }
2003    $inner.vscale set $_settings(terrain-vertscale)
2004
2005    blt::table $inner \
2006        0,0 $inner.vscale_l  -anchor w -pady 2 \
2007        0,1 $inner.vscale    -fill x   -pady 2
2008#        1,0 $inner.palette_l -anchor w -pady 2 \
2009#        1,1 $inner.palette   -fill x   -pady 2
2010
2011    blt::table configure $inner r* c* -resize none
2012    blt::table configure $inner r3 c1 -resize expand
2013}
2014
2015itcl::body Rappture::MapViewer::BuildLayerTab {} {
2016    set fg [option get $itk_component(hull) font Font]
2017    #set bfg [option get $itk_component(hull) boldFont Font]
2018
2019    set inner [$itk_component(main) insert end \
2020        -title "Layers" \
2021        -icon [Rappture::icon layers]]
2022    $inner configure -borderwidth 4
2023    set f [frame $inner.layers]
2024    blt::table $inner \
2025        0,0 $f -fill both
2026    set _layersFrame $inner
2027}
2028
2029itcl::body Rappture::MapViewer::BuildViewpointsTab {} {
2030    set fg [option get $itk_component(hull) font Font]
2031    #set bfg [option get $itk_component(hull) boldFont Font]
2032
2033    set inner [$itk_component(main) insert end \
2034        -title "Places" \
2035        -icon [Rappture::icon placemark16]]
2036    $inner configure -borderwidth 4
2037    set f [frame $inner.viewpoints]
2038    blt::table $inner \
2039        0,0 $f -fill both
2040    set _viewpointsFrame $inner
2041}
2042
2043itcl::body Rappture::MapViewer::BuildCameraTab {} {
2044    set inner [$itk_component(main) insert end \
2045        -title "Camera Settings" \
2046        -icon [Rappture::icon camera]]
2047    $inner configure -borderwidth 4
2048
2049    set row 0
2050
2051    set labels { x y z heading pitch distance }
2052    foreach tag $labels {
2053        label $inner.${tag}label -text $tag -font "Arial 9"
2054        entry $inner.${tag} -font "Arial 9"  -bg white \
2055            -textvariable [itcl::scope _view($tag)]
2056        bind $inner.${tag} <KeyPress-Return> \
2057            [itcl::code $this camera set ${tag}]
2058        bind $inner.${tag} <KP_Enter> \
2059            [itcl::code $this camera set ${tag}]
2060        blt::table $inner \
2061            $row,0 $inner.${tag}label -anchor e -pady 2 \
2062            $row,1 $inner.${tag} -anchor w -pady 2
2063        blt::table configure $inner r$row -resize none
2064        incr row
2065    }
2066    set labels { srs verticalDatum }
2067    foreach tag $labels {
2068        label $inner.${tag}label -text $tag -font "Arial 9"
2069        entry $inner.${tag} -font "Arial 9"  -bg white \
2070            -textvariable [itcl::scope _view($tag)]
2071        bind $inner.${tag} <KeyPress-Return> \
2072            [itcl::code $this camera set ${tag}]
2073        bind $inner.${tag} <KP_Enter> \
2074            [itcl::code $this camera set ${tag}]
2075        blt::table $inner \
2076            $row,0 $inner.${tag}label -anchor e -pady 2 \
2077            $row,1 $inner.${tag} -anchor w -pady 2
2078        blt::table configure $inner r$row -resize none
2079        incr row
2080    }
2081
2082    if {0} {
2083    button $inner.get \
2084        -text "Get Camera Settings" \
2085        -font "Arial 9" \
2086        -command [itcl::code $this SendCmd "camera get"]
2087    blt::table $inner \
2088        $row,0 $inner.get -anchor w -pady 2 -cspan 2
2089    blt::table configure $inner r$row -resize none
2090    incr row
2091
2092    button $inner.set \
2093        -text "Apply Camera Settings" \
2094        -font "Arial 9" \
2095        -command [itcl::code $this camera set all]
2096    blt::table $inner \
2097        $row,0 $inner.set -anchor w -pady 2 -cspan 2
2098    blt::table configure $inner r$row -resize none
2099    incr row
2100    }
2101
2102    if {$_useServerManip} {
2103        checkbutton $inner.throw \
2104            -text "Enable Throw" \
2105            -font "Arial 9" \
2106            -variable [itcl::scope _settings(camera-throw)] \
2107            -command [itcl::code $this AdjustSetting camera-throw]
2108        blt::table $inner \
2109            $row,0 $inner.throw -anchor w -pady 2 -cspan 2
2110        blt::table configure $inner r$row -resize none
2111        incr row
2112    }
2113
2114    label $inner.heading_slider_l -text "Heading" -font "Arial 9"
2115    ::scale $inner.heading_slider -font "Arial 9" \
2116        -from -180 -to 180 -orient horizontal \
2117        -variable [itcl::scope _view(heading)] \
2118        -width 10 \
2119        -showvalue on \
2120        -command [itcl::code $this camera set heading]
2121
2122    blt::table $inner \
2123            $row,0 $inner.heading_slider_l -anchor w -pady 2
2124    blt::table $inner \
2125            $row,1 $inner.heading_slider -fill x -anchor w -pady 2
2126    blt::table configure $inner r$row -resize none
2127    incr row
2128
2129    itk_component add pitch_slider_l {
2130        label $inner.pitch_slider_l -text "Pitch" -font "Arial 9"
2131    }
2132    itk_component add pitch_slider {
2133        ::scale $inner.pitch_slider -font "Arial 9" \
2134            -from -10 -to -90 -orient horizontal \
2135            -variable [itcl::scope _view(pitch)] \
2136            -width 10 \
2137            -showvalue on \
2138            -command [itcl::code $this camera set pitch]
2139    }
2140
2141    blt::table $inner \
2142            $row,0 $inner.pitch_slider_l -anchor w -pady 2
2143    blt::table $inner \
2144            $row,1 $inner.pitch_slider -fill x -anchor w -pady 2
2145    blt::table configure $inner r$row -resize none
2146    incr row
2147
2148    blt::table configure $inner c* r* -resize none
2149    blt::table configure $inner c2 -resize expand
2150    blt::table configure $inner r$row -resize expand
2151}
2152
2153itcl::body Rappture::MapViewer::BuildHelpTab {} {
2154    set fg [option get $itk_component(hull) font Font]
2155    #set bfg [option get $itk_component(hull) boldFont Font]
2156
2157    set inner [$itk_component(main) insert end \
2158        -title "Help" \
2159        -icon [Rappture::icon question_mark12]]
2160    $inner configure -borderwidth 4
2161
2162    set helptext {*************************
2163Mouse bindings:
2164*************************
2165  Left - Panning
2166  Middle - Rotation
2167  Right - Zoom
2168
2169Zoom/travel:
2170  Left double-click:
2171    Zoom to point
2172  Left shift-double:
2173    Travel to point
2174  Right double-click:
2175    Zoom out from point
2176
2177Pins:
2178  Ctl-Left: Drop pin
2179  Ctl-Right: Delete pin
2180
2181Select:
2182  Shift-Left click-drag
2183
2184*************************
2185Keyboard bindings:
2186*************************
2187  g - Toggle graticule
2188  l - Toggle lighting
2189  n - Set North up
2190  p - Reset pitch
2191  w - Toggle wireframe
2192  arrows - panning
2193  Shift-arrows - fine pan
2194  Ctl-arrows - rotation
2195  Ctl-Shift-arrows:
2196    fine rotation
2197  PgUp/PgDown - zoom
2198  Home - Reset camera
2199*************************}
2200
2201    text $inner.info -width 25 -bg white
2202    $inner.info insert end $helptext
2203    $inner.info configure -state disabled
2204    blt::table $inner \
2205        0,0 $inner.info -fill both
2206}
2207
2208#
2209#  camera --
2210#
2211# USAGE: camera get
2212#        This is called by the server to transfer the
2213#        current Viewpoint settings
2214# USAGE: camera reset
2215#        Reset the camera to the default view
2216#
2217itcl::body Rappture::MapViewer::camera {option args} {
2218    switch -- $option {
2219        "get" {
2220            # We got the camera settings from the server
2221            foreach name {x y z heading pitch distance srs verticalDatum} value $args {
2222                set _view($name) $value
2223            }
2224#            puts stderr "view: $_view(x), $_view(y), $_view(z), $_view(heading), $_view(pitch), $_view(distance), {$_view(srs)}, {$_view(verticalDatum)}"
2225        }
2226        "go" {
2227            SendCmd "camera go $args"
2228        }
2229        "reset" {
2230            array set _view {
2231                x               0.0
2232                y               0.0
2233                z               0.0
2234                heading         0.0
2235                pitch           -89.9
2236                distance        1.0
2237                srs             ""
2238                verticalDatum   ""
2239            }
2240            if { [info exists _mapsettings(camera)] } {
2241                # Check if the tool specified a default
2242                set view $_mapsettings(camera)
2243                if { $view != "" } {
2244                    array set cam $view
2245                    set duration 0.0
2246                    if {[info exists cam(xmin)] && [info exists cam(ymin)] &&
2247                        [info exists cam(xmax)] && [info exists cam(ymax)]} {
2248                        set srs ""
2249                        if {[info exists cam(srs)]} {
2250                            set srs $cam(srs)
2251                        }
2252                        SendCmd [list camera extent $cam(xmin) $cam(ymin) $cam(xmax) $cam(ymax) $duration $srs]
2253                    } else {
2254                        array set _view $view
2255                        SendCmd [list camera set $_view(x) $_view(y) $_view(z) $_view(heading) $_view(pitch) $_view(distance) $duration $_view(srs) $_view(verticalDatum)]
2256                    }
2257                } else {
2258                    SendCmd "camera reset"
2259                    # Retrieve the settings
2260                    #SendCmd "camera get"
2261                }
2262            } else {
2263                SendCmd "camera reset"
2264                # Retrieve the settings
2265               # SendCmd "camera get"
2266            }
2267        }
2268        "set" {
2269            set who [lindex $args 0]
2270            if {$who != "all" && $who != "srs" && $who != "verticalDatum"} {
2271                set val $_view($who)
2272                set code [catch { string is double $val } result]
2273                if { $code != 0 || !$result } {
2274                    return
2275                }
2276            }
2277            switch -- $who {
2278                "distance" {
2279                    SendCmd [list camera dist $_view(distance)]
2280                }
2281                "all" - "x" - "y" - "z" - "heading" - "pitch" - "srs" - "verticalDatum" {
2282                    set duration 0.0
2283                    SendCmd [list camera set $_view(x) $_view(y) $_view(z) $_view(heading) $_view(pitch) $_view(distance) $duration $_view(srs) $_view(verticalDatum)]
2284                }
2285            }
2286        }
2287    }
2288}
2289
2290itcl::body Rappture::MapViewer::GoToViewpoint { dataobj viewpoint } {
2291    array set view [subst {
2292        x 0
2293        y 0
2294        z 0
2295        heading 0
2296        pitch -90
2297        distance $_view(distance)
2298        srs "$_view(srs)"
2299        verticalDatum "$_view(verticalDatum)"
2300    }]
2301    array set view [$dataobj viewpoint $viewpoint]
2302    foreach key {x y z heading pitch distance srs verticalDatum} {
2303        if { [info exists view($key)] } {
2304            set _view($key) $view($key)
2305        }
2306    }
2307    # If map is projected, ignore pitch
2308    if {![MapIsGeocentric]} {
2309        set _view(pitch) -90
2310    }
2311    set duration 2.0
2312    SendCmd [list camera set $_view(x) $_view(y) $_view(z) $_view(heading) $_view(pitch) $_view(distance) $duration $_view(srs) $_view(verticalDatum)]
2313}
2314
2315itcl::body Rappture::MapViewer::GetImage { args } {
2316    if { [image width $_image(download)] > 0 &&
2317         [image height $_image(download)] > 0 } {
2318        set bytes [$_image(download) data -format "jpeg -quality 100"]
2319        set bytes [Rappture::encoding::decode -as b64 $bytes]
2320        return [list .jpg $bytes]
2321    }
2322    return ""
2323}
2324
2325itcl::body Rappture::MapViewer::BuildDownloadPopup { popup command } {
2326    Rappture::Balloon $popup \
2327        -title "[Rappture::filexfer::label downloadWord] as..."
2328    set inner [$popup component inner]
2329    label $inner.summary -text "" -anchor w
2330
2331    radiobutton $inner.image_button -text "Image File" \
2332        -variable [itcl::scope _downloadPopup(format)] \
2333        -value image
2334    Rappture::Tooltip::for $inner.image_button \
2335        "Save as digital image."
2336
2337    button $inner.ok -text "Save" \
2338        -highlightthickness 0 -pady 2 -padx 3 \
2339        -command $command \
2340        -compound left \
2341        -image [Rappture::icon download]
2342
2343    button $inner.cancel -text "Cancel" \
2344        -highlightthickness 0 -pady 2 -padx 3 \
2345        -command [list $popup deactivate] \
2346        -compound left \
2347        -image [Rappture::icon cancel]
2348
2349    blt::table $inner \
2350        0,0 $inner.summary -cspan 2  \
2351        2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \
2352        4,1 $inner.cancel -width .9i -fill y \
2353        4,0 $inner.ok -padx 2 -width .9i -fill y
2354    blt::table configure $inner r3 -height 4
2355    blt::table configure $inner r4 -pady 4
2356    raise $inner.image_button
2357    $inner.image_button invoke
2358    return $inner
2359}
2360
2361itcl::body Rappture::MapViewer::ToggleGrid {} {
2362    set _settings(grid) [expr !$_settings(grid)]
2363    AdjustSetting grid
2364}
2365
2366itcl::body Rappture::MapViewer::ToggleLighting {} {
2367    set _settings(terrain-lighting) [expr !$_settings(terrain-lighting)]
2368    AdjustSetting terrain-lighting
2369}
2370
2371itcl::body Rappture::MapViewer::ToggleWireframe {} {
2372    set _settings(terrain-wireframe) [expr !$_settings(terrain-wireframe)]
2373    AdjustSetting terrain-wireframe
2374}
2375
2376itcl::body Rappture::MapViewer::SetTerrainStyle { style } {
2377    array set settings {
2378        -ambient 0.03
2379        -color white
2380        -edgecolor black
2381        -edges 0
2382        -lighting 1
2383        -linewidth 1.0
2384        -vertscale 1.0
2385        -wireframe 0
2386    }
2387    array set settings $style
2388
2389    SendCmd "map terrain ambient $settings(-ambient)"
2390    set _settings(terrain-ambient) $settings(-ambient)
2391    SendCmd "map terrain edges $settings(-edges)"
2392    set _settings(terrain-edges) $settings(-edges)
2393    SendCmd "map terrain color [Color2RGB $settings(-color)]"
2394    #SendCmd "map terrain colormode constant"
2395    SendCmd "map terrain lighting $settings(-lighting)"
2396    set _settings(terrain-lighting) $settings(-lighting)
2397    SendCmd "map terrain linecolor [Color2RGB $settings(-edgecolor)]"
2398    #SendCmd "map terrain linewidth $settings(-linewidth)"
2399    SendCmd "map terrain vertscale $settings(-vertscale)"
2400    set _settings(terrain-vertscale) $settings(-vertscale)
2401    SendCmd "map terrain wireframe $settings(-wireframe)"
2402    set _settings(terrain-wireframe) $settings(-wireframe)
2403}
2404
2405itcl::body Rappture::MapViewer::SendFiles { path } {
2406    if {[string range $path 0 7] != "local://"} {
2407        return
2408    }
2409    DebugTrace "Local path: $path"
2410    set path [string range $path 8 end]
2411    set basename [file rootname $path]
2412    set files [glob -path $basename .*]
2413    foreach file $files {
2414        set name $file
2415        set type [file type $file]
2416        set size [file size $file]
2417        set f [open $file "r"]
2418        fconfigure $f -translation binary -encoding binary
2419        set data [read $f]
2420        close $f
2421        SendCmd [list file put $name $type $size]
2422        SendData $data
2423    }
2424}
2425
2426itcl::body Rappture::MapViewer::SetLayerStyle { dataobj layer } {
2427    array set info [$dataobj layer settings $layer]
2428    if { [info exists info(visible)] &&
2429         !$info(visible) } {
2430        set _visibility($layer) 0
2431    } else {
2432        set _visibility($layer) 1
2433    }
2434
2435    switch -- $info(type) {
2436        "image" {
2437            array set style {
2438                -minlevel 0
2439                -maxlevel 23
2440                -opacity 1.0
2441            }
2442            if { [info exists info(style)] } {
2443                DebugTrace "layer style: $info(style)"
2444                array set style $info(style)
2445            }
2446            if { [info exists info(opacity)] } {
2447                set style(-opacity) $info(opacity)
2448                set _opacity($layer) $info(opacity)
2449            }
2450            set _opacity($layer) [expr $style(-opacity) * 100]
2451            set coverage 0
2452            if { [info exists info(coverage)] } {
2453                set coverage $info(coverage)
2454            }
2455            if {!$_sendEarthFile} {
2456                switch -- $info(driver)  {
2457                    "arcgis" {
2458                        SendCmd [list map layer add $layer image arcgis \
2459                                     $info(arcgis.url) $info(cache) $coverage $info(arcgis.token)]
2460                    }
2461                    "colorramp" {
2462                        set cmapName $layer
2463                        SendFiles $info(colorramp.url)
2464                        SendCmd [list colormap define $cmapName $info(colorramp.colormap)]
2465                        SendCmd [list map layer add $layer image colorramp \
2466                                     $info(colorramp.url) $info(cache) $coverage $info(colorramp.elevdriver) $info(profile)  \
2467                                     $cmapName]
2468                    }
2469                    "debug" {
2470                        SendCmd [list map layer add $layer image debug]
2471                    }
2472                    "gdal" {
2473                        SendFiles $info(gdal.url)
2474                        SendCmd [list map layer add $layer image gdal \
2475                                     $info(gdal.url) $info(cache) $coverage]
2476                    }
2477                    "tms" {
2478                        SendCmd [list map layer add $layer image tms \
2479                                     $info(tms.url) $info(cache) $coverage]
2480                    }
2481                    "wms" {
2482                        SendCmd [list map layer add $layer image wms \
2483                                     $info(wms.url) $info(cache) $coverage \
2484                                     $info(wms.layers) \
2485                                     $info(wms.format) \
2486                                     $info(wms.transparent)]
2487                    }
2488                    "xyz" {
2489                        SendCmd [list map layer add $layer image xyz \
2490                                     $info(xyz.url) $info(cache) $coverage]
2491                    }
2492                }
2493            }
2494            SendCmd "map layer opacity $style(-opacity) $layer"
2495        }
2496        "elevation" {
2497            array set style {
2498                -minlevel 0
2499                -maxlevel 23
2500            }
2501            if { [info exists info(style)] } {
2502                array set style $info(style)
2503            }
2504            if {!$_sendEarthFile} {
2505                switch -- $info(driver)  {
2506                    "gdal" {
2507                        SendFiles $info(gdal.url)
2508                        SendCmd [list map layer add $layer elevation gdal \
2509                                     $info(gdal.url) $info(cache)]
2510                    }
2511                    "tms" {
2512                        SendCmd [list map layer add $layer elevation tms \
2513                                     $info(tms.url) $info(cache)]
2514                    }
2515                    "wcs" {
2516                        SendCmd [list map layer add $layer elevation wcs \
2517                                     $info(wcs.url) $info(cache) $info(wcs.identifier)]
2518                    }
2519                }
2520            }
2521        }
2522        "feature" {
2523            array set style {
2524                -opacity 1.0
2525            }
2526            if { [info exists info(style)] } {
2527                DebugTrace "layer style: $info(style)"
2528                array set style $info(style)
2529            }
2530            if { [info exists info(opacity)] } {
2531                set style(-opacity) $info(opacity)
2532            }
2533            set _opacity($layer) [expr $style(-opacity) * 100]
2534            DebugTrace "stylesheet: $info(stylesheet)"
2535            set script ""
2536            if { [info exists info(script)] } {
2537                set script $info(script)
2538                DebugTrace "script: $script"
2539            }
2540            set selectors [list]
2541            foreach selector [$dataobj selectors $layer] {
2542               array set sinfo [$dataobj selector $layer $selector]
2543                DebugTrace "$selector: [array get sinfo]"
2544                lappend selectors [array get sinfo]
2545                if {[info exists sinfo(styleExpression)]} {
2546                    DebugTrace "$selector: $sinfo(styleExpression)"
2547                } elseif {[info exists sinfo(query)]} {
2548                    if {[info exists sinfo(queryBounds)]} {
2549                        foreach {x1 y1 x2 y2} $sinfo(queryBounds) break
2550                        DebugTrace "queryBounds: xmin $x1 ymin $y1 xmax $x2 ymax $y2"
2551                    }
2552                }
2553            }
2554            set format ""
2555            set tmsType ""
2556            set cmd [list map layer add $layer feature $info(driver) $format $tmsType $info(ogr.url) $info(cache) $info(stylesheet) $script $selectors]
2557            if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2558                lappend cmd $style(-minrange) $style(-maxrange)
2559            }
2560            SendFiles $info(ogr.url)
2561            SendCmd $cmd
2562        }
2563        "line" {
2564            array set style {
2565                -cap "flat"
2566                -clamping terrain
2567                -clamptechnique gpu
2568                -color black
2569                -join "mitre"
2570                -minbias 1000
2571                -opacity 1.0
2572                -stipplepattern 0
2573                -stipplefactor 1
2574                -width 1
2575            }
2576            if { [info exists info(style)] } {
2577                array set style $info(style)
2578            }
2579            if { [info exists info(opacity)] } {
2580                set style(-opacity) $info(opacity)
2581            }
2582            set _opacity($layer) [expr $style(-opacity) * 100]
2583            foreach {r g b} [Color2RGB $style(-color)] {}
2584            switch -- $info(driver)  {
2585                "ogr" {
2586                    SendFiles $info(ogr.url)
2587                    if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2588                        SendCmd [list map layer add $layer line ogr {} {} $info(ogr.url) $info(cache) $r $g $b $style(-width) $style(-cap) $style(-join) $style(-stipplepattern) $style(-stipplefactor) $style(-clamping) $style(-clamptechnique) $style(-minrange) $style(-maxrange)]
2589                    } else {
2590                        SendCmd [list map layer add $layer line ogr {} {} $info(ogr.url) $info(cache) $r $g $b $style(-width) $style(-cap) $style(-join) $style(-stipplepattern) $style(-stipplefactor) $style(-clamping) $style(-clamptechnique)]
2591                    }
2592                }
2593                "tfs" {
2594                    set format "json"
2595                    if {[info exists info(tfs.format)]} {
2596                        set format $info(tfs.format)
2597                    }
2598                    if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2599                        SendCmd [list map layer add $layer line tfs $format {} $info(tfs.url) $info(cache) $r $g $b $style(-width) $style(-cap) $style(-join) $style(-stipplepattern) $style(-stipplefactor) $style(-clamping) $style(-clamptechnique) $style(-minrange) $style(-maxrange)]
2600                    } else {
2601                        SendCmd [list map layer add $layer line tfs $format {} $info(tfs.url) $info(cache) $r $g $b $style(-width) $style(-cap) $style(-join) $style(-stipplepattern) $style(-stipplefactor) $style(-clamping) $style(-clamptechnique)]
2602                    }
2603                }
2604                "wfs" {
2605                    set format "json"
2606                    if {[info exists info(wfs.format)]} {
2607                        set format $info(wfs.format)
2608                    }
2609                    if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2610                        SendCmd [list map layer add $layer line wfs $format $info(wfs.typename) $info(wfs.url) $info(cache) $r $g $b $style(-width) $style(-cap) $style(-join) $style(-stipplepattern) $style(-stipplefactor) $style(-clamping) $style(-clamptechnique) $style(-minrange) $style(-maxrange)]
2611                    } else {
2612                        SendCmd [list map layer add $layer line wfs $format $info(wfs.typename) $info(wfs.url) $info(cache) $r $g $b $style(-width) $style(-cap) $style(-join) $style(-stipplepattern) $style(-stipplefactor) $style(-clamping) $style(-clamptechnique)]
2613                    }
2614                }
2615            }
2616            SendCmd "map layer opacity $style(-opacity) $layer"
2617        }
2618        "point" {
2619            array set style {
2620                -color black
2621                -minbias 1000
2622                -opacity 1.0
2623                -size 1
2624            }
2625            if { [info exists info(style)] } {
2626                array set style $info(style)
2627            }
2628            if { [info exists info(opacity)] } {
2629                set style(-opacity) $info(opacity)
2630            }
2631            set _opacity($layer) [expr $style(-opacity) * 100]
2632            foreach {r g b} [Color2RGB $style(-color)] {}
2633            switch -- $info(driver)  {
2634                "ogr" {
2635                    SendFiles $info(ogr.url)
2636                    if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2637                        SendCmd [list map layer add $layer point ogr {} {} $info(ogr.url) $info(cache) $r $g $b $style(-size) $style(-minrange) $style(-maxrange)]
2638                    } else {
2639                        SendCmd [list map layer add $layer point ogr {} {} $info(ogr.url) $info(cache) $r $g $b $style(-size)]
2640                    }
2641                }
2642                "tfs" {
2643                    set format "json"
2644                    if {[info exists info(tfs.format)]} {
2645                        set format $info(tfs.format)
2646                    }
2647                    if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2648                        SendCmd [list map layer add $layer point tfs $format {} $info(ogr.url) $info(cache) $r $g $b $style(-size) $style(-minrange) $style(-maxrange)]
2649                    } else {
2650                        SendCmd [list map layer add $layer point tfs $format {} $info(ogr.url) $info(cache) $r $g $b $style(-size)]
2651                    }
2652                }
2653                "wfs" {
2654                    set format "json"
2655                    if {[info exists info(wfs.format)]} {
2656                        set format $info(wfs.format)
2657                    }
2658                    if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2659                        SendCmd [list map layer add $layer point wfs $format $info(wfs.typename) $info(ogr.url) $info(cache) $r $g $b $style(-size) $style(-minrange) $style(-maxrange)]
2660                    } else {
2661                        SendCmd [list map layer add $layer point wfs $format $info(wfs.typename) $info(ogr.url) $info(cache) $r $g $b $style(-size)]
2662                    }
2663                }
2664            }
2665            SendCmd "map layer opacity $style(-opacity) $layer"
2666        }
2667        "icon" {
2668            array set style {
2669                -align "center_bottom"
2670                -declutter 1
2671                -heading {}
2672                -icon pin
2673                -minbias 1000
2674                -opacity 1.0
2675                -placement "vertex"
2676                -scale {}
2677            }
2678            if { [info exists info(style)] } {
2679                array set style $info(style)
2680            }
2681            if { [info exists info(opacity)] } {
2682                set style(-opacity) $info(opacity)
2683            }
2684            set _opacity($layer) [expr $style(-opacity) * 100]
2685            switch -- $info(driver)  {
2686                "ogr" {
2687                    SendFiles $info(ogr.url)
2688                    if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2689                        SendCmd [list map layer add $layer icon ogr {} {} $info(ogr.url) $info(cache) $style(-icon) $style(-scale) $style(-heading) $style(-declutter) $style(-placement) $style(-align) $style(-minrange) $style(-maxrange)]
2690                    } else {
2691                        SendCmd [list map layer add $layer icon ogr {} {} $info(ogr.url) $info(cache) $style(-icon) $style(-scale) $style(-heading) $style(-declutter) $style(-placement) $style(-align)]
2692                    }
2693                }
2694                "tfs" {
2695                    set format "json"
2696                    if {[info exists info(tfs.format)]} {
2697                        set format $info(tfs.format)
2698                    }
2699                    if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2700                        SendCmd [list map layer add $layer icon tfs $format {} $info(tfs.url) $info(cache) $style(-icon) $style(-scale) $style(-heading) $style(-declutter) $style(-placement) $style(-align) $style(-minrange) $style(-maxrange)]
2701                    } else {
2702                        SendCmd [list map layer add $layer icon tfs $format {} $info(tfs.url) $info(cache) $style(-icon) $style(-scale) $style(-heading) $style(-declutter) $style(-placement) $style(-align)]
2703                    }
2704                }
2705                "wfs" {
2706                    set format "json"
2707                    if {[info exists info(wfs.format)]} {
2708                        set format $info(wfs.format)
2709                    }
2710                    if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2711                        SendCmd [list map layer add $layer icon wfs $format $info(wfs.typename) $info(wfs.url) $info(cache) $style(-icon) $style(-scale) $style(-heading) $style(-declutter) $style(-placement) $style(-align) $style(-minrange) $style(-maxrange)]
2712                    } else {
2713                        SendCmd [list map layer add $layer icon wfs $format $info(wfs.typename) $info(wfs.url) $info(cache) $style(-icon) $style(-scale) $style(-heading) $style(-declutter) $style(-placement) $style(-align)]
2714                    }
2715                }
2716            }
2717            SendCmd "map layer opacity $style(-opacity) $layer"
2718        }
2719        "polygon" {
2720            array set style {
2721                -clamping terrain
2722                -clamptechnique gpu
2723                -color white
2724                -minbias 1000
2725                -opacity 1.0
2726                -strokecolor black
2727                -strokewidth 0.0
2728            }
2729            if { [info exists info(style)] } {
2730                array set style $info(style)
2731            }
2732            if { [info exists info(opacity)] } {
2733                set style(-opacity) $info(opacity)
2734            }
2735            set _opacity($layer) [expr $style(-opacity) * 100]
2736            foreach {r g b} [Color2RGB $style(-color)] {}
2737            foreach {strokeR strokeG strokeB} [Color2RGB $style(-strokecolor)] {}
2738            switch -- $info(driver)  {
2739                "ogr" {
2740                    SendFiles $info(ogr.url)
2741                    if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2742                        SendCmd [list map layer add $layer polygon ogr {} {} $info(ogr.url) $info(cache) $r $g $b $style(-strokewidth) $strokeR $strokeG $strokeB $style(-clamping) $style(-clamptechnique) $style(-minrange) $style(-maxrange)]
2743                    } else {
2744                        SendCmd [list map layer add $layer polygon ogr {} {} $info(ogr.url) $info(cache) $r $g $b $style(-strokewidth) $strokeR $strokeG $strokeB $style(-clamping) $style(-clamptechnique)]
2745                    }
2746                }
2747                "tfs" {
2748                    set format "json"
2749                    if {[info exists info(tfs.format)]} {
2750                        set format $info(tfs.format)
2751                    }
2752                    if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2753                        SendCmd [list map layer add $layer polygon tfs $format {} $info(tfs.url) $info(cache) $r $g $b $style(-strokewidth) $strokeR $strokeG $strokeB $style(-clamping) $style(-clamptechnique) $style(-minrange) $style(-maxrange)]
2754                    } else {
2755                        SendCmd [list map layer add $layer polygon tfs $format {} $info(tfs.url) $info(cache) $r $g $b $style(-strokewidth) $strokeR $strokeG $strokeB $style(-clamping) $style(-clamptechnique)]
2756                    }
2757                }
2758                "wfs" {
2759                    set format "json"
2760                    if {[info exists info(wfs.format)]} {
2761                        set format $info(wfs.format)
2762                    }
2763                    if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2764                        SendCmd [list map layer add $layer polygon wfs $format $info(wfs.typename) $info(wfs.url) $info(cache) $r $g $b $style(-strokewidth) $strokeR $strokeG $strokeB $style(-clamping) $style(-clamptechnique) $style(-minrange) $style(-maxrange)]
2765                    } else {
2766                        SendCmd [list map layer add $layer polygon wfs $format $info(wfs.typename) $info(wfs.url) $info(cache) $r $g $b $style(-strokewidth) $strokeR $strokeG $strokeB $style(-clamping) $style(-clamptechnique)]
2767                    }
2768                }
2769            }
2770            SendCmd "map layer opacity $style(-opacity) $layer"
2771        }
2772        "label" {
2773            array set style {
2774                -align "left_baseline"
2775                -color black
2776                -declutter 1
2777                -font Arial
2778                -fontsize 16.0
2779                -halocolor white
2780                -halowidth 2.0
2781                -layout "left_to_right"
2782                -minbias 1000
2783                -opacity 1.0
2784                -removedupes 1
2785                -xoffset 0
2786                -yoffset 0
2787            }
2788            if { [info exists info(style)] } {
2789                array set style $info(style)
2790            }
2791            if { [info exists info(opacity)] } {
2792                set style(-opacity) $info(opacity)
2793            }
2794            set _opacity($layer) [expr $style(-opacity) * 100]
2795            set contentExpr $info(content)
2796            if {[info exists info(priority)]} {
2797                set priorityExpr $info(priority)
2798            } else {
2799                set priorityExpr ""
2800            }
2801            foreach {fgR fgG fgB} [Color2RGB $style(-color)] {}
2802            foreach {bgR bgG bgB} [Color2RGB $style(-halocolor)] {}
2803            switch -- $info(driver)  {
2804                "ogr" {
2805                    SendFiles $info(ogr.url)
2806                    if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2807                        SendCmd [list map layer add $layer text ogr {} {} $info(ogr.url) $info(cache) $contentExpr $priorityExpr $fgR $fgG $fgB $bgR $bgG $bgB $style(-halowidth) $style(-fontsize) $style(-removedupes) $style(-declutter) $style(-align) $style(-xoffset) $style(-yoffset) $style(-minrange) $style(-maxrange)]
2808                    } else {
2809                        SendCmd [list map layer add $layer text ogr {} {} $info(ogr.url) $info(cache) $contentExpr $priorityExpr $fgR $fgG $fgB $bgR $bgG $bgB $style(-halowidth) $style(-fontsize) $style(-removedupes) $style(-declutter) $style(-align) $style(-xoffset) $style(-yoffset)]
2810                    }
2811                }
2812                "tfs" {
2813                    set format "json"
2814                    if {[info exists info(tfs.format)]} {
2815                        set format $info(tfs.format)
2816                    }
2817                    if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2818                        SendCmd [list map layer add $layer text tfs $format {} $info(tfs.url) $info(cache) $contentExpr $priorityExpr $fgR $fgG $fgB $bgR $bgG $bgB $style(-halowidth) $style(-fontsize) $style(-removedupes) $style(-declutter) $style(-align) $style(-xoffset) $style(-yoffset) $style(-minrange) $style(-maxrange)]
2819                    } else {
2820                        SendCmd [list map layer add $layer text tfs $format {} $info(tfs.url) $info(cache) $contentExpr $priorityExpr $fgR $fgG $fgB $bgR $bgG $bgB $style(-halowidth) $style(-fontsize) $style(-removedupes) $style(-declutter) $style(-align) $style(-xoffset) $style(-yoffset)]
2821                    }
2822                }
2823                "wfs" {
2824                    set format "json"
2825                    if {[info exists info(wfs.format)]} {
2826                        set format $info(wfs.format)
2827                    }
2828                    if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2829                        SendCmd [list map layer add $layer text wfs $format $info(wfs.typename) $info(wfs.url) $contentExpr $priorityExpr $fgR $fgG $fgB $bgR $bgG $bgB $style(-halowidth) $style(-fontsize) $style(-removedupes) $style(-declutter) $style(-align) $style(-xoffset) $style(-yoffset) $style(-minrange) $style(-maxrange)]
2830                    } else {
2831                        SendCmd [list map layer add $layer text wfs $format $info(wfs.typename) $info(wfs.url) $contentExpr $priorityExpr $fgR $fgG $fgB $bgR $bgG $bgB $style(-halowidth) $style(-fontsize) $style(-removedupes) $style(-declutter) $style(-align) $style(-xoffset) $style(-yoffset)]
2832                    }
2833                }
2834            }
2835            SendCmd "map layer opacity $style(-opacity) $layer"
2836        }
2837    }
2838
2839    SendCmd "map layer visible $_visibility($layer) $layer"
2840}
2841
2842itcl::body Rappture::MapViewer::SetLayerOpacity { dataobj layer {value 100}} {
2843    set val $_opacity($layer)
2844    set sval [expr { 0.01 * double($val) }]
2845    SendCmd "map layer opacity $sval $layer"
2846}
2847
2848itcl::body Rappture::MapViewer::SetLayerVisibility { dataobj layer } {
2849    set bool $_visibility($layer)
2850    SendCmd "map layer visible $bool $layer"
2851}
2852
2853itcl::body Rappture::MapViewer::UpdateLayerControls {} {
2854    set row 0
2855    set inner $_layersFrame
2856    if { [winfo exists $inner.layers] } {
2857        foreach w [winfo children $inner.layers] {
2858            destroy $w
2859        }
2860    }
2861    set f $inner.layers
2862    set attrib [list]
2863    set imgIdx 0
2864    foreach dataobj [get -objects] {
2865        foreach layer [$dataobj layer names] {
2866            array unset info
2867            array set info [$dataobj layer settings $layer]
2868            checkbutton $f.${layer}_visible \
2869                -text $info(label) \
2870                -font "Arial 9" -anchor w \
2871                -variable [itcl::scope _visibility($layer)] \
2872                -command [itcl::code $this \
2873                              SetLayerVisibility $dataobj $layer]
2874            blt::table $f $row,0 $f.${layer}_visible -anchor w -pady 2 -cspan 2
2875            incr row
2876            if { $info(type) == "image" } {
2877                incr imgIdx
2878                if { $info(driver) == "colorramp" } {
2879                    set colormap $layer
2880                    if { ![info exists _image(legend-$colormap)] } {
2881                        set _image(legend-$colormap) [image create photo]
2882                    }
2883                    itk_component add legend-$colormap-min {
2884                        label $f.${layer}_legend-$colormap-min -text 0
2885                    }
2886                    itk_component add legend-$colormap-max {
2887                        label $f.${layer}_legend-$colormap-max -text 1
2888                    }
2889                    itk_component add legend-$colormap {
2890                        label $f.${layer}_legend-$colormap -image $_image(legend-$colormap)
2891                    }
2892                    blt::table $f $row,0 $f.${layer}_legend-$colormap-min -anchor w -pady 0
2893                    blt::table $f $row,1 $f.${layer}_legend-$colormap-max -anchor e -pady 0
2894                    incr row
2895                    blt::table $f $row,0 $f.${layer}_legend-$colormap -anchor w -pady 2 -cspan 2
2896                    incr row
2897                    RequestLegend $colormap 256 16
2898                }
2899            }
2900            if { $info(type) != "elevation" && ($info(type) != "image" || $imgIdx > 1) } {
2901                label $f.${layer}_opacity_l -text "Opacity" -font "Arial 9"
2902                ::scale $f.${layer}_opacity -from 0 -to 100 \
2903                    -orient horizontal -showvalue off \
2904                    -variable [itcl::scope _opacity($layer)] \
2905                    -width 10 \
2906                    -command [itcl::code $this \
2907                                  SetLayerOpacity $dataobj $layer]
2908                Rappture::Tooltip::for $f.${layer}_opacity "Set opacity of $info(label) layer"
2909                blt::table $f $row,0 $f.${layer}_opacity_l -anchor w -pady 2
2910                blt::table $f $row,1 $f.${layer}_opacity -anchor w -pady 2
2911                incr row
2912            }
2913            set tooltip [list $info(description)]
2914            if { [info exists info(attribution)] &&
2915                 $info(attribution) != ""} {
2916                lappend tooltip $info(attribution)
2917            }
2918            Rappture::Tooltip::for $f.${layer}_visible [join $tooltip \n]
2919        }
2920        set mapAttrib [$dataobj hints "attribution"]
2921        if { $mapAttrib != "" } {
2922            lappend attrib $mapAttrib
2923        }
2924    }
2925    SendCmd "[list map attrib [encoding convertto utf-8 [join $attrib ,]]]"
2926    label $f.map_attrib -text [join $attrib \n] -font "Arial 9"
2927    blt::table $f $row,0 $f.map_attrib -anchor sw -pady 2 -cspan 2
2928    #incr row
2929    if { $row > 0 } {
2930        blt::table configure $f r* c* -resize none
2931        blt::table configure $f r$row c1 -resize expand
2932    }
2933}
2934
2935itcl::body Rappture::MapViewer::UpdateViewpointControls {} {
2936    set row 0
2937    set inner $_viewpointsFrame
2938    if { [winfo exists $inner.viewpoints] } {
2939        foreach w [winfo children $inner.viewpoints] {
2940            destroy $w
2941        }
2942    }
2943    set f $inner.viewpoints
2944    foreach dataobj [get -objects] {
2945        foreach viewpoint [$dataobj viewpoints] {
2946            array unset info
2947            array set info [$dataobj viewpoint $viewpoint]
2948            button $f.${viewpoint}_go \
2949                -relief flat -compound left \
2950                -image [Rappture::icon placemark16] \
2951                -text $info(label) \
2952                -font "Arial 9" -anchor w \
2953                -command [itcl::code $this \
2954                              GoToViewpoint $dataobj $viewpoint]
2955            label $f.${viewpoint}_label \
2956                -text $info(label) \
2957                -font "Arial 9" -anchor w
2958            blt::table $f $row,0 $f.${viewpoint}_go -anchor w -pady 2 -cspan 2
2959            #blt::table $f $row,1 $f.${viewpoint}_label -anchor w -pady 2
2960            Rappture::Tooltip::for $f.${viewpoint}_go $info(description)
2961            incr row
2962        }
2963    }
2964    if { $row > 0 } {
2965        blt::table configure $f r* c* -resize none
2966        blt::table configure $f r$row c1 -resize expand
2967    }
2968}
2969
2970#
2971# Generate an OSG Earth file to send to server.  This is inteneded
2972# as a stopgap and testing tool until the protocol is fleshed out.
2973#
2974# Note that the lighting settings are required to be "hard-coded"
2975# as below for the runtime control to work.  Don't make those user
2976# configurable.
2977#
2978# Also note: Use "true"/"false" for boolean settings.  Not sure if
2979# the parser in OSG Earth accepts all of Tcl's forms of boolean vals.
2980#
2981itcl::body Rappture::MapViewer::EarthFile {} {
2982    append out "<map"
2983    append out " name=\"$_mapsettings(label)\""
2984    append out " type=\"$_mapsettings(type)\""
2985    append out " version=\"2\""
2986    append out ">\n"
2987    append out " <options lighting=\"true\">\n"
2988    # FIXME: convert color setting to hex
2989    # array set style $_mapsettings(style)
2990    # if {[info exists style(-color)]} {
2991    #     set color "?"
2992    # }
2993    set color "#ffffffff"
2994    append out "  <terrain lighting=\"false\" color=\"$color\"/>\n"
2995    if { [info exists _mapsettings(projection)] } {
2996        append out "  <profile"
2997        append out " srs=\"$_mapsettings(projection)\""
2998        if { [info exists _mapsettings(extents)] } {
2999            append out " xmin=\"$_mapsettings(x1)\""
3000            append out " ymin=\"$_mapsettings(y1)\""
3001            append out " xmax=\"$_mapsettings(x2)\""
3002            append out " ymax=\"$_mapsettings(y2)\""
3003        }
3004        append out "/>\n"
3005    }
3006    append out " </options>\n"
3007
3008    foreach dataobj [get -objects] {
3009        foreach layer [$dataobj layer names] {
3010            set _layers($layer) 1
3011            array unset info
3012            array set info [$dataobj layer settings $layer]
3013            switch -- $info(type) {
3014                "image" {
3015                    append out " <image"
3016                    append out " name=\"$layer\""
3017                    append out " driver=\"gdal\""
3018                    if { [info exists info(opacity)] } {
3019                        append out " opacity=\"$info(opacity)\""
3020                    }
3021                    if { $info(visible) } {
3022                        append out " visible=\"true\""
3023                    } else {
3024                        append out " visible=\"false\""
3025                    }
3026                    append out ">\n"
3027                    append out "  <url>$info(url)</url>\n"
3028                    append out " </image>\n"
3029                }
3030                "elevation" {
3031                    append out " <elevation"
3032                    append out " name=\"$layer\""
3033                    append out " driver=\"gdal\""
3034                    if { $info(visible) } {
3035                        append out " visible=\"true\""
3036                    } else {
3037                        append out " visible=\"false\""
3038                    }
3039                    append out ">\n"
3040                    append out "  <url>$info(url)</url>\n"
3041                    append out " </elevation>\n"
3042                }
3043                default {
3044                    puts stderr "Type $info(type) not implemented in MapViewer::EarthFile"
3045                }
3046            }
3047        }
3048    }
3049    append out "</map>\n"
3050    return $out
3051}
Note: See TracBrowser for help on using the repository browser.