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

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

add Rappture build info to map clientinfo

File size: 71.1 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: mapviewer - Map object viewer
4#
5#  It connects to the GeoVis server running on a rendering farm,
6#  transmits data, and displays the results.
7# ======================================================================
8#  AUTHOR:  Michael McLennan, Purdue University
9#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
10#
11#  See the file "license.terms" for information on usage and
12#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13# ======================================================================
14package require Itk
15package require BLT
16#package require Img
17
18option add *MapViewer.width 4i widgetDefault
19option add *MapViewer*cursor crosshair widgetDefault
20option add *MapViewer.height 4i widgetDefault
21option add *MapViewer.foreground black widgetDefault
22option add *MapViewer.controlBackground gray widgetDefault
23option add *MapViewer.controlDarkBackground #999999 widgetDefault
24option add *MapViewer.plotBackground black widgetDefault
25option add *MapViewer.plotForeground white widgetDefault
26option add *MapViewer.font \
27    -*-helvetica-medium-r-normal-*-12-* widgetDefault
28
29# must use this name -- plugs into Rappture::resources::load
30proc MapViewer_init_resources {} {
31    Rappture::resources::register \
32        geovis_server Rappture::MapViewer::SetServerList
33}
34
35itcl::class Rappture::MapViewer {
36    inherit Rappture::VisViewer
37
38    itk_option define -plotforeground plotForeground Foreground ""
39    itk_option define -plotbackground plotBackground Background ""
40
41    private variable _layersFrame "";   # Name of layers frame widget
42    private variable _mapsettings;      # Global map settings
43
44    constructor { hostlist args } {
45        Rappture::VisViewer::constructor $hostlist
46    } {
47        # defined below
48    }
49    destructor {
50        # defined below
51    }
52    public proc SetServerList { namelist } {
53        Rappture::VisViewer::SetServerList "geovis" $namelist
54    }
55    public method add {dataobj {settings ""}}
56    public method camera {option args}
57    public method delete {args}
58    public method disconnect {}
59    public method download {option args}
60    public method get {args}
61    public method isconnected {}
62    public method 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 "version" "$Rappture::version"
864            lappend info "build" "$Rappture::build"
865            lappend info "svnurl" "$Rappture::svnurl"
866            lappend info "installdir" "$Rappture::installdir"
867            lappend info "hub" [exec hostname]
868            lappend info "client" "mapviewer"
869            lappend info "user" $user
870            lappend info "session" $session
871            SendCmd "clientinfo [list $info]"
872        }
873
874        set w [winfo width $itk_component(view)]
875        set h [winfo height $itk_component(view)]
876        EventuallyResize $w $h
877    }
878    return $result
879}
880
881#
882# isconnected --
883#
884#       Indicates if we are currently connected to the visualization server.
885#
886itcl::body Rappture::MapViewer::isconnected {} {
887    return [VisViewer::IsConnected]
888}
889
890#
891# disconnect --
892#
893itcl::body Rappture::MapViewer::disconnect {} {
894    Disconnect
895    set _reset 1
896}
897
898#
899# Disconnect --
900#
901#       Clients use this method to disconnect from the current rendering
902#       server.
903#
904itcl::body Rappture::MapViewer::Disconnect {} {
905    VisViewer::Disconnect
906
907    $_dispatcher cancel !pan
908    $_dispatcher cancel !motion
909    $_dispatcher cancel !rebuild
910    $_dispatcher cancel !resize
911    $_dispatcher cancel !rotate
912    # disconnected -- no more data sitting on server
913    array unset _layers
914    array unset _layersFrame
915    global readyForNextFrame
916    set readyForNextFrame 1
917}
918
919# ----------------------------------------------------------------------
920# USAGE: ReceiveImage -type <type> -token <token> -bytes <size>
921#
922# Invoked automatically whenever the "image" command comes in from
923# the rendering server.  Indicates that binary image data with the
924# specified <size> will follow.
925# ----------------------------------------------------------------------
926itcl::body Rappture::MapViewer::ReceiveImage { args } {
927    global readyForNextFrame
928    set readyForNextFrame 1
929    array set info {
930        -bytes 0
931        -token "???"
932        -type image
933    }
934    array set info $args
935    set bytes [ReceiveBytes $info(-bytes)]
936    if { $info(-type) == "image" } {
937        $_image(plot) configure -data $bytes
938    } elseif { $info(type) == "print" } {
939        set tag $this-print-$info(-token)
940        set _hardcopy($tag) $bytes
941    }
942}
943
944#
945# ReceiveMapInfo --
946#
947itcl::body Rappture::MapViewer::ReceiveMapInfo { args } {
948    if { ![isconnected] } {
949        return
950    }
951    set timeReceived [clock clicks -milliseconds]
952    set elapsed [expr $timeReceived - $_start]
953    set option [lindex $args 0]
954    switch -- $option {
955        "coords" {
956            set len [llength $args]
957            if {$len < 3} {
958                error "Bad map coords response"
959            } else {
960                set token [lindex $args 1]
961            }
962            foreach { x y z } [lindex $args 2] {
963                puts stderr "\[$token\] Map coords: $x $y $z"
964            }
965            if {$len > 3} {
966                set srs [lindex $args 3]
967                set vert [lindex $args 4]
968                puts stderr "\[$token\] {$srs} {$vert}"
969            }
970        }
971        "names" {
972            foreach { name } [lindex $args 1] {
973                puts stderr "layer: $name"
974            }
975        }
976        default {
977            error "unknown map option \"$option\" from server"
978        }
979    }
980}
981
982#
983# ReceiveScreenInfo --
984#
985itcl::body Rappture::MapViewer::ReceiveScreenInfo { args } {
986    if { ![isconnected] } {
987        return
988    }
989    set option [lindex $args 0]
990    switch -- $option {
991        "coords" {
992            set len [llength $args]
993            if {$len < 3} {
994                error "Bad screen coords response"
995            } else {
996                set token [lindex $args 1]
997            }
998            foreach { x y z } [lindex $args 2] {
999                puts stderr "\[$token\] Screen coords: $x $y $z"
1000            }
1001        }
1002        default {
1003            error "unknown screen option \"$option\" from server"
1004        }
1005    }
1006}
1007
1008# ----------------------------------------------------------------------
1009# USAGE: Rebuild
1010#
1011# Called automatically whenever something changes that affects the
1012# data in the widget.  Clears any existing data and rebuilds the
1013# widget to display new data.
1014# ----------------------------------------------------------------------
1015itcl::body Rappture::MapViewer::Rebuild {} {
1016    set w [winfo width $itk_component(view)]
1017    set h [winfo height $itk_component(view)]
1018    if { $w < 2 || $h < 2 } {
1019        $_dispatcher event -idle !rebuild
1020        return
1021    }
1022
1023    # Turn on buffering of commands to the server.  We don't want to be
1024    # preempted by a server disconnect/reconnect (which automatically
1025    # generates a new call to Rebuild).
1026    StartBufferingCommands
1027
1028    if { $_reset } {
1029        set _width $w
1030        set _height $h
1031        DoResize
1032
1033        if { [info exists _mapsettings(type)] } {
1034            # The map must be reset once before any layers are added This
1035            # should not be done more than once as it is very expensive.
1036            if {$_sendEarthFile} {
1037                set bytes [EarthFile]
1038                if {0} {
1039                    set f [open "/tmp/map.earth" "w"]
1040                    puts $f $bytes
1041                    close $f
1042                }
1043                set length [string length $bytes]
1044                SendCmd "map load data follows $length"
1045                append _outbuf $bytes
1046            } else {
1047                if { $_mapsettings(type) == "geocentric" } {
1048                    SendCmd "map reset geocentric"
1049                }  else {
1050                    set proj $_mapsettings(projection)
1051                    if { $proj == "" } {
1052                        SendCmd "map reset projected global-mercator"
1053                    } elseif { ![info exists _mapsettings(extents)] || $_mapsettings(extents) == "" } {
1054                        SendCmd [list map reset "projected" $proj]
1055                    } else {
1056                        #foreach {x1 y1 x2 y2} $_mapsettings(extents) break
1057                        foreach key "x1 y1 x2 y2" {
1058                            set $key $_mapsettings($key)
1059                        }
1060                        SendCmd [list map reset "projected" $proj $x1 $y1 $x2 $y2]
1061                    }
1062                }
1063                # XXX: Remove these after implementing batch load of layers with reset
1064                SendCmd "map layer delete base"
1065            }
1066
1067            # Most terrain settings are global to the map and apply even
1068            # if there is no elevation layer.  The exception is the
1069            # vertical scale, which only applies if there is an elevation
1070            # layer
1071            if { [info exists _mapsettings(style)] } {
1072                SetTerrainStyle $_mapsettings(style)
1073            } else {
1074                InitSettings terrain-edges terrain-lighting \
1075                    terrain-vertscale terrain-wireframe
1076            }
1077            InitSettings coords-visible
1078        } else {
1079            error "No map settings on reset"
1080        }
1081    }
1082
1083    set _first ""
1084    set count 0
1085
1086    foreach dataobj [get -objects] {
1087        set _obj2datasets($dataobj) ""
1088        foreach layer [$dataobj layers] {
1089            array unset info
1090            array set info [$dataobj layer $layer]
1091            if { ![info exists _layers($layer)] } {
1092                if { $_reportClientInfo }  {
1093                    set cinfo {}
1094                    lappend cinfo "tool_id"       [$dataobj hints toolid]
1095                    lappend cinfo "tool_name"     [$dataobj hints toolname]
1096                    lappend cinfo "tool_title"    [$dataobj hints tooltitle]
1097                    lappend cinfo "tool_command"  [$dataobj hints toolcommand]
1098                    lappend cinfo "tool_revision" [$dataobj hints toolrevision]
1099                    lappend cinfo "dataset_label" [$dataobj hints label]
1100                    lappend cinfo "dataset_tag"   $layer
1101                    SendCmd "clientinfo [list $cinfo]"
1102                }
1103                set _layers($layer) 1
1104                SetLayerStyle $dataobj $layer
1105            }
1106            lappend _obj2datasets($dataobj) $layer
1107            # FIXME: This is overriding all layers' initial visibility setting
1108            if { [info exists _obj2ovride($dataobj-raise)] } {
1109                SendCmd "map layer visible 1 $layer"
1110                set _visibility($layer) 1
1111                #SetLayerOpacity $layer
1112            }
1113        }
1114    }
1115
1116    if {$_reset} {
1117        if {$_initCamera} {
1118            # If this is the first Rebuild, we need to
1119            # set up the initial view settings if there
1120            # are any
1121            if { [info exists _mapsettings(camera)] } {
1122                set location $_mapsettings(camera)
1123                if { $location != "" } {
1124                    array set _view $location
1125                    camera set all
1126                }
1127            }
1128            set _initCamera 0
1129        } else {
1130            # Restore view from before reconnect
1131            camera set all
1132        }
1133    }
1134
1135    UpdateLayerControls
1136    set _reset 0
1137    global readyForNextFrame
1138    set readyForNextFrame 0;            # Don't advance to the next frame
1139                                        # until we get an image.
1140
1141    # Actually write the commands to the server socket.  If it fails, we
1142    # don't care.  We're finished here.
1143    blt::busy hold $itk_component(hull)
1144    StopBufferingCommands
1145    blt::busy release $itk_component(hull)
1146}
1147
1148# ----------------------------------------------------------------------
1149# USAGE: CurrentLayers ?-all -visible? ?dataobjs?
1150#
1151# Returns a list of server IDs for the current datasets being displayed.
1152# This is normally a single ID, but it might be a list of IDs if the
1153# current data object has multiple components.
1154# ----------------------------------------------------------------------
1155itcl::body Rappture::MapViewer::CurrentLayers {args} {
1156    set flag [lindex $args 0]
1157    switch -- $flag {
1158        "-all" {
1159            if { [llength $args] > 1 } {
1160                error "CurrentLayers: can't specify dataobj after \"-all\""
1161            }
1162            set dlist [get -objects]
1163        }
1164        "-visible" {
1165            if { [llength $args] > 1 } {
1166                set dlist {}
1167                set args [lrange $args 1 end]
1168                foreach dataobj $args {
1169                    if { [info exists _obj2ovride($dataobj-raise)] } {
1170                        lappend dlist $dataobj
1171                    }
1172                }
1173            } else {
1174                set dlist [get -visible]
1175            }
1176        }           
1177        default {
1178            set dlist $args
1179        }
1180    }
1181    set rlist ""
1182    foreach dataobj $dlist {
1183        foreach layer [$dataobj layers] {
1184            if { [info exists _layers($layer)] && $_layers($layer) } {
1185                lappend rlist $layer
1186            }
1187        }
1188    }
1189    return $rlist
1190}
1191
1192itcl::body Rappture::MapViewer::KeyPress {k} {
1193    SendCmd "key press $k"
1194}
1195
1196itcl::body Rappture::MapViewer::KeyRelease {k} {
1197    SendCmd "key release $k"
1198}
1199
1200itcl::body Rappture::MapViewer::GetNormalizedMouse {x y} {
1201    set w [winfo width $itk_component(view)]
1202    set h [winfo height $itk_component(view)]
1203    set x [expr {(2.0 * double($x)/$w) - 1.0}]
1204    set y [expr {(2.0 * double($y)/$h) - 1.0}]
1205    return [list $x $y]
1206}
1207
1208itcl::body Rappture::MapViewer::MouseClick {button x y} {
1209    SendCmd "mouse click $button $x $y"
1210}
1211
1212itcl::body Rappture::MapViewer::MouseDoubleClick {button x y} {
1213    SendCmd "mouse dblclick $button $x $y"
1214}
1215
1216itcl::body Rappture::MapViewer::MouseDrag {button x y} {
1217    SendCmd "mouse drag $button $x $y"
1218}
1219
1220itcl::body Rappture::MapViewer::MouseRelease {button x y} {
1221    SendCmd "mouse release $button $x $y"
1222}
1223
1224itcl::body Rappture::MapViewer::MouseMotion {} {
1225    #SendCmd "mouse motion $_motion(x) $_motion(y)"
1226    SendCmd "map pin hover $_motion(x) $_motion(y)"
1227    set _motion(pending) 0
1228}
1229
1230itcl::body Rappture::MapViewer::MouseScroll {direction} {
1231    switch -- $direction {
1232        "up" {
1233            SendCmd "mouse scroll 1"
1234        }
1235        "down" {
1236            SendCmd "mouse scroll -1"
1237        }
1238    }
1239}
1240
1241#
1242# EventuallyHandleMotionEvent --
1243#
1244#       This routine compresses (no button press) motion events.  It
1245#       delivers a server mouse command once every 100 milliseconds (if a
1246#       motion event is pending).
1247#
1248itcl::body Rappture::MapViewer::EventuallyHandleMotionEvent {x y} {
1249    set _motion(x) $x
1250    set _motion(y) $y
1251    if { !$_motion(compress) } {
1252        MouseMotion
1253        return
1254    }
1255    if { !$_motion(pending) } {
1256        set _motion(pending) 1
1257        $_dispatcher event -after $_motion(delay) !motion
1258    }
1259}
1260
1261# ----------------------------------------------------------------------
1262# USAGE: Zoom in
1263# USAGE: Zoom out
1264# USAGE: Zoom reset
1265#        $this Zoom click x y
1266#        $this Zoom drag x y
1267#        $this Zoom release x y
1268#
1269# Called automatically when the user clicks on one of the zoom
1270# controls for this widget.  Changes the zoom for the current view.
1271# Also implements mouse zoom.
1272# ----------------------------------------------------------------------
1273itcl::body Rappture::MapViewer::Zoom {option {x 0} {y 0}} {
1274    switch -- $option {
1275        "in" {
1276            # z here is normalized mouse Y delta
1277            set z -0.25
1278            SendCmd "camera zoom $z"
1279        }
1280        "out" {
1281            # z here is normalized mouse Y delta
1282            set z 0.25
1283            SendCmd "camera zoom $z"
1284        }
1285        "reset" {
1286            SendCmd "camera dist $_view(distance)"
1287        }
1288        "click" {
1289            set _click(x) $x
1290            set _click(y) $y
1291            $itk_component(view) configure -cursor hand1
1292        }
1293        "drag" {
1294            if { ![info exists _click(x)] } {
1295                set _click(x) $x
1296            }
1297            if { ![info exists _click(y)] } {
1298                set _click(y) $y
1299            }
1300            set h [winfo height $itk_component(view)]
1301            set dy [expr ($_click(y) - $y)/double($h)]
1302            set _click(x) $x
1303            set _click(y) $y
1304            if {[expr (abs($dy) > 0.0)]} {
1305                SendCmd "camera zoom $dy"
1306            }
1307        }
1308        "release" {
1309            Zoom drag $x $y
1310            $itk_component(view) configure -cursor ""
1311        }
1312    }
1313}
1314
1315# ----------------------------------------------------------------------
1316# USAGE: Rotate click <x> <y>
1317# USAGE: Rotate drag <x> <y>
1318# USAGE: Rotate release <x> <y>
1319#
1320# Called automatically when the user clicks/drags/releases in the
1321# plot area.  Moves the plot according to the user's actions.
1322# ----------------------------------------------------------------------
1323itcl::body Rappture::MapViewer::Rotate {option x y} {
1324    switch -- $option {
1325        "click" {
1326            $itk_component(view) configure -cursor fleur
1327            set _click(x) $x
1328            set _click(y) $y
1329            set _rotate(azimuth) 0
1330            set _rotate(elevation) 0
1331        }
1332        "drag" {
1333            if {[array size _click] == 0} {
1334                Rotate click $x $y
1335            } else {
1336                set w [winfo width $itk_component(view)]
1337                set h [winfo height $itk_component(view)]
1338                if {$w <= 0 || $h <= 0} {
1339                    return
1340                }
1341                set dx [expr ($x - $_click(x))/double($w)]
1342                set dy [expr ($_click(y) - $y)/double($h)]
1343                set _click(x) $x
1344                set _click(y) $y
1345                if {[expr (abs($dx) > 0.0 || abs($dy) > 0.0)]} {
1346                    #SendCmd "camera rotate $dx $dy"
1347                    EventuallyRotate $dx $dy
1348                }
1349            }
1350        }
1351        "release" {
1352            Rotate drag $x $y
1353            $itk_component(view) configure -cursor ""
1354            catch {unset _click}
1355        }
1356        default {
1357            error "bad option \"$option\": should be click, drag, release"
1358        }
1359    }
1360}
1361
1362itcl::body Rappture::MapViewer::Select {option x y} {
1363    switch -- $option {
1364        "click" {
1365            set _click(x) $x
1366            set _click(y) $y
1367            set _b1mode "select"
1368            SendCmd "map box init $x $y"
1369        }
1370        "drag" {
1371            if {$_b1mode == "select"} {
1372                SendCmd "map box update $x $y"
1373            }
1374        }
1375        "release" {
1376            set _b1mode ""
1377            if {$_click(x) == $x &&
1378                $_click(y) == $y} {
1379                SendCmd "map box clear"
1380            }
1381        }
1382    }
1383}
1384
1385itcl::body Rappture::MapViewer::Pin {option x y} {
1386    set _click(x) $x
1387    set _click(y) $y
1388    switch -- $option {
1389        "add" {
1390            incr _labelCount
1391            set label "Label $_labelCount"
1392            SendCmd [list "map" "pin" "add" $x $y $label]
1393        }
1394        "delete" {
1395            SendCmd "map pin delete $x $y"
1396        }
1397    }
1398}
1399
1400# ----------------------------------------------------------------------
1401# USAGE: $this Pan set x y
1402#        $this Pan click x y
1403#        $this Pan drag x y
1404#        $this Pan release x y
1405#
1406# Called automatically when the user clicks on one of the zoom
1407# controls for this widget.  Changes the zoom for the current view.
1408# ----------------------------------------------------------------------
1409itcl::body Rappture::MapViewer::Pan {option x y} {
1410    switch -- $option {
1411        "set" {
1412            set w [winfo width $itk_component(view)]
1413            set h [winfo height $itk_component(view)]
1414            set x [expr $x / double($w)]
1415            set y [expr $y / double($h)]
1416            if {[expr (abs($x) > 0.0 || abs($y) > 0.0)]} {
1417                SendCmd "camera pan $x $y"
1418            }
1419            return
1420        }
1421        "click" {
1422            set _click(x) $x
1423            set _click(y) $y
1424            set _pan(x) 0
1425            set _pan(y) 0
1426            $itk_component(view) configure -cursor hand1
1427            set _b1mode "pan"
1428        }
1429        "drag" {
1430            if {$_b1mode != "pan"} {
1431                return
1432            }
1433            if { ![info exists _click(x)] } {
1434                set _click(x) $x
1435            }
1436            if { ![info exists _click(y)] } {
1437                set _click(y) $y
1438            }
1439            set w [winfo width $itk_component(view)]
1440            set h [winfo height $itk_component(view)]
1441            set dx [expr ($x - $_click(x))/double($w)]
1442            set dy [expr ($_click(y) - $y)/double($h)]
1443            set _click(x) $x
1444            set _click(y) $y
1445            if {[expr (abs($dx) > 0.0 || abs($dy) > 0.0)]} {
1446                EventuallyPan $dx $dy
1447                #SendCmd "camera pan $dx $dy"
1448            }
1449        }
1450        "release" {
1451            Pan drag $x $y
1452            $itk_component(view) configure -cursor ""
1453            set _b1mode ""
1454        }
1455        default {
1456            error "unknown option \"$option\": should set, click, drag, or release"
1457        }
1458    }
1459}
1460
1461# ----------------------------------------------------------------------
1462# USAGE: InitSettings <what> ?<value>?
1463#
1464# Used internally to update rendering settings whenever parameters
1465# change in the popup settings panel.  Sends the new settings off
1466# to the back end.
1467# ----------------------------------------------------------------------
1468itcl::body Rappture::MapViewer::InitSettings { args } {
1469    foreach setting $args {
1470        AdjustSetting $setting
1471    }
1472}
1473
1474#
1475# AdjustSetting --
1476#
1477#       Changes/updates a specific setting in the widget.  There are
1478#       usually user-setable option.  Commands are sent to the render
1479#       server.
1480#
1481itcl::body Rappture::MapViewer::AdjustSetting {what {value ""}} {
1482    if { ![isconnected] } {
1483        return
1484    }
1485    switch -- $what {
1486        "coords-visible" - "coords-precision" - "coords-units" {
1487            set bool $_settings(coords-visible)
1488            set units $_settings(coords-units)
1489            set precision $_settings(coords-precision)
1490            SendCmd "map posdisp $bool $units $precision"
1491        }
1492        "grid" - "grid-type" {
1493            set bool $_settings(grid)
1494            set gridType $_settings(grid-type)
1495            SendCmd "map grid $bool $gridType"
1496        }
1497        "camera-throw" {
1498            set bool $_settings($what)
1499            SendCmd "camera throw $bool"
1500        }
1501        "terrain-edges" {
1502            set bool $_settings($what)
1503            SendCmd "map terrain edges $bool"
1504        }
1505        "terrain-lighting" {
1506            set bool $_settings($what)
1507            SendCmd "map terrain lighting $bool"
1508        }
1509        "terrain-palette" {
1510            set cmap [$itk_component(terrainpalette) value]
1511            #SendCmd "map terrain colormap $cmap"
1512        }
1513        "terrain-vertscale" {
1514            set val $_settings($what)
1515            SendCmd "map terrain vertscale $val"
1516        }
1517        "terrain-wireframe" {
1518            set bool $_settings($what)
1519            SendCmd "map terrain wireframe $bool"
1520        }
1521        default {
1522            error "don't know how to fix $what"
1523        }
1524    }
1525}
1526
1527# ----------------------------------------------------------------------
1528# CONFIGURATION OPTION: -plotbackground
1529# ----------------------------------------------------------------------
1530itcl::configbody Rappture::MapViewer::plotbackground {
1531    if { [isconnected] } {
1532        set rgb [Color2RGB $itk_option(-plotbackground)]
1533        SendCmd "screen bgcolor $rgb"
1534    }
1535}
1536
1537# ----------------------------------------------------------------------
1538# CONFIGURATION OPTION: -plotforeground
1539# ----------------------------------------------------------------------
1540itcl::configbody Rappture::MapViewer::plotforeground {
1541    if { [isconnected] } {
1542        set rgb [Color2RGB $itk_option(-plotforeground)]
1543        # FIXME: Set font foreground colors
1544    }
1545}
1546
1547itcl::body Rappture::MapViewer::BuildTerrainTab {} {
1548
1549    set fg [option get $itk_component(hull) font Font]
1550    #set bfg [option get $itk_component(hull) boldFont Font]
1551
1552    set inner [$itk_component(main) insert end \
1553        -title "Terrain Settings" \
1554        -icon [Rappture::icon surface]]
1555    $inner configure -borderwidth 4
1556
1557    checkbutton $inner.posdisp \
1558        -text "Show Coordinate Readout" \
1559        -variable [itcl::scope _settings(coords-visible)] \
1560        -command [itcl::code $this AdjustSetting coords-visible] \
1561        -font "Arial 9" -anchor w
1562
1563    checkbutton $inner.grid \
1564        -text "Show Graticule" \
1565        -variable [itcl::scope _settings(grid)] \
1566        -command [itcl::code $this AdjustSetting grid] \
1567        -font "Arial 9" -anchor w
1568
1569    checkbutton $inner.wireframe \
1570        -text "Show Wireframe" \
1571        -variable [itcl::scope _settings(terrain-wireframe)] \
1572        -command [itcl::code $this AdjustSetting terrain-wireframe] \
1573        -font "Arial 9" -anchor w
1574
1575    checkbutton $inner.lighting \
1576        -text "Enable Lighting" \
1577        -variable [itcl::scope _settings(terrain-lighting)] \
1578        -command [itcl::code $this AdjustSetting terrain-lighting] \
1579        -font "Arial 9" -anchor w
1580
1581    checkbutton $inner.edges \
1582        -text "Show Edges" \
1583        -variable [itcl::scope _settings(terrain-edges)] \
1584        -command [itcl::code $this AdjustSetting terrain-edges] \
1585        -font "Arial 9" -anchor w
1586
1587    label $inner.palette_l -text "Palette" -font "Arial 9" -anchor w
1588    itk_component add terrainpalette {
1589        Rappture::Combobox $inner.palette -width 10 -editable no
1590    }
1591    $inner.palette choices insert end [GetColormapList]
1592
1593    $itk_component(terrainpalette) value "BCGYR"
1594    bind $inner.palette <<Value>> \
1595        [itcl::code $this AdjustSetting terrain-palette]
1596
1597    label $inner.vscale_l -text "Vertical Scale" -font "Arial 9" -anchor w
1598    ::scale $inner.vscale -from 0 -to 10 -orient horizontal \
1599        -variable [itcl::scope _settings(terrain-vertscale)] \
1600        -width 10 \
1601        -resolution 0.1 \
1602        -showvalue on \
1603        -command [itcl::code $this AdjustSetting terrain-vertscale]
1604    $inner.vscale set $_settings(terrain-vertscale)
1605
1606    blt::table $inner \
1607        0,0 $inner.posdisp   -cspan 2  -anchor w -pady 2 \
1608        1,0 $inner.grid      -cspan 2  -anchor w -pady 2 \
1609        2,0 $inner.wireframe -cspan 2  -anchor w -pady 2 \
1610        3,0 $inner.lighting  -cspan 2  -anchor w -pady 2 \
1611        4,0 $inner.edges     -cspan 2  -anchor w -pady 2 \
1612        5,0 $inner.vscale_l  -anchor w -pady 2 \
1613        5,1 $inner.vscale    -fill x   -pady 2 \
1614        6,0 $inner.palette_l -anchor w -pady 2 \
1615        6,1 $inner.palette   -fill x   -pady 2 
1616
1617    blt::table configure $inner r* c* -resize none
1618    blt::table configure $inner r8 c1 -resize expand
1619}
1620
1621itcl::body Rappture::MapViewer::BuildLayerTab {} {
1622
1623    set fg [option get $itk_component(hull) font Font]
1624    #set bfg [option get $itk_component(hull) boldFont Font]
1625
1626    set inner [$itk_component(main) insert end \
1627        -title "Layers" \
1628        -icon [Rappture::icon layers]]
1629    $inner configure -borderwidth 4
1630    set f [frame $inner.layers]
1631    blt::table $inner \
1632        0,0 $f -fill both
1633    set _layersFrame $inner
1634}
1635
1636itcl::body Rappture::MapViewer::BuildCameraTab {} {
1637    set inner [$itk_component(main) insert end \
1638        -title "Camera Settings" \
1639        -icon [Rappture::icon camera]]
1640    $inner configure -borderwidth 4
1641
1642    set row 0
1643
1644    set labels { x y z heading pitch distance }
1645    foreach tag $labels {
1646        label $inner.${tag}label -text $tag -font "Arial 9"
1647        entry $inner.${tag} -font "Arial 9"  -bg white \
1648            -textvariable [itcl::scope _view($tag)]
1649        bind $inner.${tag} <KeyPress-Return> \
1650            [itcl::code $this camera set ${tag}]
1651        bind $inner.${tag} <KP_Enter> \
1652            [itcl::code $this camera set ${tag}]
1653        blt::table $inner \
1654            $row,0 $inner.${tag}label -anchor e -pady 2 \
1655            $row,1 $inner.${tag} -anchor w -pady 2
1656        blt::table configure $inner r$row -resize none
1657        incr row
1658    }
1659    set labels { srs verticalDatum }
1660    foreach tag $labels {
1661        label $inner.${tag}label -text $tag -font "Arial 9"
1662        entry $inner.${tag} -font "Arial 9"  -bg white \
1663            -textvariable [itcl::scope _view($tag)]
1664        bind $inner.${tag} <KeyPress-Return> \
1665            [itcl::code $this camera set ${tag}]
1666        bind $inner.${tag} <KP_Enter> \
1667            [itcl::code $this camera set ${tag}]
1668        blt::table $inner \
1669            $row,0 $inner.${tag}label -anchor e -pady 2 \
1670            $row,1 $inner.${tag} -anchor w -pady 2
1671        blt::table configure $inner r$row -resize none
1672        incr row
1673    }
1674
1675    if {0} {
1676    button $inner.get \
1677        -text "Get Camera Settings" \
1678        -font "Arial 9" \
1679        -command [itcl::code $this SendCmd "camera get"]
1680    blt::table $inner \
1681        $row,0 $inner.get -anchor w -pady 2 -cspan 2
1682    blt::table configure $inner r$row -resize none
1683    incr row
1684
1685    button $inner.set \
1686        -text "Apply Camera Settings" \
1687        -font "Arial 9" \
1688        -command [itcl::code $this camera set all]
1689    blt::table $inner \
1690        $row,0 $inner.set -anchor w -pady 2 -cspan 2
1691    blt::table configure $inner r$row -resize none
1692    incr row
1693    }
1694
1695    if {$_useServerManip} {
1696        checkbutton $inner.throw \
1697            -text "Enable Throw" \
1698            -font "Arial 9" \
1699            -variable [itcl::scope _settings(camera-throw)] \
1700            -command [itcl::code $this AdjustSetting camera-throw]
1701        blt::table $inner \
1702            $row,0 $inner.throw -anchor w -pady 2 -cspan 2
1703        blt::table configure $inner r$row -resize none
1704        incr row
1705    }
1706
1707    blt::table configure $inner c* r* -resize none
1708    blt::table configure $inner c2 -resize expand
1709    blt::table configure $inner r$row -resize expand
1710}
1711
1712#
1713#  camera --
1714#
1715# USAGE: camera get
1716#        This is called by the server to transfer the
1717#        current Viewpoint settings
1718# USAGE: camera reset
1719#        Reset the camera to the default view
1720#
1721itcl::body Rappture::MapViewer::camera {option args} {
1722    switch -- $option {
1723        "get" {
1724            # We got the camera settings from the server
1725            foreach name {x y z heading pitch distance srs verticalDatum} value $args {
1726                set _view($name) $value
1727            }
1728            puts stderr "view: $_view(x), $_view(y), $_view(z), $_view(heading), $_view(pitch), $_view(distance), {$_view(srs)}, {$_view(verticalDatum)}"
1729        }
1730        "go" {
1731            SendCmd "camera go $args"
1732        }
1733        "reset" {
1734            array set _view {
1735                x               0.0
1736                y               0.0
1737                z               0.0
1738                heading         0.0
1739                pitch           -89.9
1740                distance        1.0
1741                srs             ""
1742                verticalDatum   ""
1743            }
1744            if { [info exists _mapsettings(camera)] } {
1745                # Check if the tool specified a default
1746                set location $_mapsettings(camera)
1747                if { $location != "" } {
1748                    array set _view $location
1749                    set duration 0.0
1750                    SendCmd [list camera set $_view(x) $_view(y) $_view(z) $_view(heading) $_view(pitch) $_view(distance) $duration $_view(srs) $_view(verticalDatum)]
1751                } else {
1752                    SendCmd "camera reset"
1753                    # Retrieve the settings
1754                    #SendCmd "camera get"
1755                }
1756            } else {
1757                SendCmd "camera reset"
1758                # Retrieve the settings
1759               # SendCmd "camera get"
1760            }
1761        }
1762        "set" {
1763            set who [lindex $args 0]
1764            if {$who != "all" && $who != "srs" && $who != "verticalDatum"} {
1765                set val $_view($who)
1766                set code [catch { string is double $val } result]
1767                if { $code != 0 || !$result } {
1768                    return
1769                }
1770            }
1771            switch -- $who {
1772                "distance" {
1773                    SendCmd [list camera dist $_view(distance)]
1774                }
1775                "all" - "x" - "y" - "z" - "heading" - "pitch" - "srs" - "verticalDatum" {
1776                    set duration 0.0
1777                    SendCmd [list camera set $_view(x) $_view(y) $_view(z) $_view(heading) $_view(pitch) $_view(distance) $duration $_view(srs) $_view(verticalDatum)]
1778                }
1779            }
1780        }
1781    }
1782}
1783
1784itcl::body Rappture::MapViewer::GetImage { args } {
1785    if { [image width $_image(download)] > 0 &&
1786         [image height $_image(download)] > 0 } {
1787        set bytes [$_image(download) data -format "jpeg -quality 100"]
1788        set bytes [Rappture::encoding::decode -as b64 $bytes]
1789        return [list .jpg $bytes]
1790    }
1791    return ""
1792}
1793
1794itcl::body Rappture::MapViewer::BuildDownloadPopup { popup command } {
1795    Rappture::Balloon $popup \
1796        -title "[Rappture::filexfer::label downloadWord] as..."
1797    set inner [$popup component inner]
1798    label $inner.summary -text "" -anchor w
1799
1800    radiobutton $inner.image_button -text "Image File" \
1801        -variable [itcl::scope _downloadPopup(format)] \
1802        -value image
1803    Rappture::Tooltip::for $inner.image_button \
1804        "Save as digital image."
1805
1806    button $inner.ok -text "Save" \
1807        -highlightthickness 0 -pady 2 -padx 3 \
1808        -command $command \
1809        -compound left \
1810        -image [Rappture::icon download]
1811
1812    button $inner.cancel -text "Cancel" \
1813        -highlightthickness 0 -pady 2 -padx 3 \
1814        -command [list $popup deactivate] \
1815        -compound left \
1816        -image [Rappture::icon cancel]
1817
1818    blt::table $inner \
1819        0,0 $inner.summary -cspan 2  \
1820        2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \
1821        4,1 $inner.cancel -width .9i -fill y \
1822        4,0 $inner.ok -padx 2 -width .9i -fill y
1823    blt::table configure $inner r3 -height 4
1824    blt::table configure $inner r4 -pady 4
1825    raise $inner.image_button
1826    $inner.image_button invoke
1827    return $inner
1828}
1829
1830itcl::body Rappture::MapViewer::SetTerrainStyle { style } {
1831    array set settings {
1832        -color white
1833        -edgecolor black
1834        -edges 0
1835        -lighting 0
1836        -linewidth 1.0
1837        -vertscale 1.0
1838        -wireframe 0
1839    }
1840    array set settings $style
1841
1842    SendCmd "map terrain edges $settings(-edges)"
1843    set _settings(terrain-edges) $settings(-edges)
1844    #SendCmd "map terrain color [Color2RGB $settings(-color)]"
1845    #SendCmd "map terrain colormode constant"
1846    SendCmd "map terrain lighting $settings(-lighting)"
1847    set _settings(terrain-lighting) $settings(-lighting)
1848    SendCmd "map terrain linecolor [Color2RGB $settings(-edgecolor)]"
1849    #SendCmd "map terrain linewidth $settings(-linewidth)"
1850    SendCmd "map terrain vertscale $settings(-vertscale)"
1851    set _settings(terrain-vertscale) $settings(-vertscale)
1852    SendCmd "map terrain wireframe $settings(-wireframe)"
1853    set _settings(terrain-wireframe) $settings(-wireframe)
1854}
1855
1856itcl::body Rappture::MapViewer::SetLayerStyle { dataobj layer } {
1857    array set info [$dataobj layer $layer]
1858    set _visibility($layer) 1
1859
1860    switch -- $info(type) {
1861        "image" {
1862            array set settings {
1863                -min_level 0
1864                -max_level 23
1865                -opacity 1.0
1866            }
1867            if { [info exists info(style)] } {
1868                array set settings $info(style)
1869            }
1870            if { [info exists info(opacity)] } {
1871                set settings(-opacity) $info(opacity)
1872            }
1873            if {!$_sendEarthFile} {
1874                switch -- $info(driver)  {
1875                    "debug" {
1876                        SendCmd [list map layer add image debug $layer]
1877                    }
1878                    "gdal" {
1879                        SendCmd [list map layer add image gdal \
1880                                     $info(gdal.url) $layer]
1881                    }
1882                    "tms" {
1883                        SendCmd [list map layer add image tms \
1884                                     $info(tms.url) $layer]
1885                    }
1886                    "wms" {
1887                        SendCmd [list map layer add image wms \
1888                                     $info(wms.url) \
1889                                     $info(wms.layers) \
1890                                     $info(wms.format) \
1891                                     $info(wms.transparent) \
1892                                     $layer]
1893                    }
1894                    "xyz" {
1895                        SendCmd [list map layer add image xyz \
1896                                     $info(xyz.url) \
1897                                     $layer]
1898                    }
1899                }                       
1900            }
1901            SendCmd "map layer opacity $settings(-opacity) $layer"
1902        }
1903        "elevation" {
1904            array set settings {
1905                -min_level 0
1906                -max_level 23
1907            }
1908            if { [info exists info(style)] } {
1909                array set settings $info(style)
1910            }
1911            if {!$_sendEarthFile} {
1912                switch -- $info(driver)  {
1913                    "gdal" {
1914                        SendCmd [list map layer add elevation gdal \
1915                                     $info(gdal.url) $layer]
1916                    }
1917                    "tms" {
1918                        SendCmd [list map layer add elevation tms \
1919                                     $info(tms.url) $layer]
1920                    }
1921                }
1922            }
1923        }
1924        "line" {
1925            array set settings {
1926                -color black
1927                -minbias 1000
1928                -opacity 1.0
1929                -width 1
1930            }
1931            if { [info exists info(style)] } {
1932                array set settings $info(style)
1933            }
1934            if { [info exists info(opacity)] } {
1935                set settings(-opacity) $info(opacity)
1936            }
1937            SendCmd [list map layer add line $info(ogr.url) $layer]
1938            SendCmd "map layer opacity $settings(-opacity) $layer"
1939        }
1940        "polygon" {
1941            array set settings {
1942                -color white
1943                -minbias 1000
1944                -opacity 1.0
1945            }
1946            if { [info exists info(style)] } {
1947                array set settings $info(style)
1948            }
1949            if { [info exists info(opacity)] } {
1950                set settings(-opacity) $info(opacity)
1951            }
1952            SendCmd [list map layer add polygon $info(ogr.url) $layer]
1953            SendCmd "map layer opacity $settings(-opacity) $layer"
1954        }
1955        "label" {
1956            array set settings {
1957                -align "center-center"
1958                -color black
1959                -declutter 1
1960                -font Arial
1961                -fontsize 16.0
1962                -halocolor white
1963                -halowidth 2.0
1964                -layout "ltr"
1965                -minbias 1000
1966                -opacity 1.0
1967                -removedupe 1
1968            }
1969            if { [info exists info(style)] } {
1970                array set settings $info(style)
1971            }
1972            if { [info exists info(opacity)] } {
1973                set settings(-opacity) $info(opacity)
1974            }
1975            set contentExpr $info(content)
1976            if {[info exists info(priority)]} {
1977                set priorityExpr $info(priority)
1978            } else {
1979                set priorityExpr ""
1980            }
1981            SendCmd [list map layer add text $info(ogr.url) $contentExpr $priorityExpr $layer]
1982            SendCmd "map layer opacity $settings(-opacity) $layer"
1983        }
1984    }
1985
1986    if { [info exists info(visible)] } {
1987        if { !$info(visible) } {
1988            set _visibility($layer) 0
1989            SendCmd "map layer visible 0 $layer"
1990        }
1991    }
1992}
1993
1994itcl::body Rappture::MapViewer::SetOpacity { dataset } {
1995    foreach {dataobj layer} [split $dataset -] break
1996    set type [$dataobj type $layer]
1997    set val $_settings(-opacity)
1998    set sval [expr { 0.01 * double($val) }]
1999    if { !$_obj2ovride($dataobj-raise) } {
2000        # This is wrong.  Need to figure out why raise isn't set with 1
2001        #set sval [expr $sval * .6]
2002    }
2003    SendCmd "$type opacity $sval $dataset"
2004}
2005
2006itcl::body Rappture::MapViewer::ChangeLayerVisibility { dataobj layer } {
2007    set bool $_visibility($layer)
2008    SendCmd "map layer visible $bool $layer"
2009}
2010
2011itcl::body Rappture::MapViewer::UpdateLayerControls {} {
2012    set row 0
2013    set inner $_layersFrame
2014    if { [winfo exists $inner.layers] } {
2015        foreach w [winfo children $inner.layers] {
2016            destroy $w
2017        }
2018    }
2019    set f $inner.layers
2020    foreach dataobj [get -objects] {
2021        foreach layer [$dataobj layers] {
2022            array unset info
2023            array set info [$dataobj layer $layer]
2024            checkbutton $f.$layer \
2025                -text $info(label) \
2026                -variable [itcl::scope _visibility($layer)] \
2027                -command [itcl::code $this \
2028                              ChangeLayerVisibility $dataobj $layer] \
2029                    -font "Arial 9" -anchor w
2030            blt::table $f $row,0 $f.$layer -anchor w -pady 2
2031            Rappture::Tooltip::for $f.$layer $info(description)
2032            incr row
2033        }
2034    }
2035    if { $row > 0 } {
2036        blt::table configure $f r* c* -resize none
2037        blt::table configure $f r$row c1 -resize expand
2038    }
2039}
2040
2041#
2042# Generate an OSG Earth file to send to server.  This is inteneded
2043# as a stopgap and testing tool until the protocol is fleshed out.
2044#
2045# Note that the lighting settings are required to be "hard-coded"
2046# as below for the runtime control to work.  Don't make those user
2047# configurable.
2048#
2049# Also note: Use "true"/"false" for boolean settings.  Not sure if
2050# the parser in OSG Earth accepts all of Tcl's forms of boolean vals.
2051#
2052itcl::body Rappture::MapViewer::EarthFile {} {
2053    append out "<map"
2054    append out " name=\"$_mapsettings(label)\""
2055    append out " type=\"$_mapsettings(type)\""
2056    append out " version=\"2\""
2057    append out ">\n"
2058    append out " <options lighting=\"true\">\n"
2059    # FIXME: convert color setting to hex
2060    # array set style $_mapsettings(style)
2061    # if {[info exists style(-color)]} {
2062    #     set color "?"
2063    # }
2064    set color "#ffffffff"
2065    append out "  <terrain lighting=\"false\" color=\"$color\"/>\n"
2066    if { [info exists _mapsettings(projection)] } {
2067        append out "  <profile"
2068        append out " srs=\"$_mapsettings(projection)\""
2069        if { [info exists _mapsettings(extents)] } {
2070            append out " xmin=\"$_mapsettings(x1)\""
2071            append out " ymin=\"$_mapsettings(y1)\""
2072            append out " xmax=\"$_mapsettings(x2)\""
2073            append out " ymax=\"$_mapsettings(y2)\""
2074        }
2075        append out "/>\n"
2076    }
2077    append out " </options>\n"
2078
2079    foreach dataobj [get -objects] {
2080        foreach layer [$dataobj layers] {
2081            set _layers($layer) 1
2082            array unset info
2083            array set info [$dataobj layer $layer]
2084            switch -- $info(type) {
2085                "image" {
2086                    append out " <image"
2087                    append out " name=\"$layer\""
2088                    append out " driver=\"gdal\""
2089                    if { [info exists info(opacity)] } {
2090                        append out " opacity=\"$info(opacity)\""
2091                    }
2092                    if { $info(visible) } {
2093                        append out " visible=\"true\""
2094                    } else {
2095                        append out " visible=\"false\""
2096                    }
2097                    append out ">\n"
2098                    append out "  <url>$info(url)</url>\n"
2099                    append out " </image>\n"
2100                }
2101                "elevation" {
2102                    append out " <elevation"
2103                    append out " name=\"$layer\""
2104                    append out " driver=\"gdal\""
2105                    if { $info(visible) } {
2106                        append out " visible=\"true\""
2107                    } else {
2108                        append out " visible=\"false\""
2109                    }
2110                    append out ">\n"
2111                    append out "  <url>$info(url)</url>\n"
2112                    append out " </elevation>\n"
2113                }
2114                default {
2115                    puts stderr "Type $info(type) not implemented in MapViewer::EarthFile"
2116                }
2117            }
2118        }
2119    }
2120    append out "</map>\n"
2121    return $out
2122}
Note: See TracBrowser for help on using the repository browser.