source: branches/1.3/gui/scripts/mapviewer.tcl @ 4706

Last change on this file since 4706 was 4706, checked in by ldelgass, 9 years ago

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