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

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

Add method to VisViewer? to get list of pre-defined colormap names. There was
an issue with the name "blue" since it could also be used for a constant color,
but the named "blue" was actually a white-to-blue ramp, so it is now named
"white-to-blue". Also, some work on expanded color settings for glyph viewer.

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