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

Last change on this file since 4363 was 4363, checked in by ldelgass, 10 years ago

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