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

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

sync up camera settings across viewers

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