source: branches/blt4_trunk/gui/scripts/mapviewer.tcl @ 6531

Last change on this file since 6531 was 6531, checked in by ldelgass, 8 years ago

merge from trunk to blt4_trunk branch

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