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

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

test pins

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