source: branches/blt4_geovis/gui/scripts/mapviewer.tcl @ 5994

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

merging in placard configuration updates, placard example, feature select example, and add-remove layer example from geomap branch r5971,r5990,r5991,r5993

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