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

Last change on this file since 4630 was 4630, checked in by ldelgass, 7 years ago

Update map viewer for new 0.5.0 protocol

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