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

Last change on this file since 4279 was 4279, checked in by gah, 10 years ago

add back terrain styles in SetObjectStyle?
File size: 54.8 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2
3# ----------------------------------------------------------------------
4#  COMPONENT: mapviewer - Map object viewer
5#
6#  It connects to the GeoVis server running on a rendering farm,
7#  transmits data, and displays the results.
8# ======================================================================
9#  AUTHOR:  Michael McLennan, Purdue University
10#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
11#
12#  See the file "license.terms" for information on usage and
13#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14# ======================================================================
15package require Itk
16package require BLT
17#package require Img
18
19option add *MapViewer.width 4i widgetDefault
20option add *MapViewer*cursor crosshair widgetDefault
21option add *MapViewer.height 4i widgetDefault
22option add *MapViewer.foreground black widgetDefault
23option add *MapViewer.controlBackground gray widgetDefault
24option add *MapViewer.controlDarkBackground #999999 widgetDefault
25option add *MapViewer.plotBackground black widgetDefault
26option add *MapViewer.plotForeground white widgetDefault
27option add *MapViewer.font \
28    -*-helvetica-medium-r-normal-*-12-* widgetDefault
29
30# must use this name -- plugs into Rappture::resources::load
31proc MapViewer_init_resources {} {
32    Rappture::resources::register \
33        geovis_server Rappture::MapViewer::SetServerList
34}
35
36itcl::class Rappture::MapViewer {
37    inherit Rappture::VisViewer
38
39    itk_option define -plotforeground plotForeground Foreground ""
40    itk_option define -plotbackground plotBackground Background ""
41
42    private variable _layers "";        # Name of layers tab widget
43    private variable _mapsettings;      # Global map settings
44
45    constructor { hostlist args } {
46        Rappture::VisViewer::constructor $hostlist
47    } {
48        # defined below
49    }
50    destructor {
51        # defined below
52    }
53    public proc SetServerList { namelist } {
54        Rappture::VisViewer::SetServerList "geovis" $namelist
55    }
56    public method add {dataobj {settings ""}}
57    public method camera {option args}
58    public method delete {args}
59    public method disconnect {}
60    public method download {option args}
61    public method get {args}
62    public method isconnected {}
63    public method limits { colormap }
64    public method parameters {title args} {
65        # do nothing
66    }
67    public method scale {args}
68
69    protected method Connect {}
70    protected method CurrentDatasets {args}
71    protected method Disconnect {}
72    protected method DoResize {}
73    protected method DoRotate {}
74    protected method AdjustSetting {what {value ""}}
75    protected method FixSettings { args  }
76    protected method KeyPress { key }
77    protected method KeyRelease { key }
78    protected method MouseClick { button x y }
79    protected method MouseDoubleClick { button x y }
80    protected method MouseDrag { button x y }
81    protected method MouseMotion {}
82    protected method MouseRelease { button x y }
83    protected method MouseScroll { direction }
84    protected method Pan {option x y}
85    protected method Pick {x y}
86    protected method Rebuild {}
87    protected method ReceiveDataset { args }
88    protected method ReceiveImage { args }
89    protected method Rotate {option x y}
90    protected method Zoom {option}
91
92    # The following methods are only used by this class.
93    private method UpdateLayerControls {}
94    private method ChangeLayerVisibility { dataobj layer }
95    private method BuildCameraTab {}
96    private method BuildLayerTab {}
97    private method BuildDownloadPopup { widget command }
98    private method BuildTerrainTab {}
99    private method EventuallyResize { w h }
100    private method EventuallyHandleMotionEvent { x y }
101    private method EventuallyRotate { q }
102    private method GetImage { args }
103    private method PanCamera {}
104    private method SetObjectStyle { dataobj layer }
105    private method SetOpacity { dataset }
106    private method SetOrientation { side }
107
108    private variable _arcball ""
109    private variable _dlist "";         # list of data objects
110    private variable _obj2datasets
111    private variable _obj2ovride;       # maps dataobj => style override
112    private variable _datasets;         # contains all the dataobj-component
113                                        # datasets in the server
114    private variable _click;            # info used for rotate operations
115    private variable _limits;           # autoscale min/max for all axes
116    private variable _view;             # view params for 3D view
117    private variable _settings
118    private variable _visibility
119    private variable _style;            # Array of current component styles.
120    private variable _initialStyle;     # Array of initial component styles.
121    private variable _reset 1;          # Indicates that server was reset and
122                                        # needs to be reinitialized.
123    private variable _haveTerrain 0
124
125    private variable _first ""     ;# This is the topmost dataset.
126    private variable _start 0
127    private variable _title ""
128
129    common _downloadPopup          ;# download options from popup
130    private common _hardcopy
131    private variable _width 0
132    private variable _height 0
133    private variable _resizePending 0
134    private variable _rotatePending 0
135    private variable _rotateDelay 150
136    private variable _scaleDelay 100
137    private variable _motion
138}
139
140itk::usual MapViewer {
141    keep -background -foreground -cursor -font
142    keep -plotbackground -plotforeground
143}
144
145# ----------------------------------------------------------------------
146# CONSTRUCTOR
147# ----------------------------------------------------------------------
148itcl::body Rappture::MapViewer::constructor {hostlist args} {
149    set _serverType "geovis"
150
151    if { [catch {
152       
153    # Rebuild event
154    $_dispatcher register !rebuild
155    $_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
156
157    # Resize event
158    $_dispatcher register !resize
159    $_dispatcher dispatch $this !resize "[itcl::code $this DoResize]; list"
160
161    # Rotate event
162    $_dispatcher register !rotate
163    $_dispatcher dispatch $this !rotate "[itcl::code $this DoRotate]; list"
164
165    # <Motion> event
166    $_dispatcher register !motion
167    $_dispatcher dispatch $this !motion "[itcl::code $this MouseMotion]; list"
168
169    #
170    # Populate parser with commands handle incoming requests
171    #
172    $_parser alias image    [itcl::code $this ReceiveImage]
173    $_parser alias dataset  [itcl::code $this ReceiveDataset]
174
175    array set _motion {
176        x               0
177        y               0
178        pending         0
179        delay           100
180        compress        0
181    }
182    # Initialize the view to some default parameters.
183    array set _view {
184        qw              1.0
185        qx              0.0
186        qy              0.0
187        qz              0.0
188        zoom            1.0
189        xpan            0.0
190        ypan            0.0
191    }
192    set _arcball [blt::arcball create 100 100]
193    set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
194    $_arcball quaternion $q
195
196    set _limits(zmin) 0.0
197    set _limits(zmax) 1.0
198
199    array set _settings [subst {
200        legend                 1
201        terrain-edges          0
202        terrain-lighting       0
203        terrain-vertscale      1.0
204        terrain-wireframe      0
205    }]
206    itk_component add view {
207        canvas $itk_component(plotarea).view \
208            -highlightthickness 0 -borderwidth 0
209    } {
210        usual
211        ignore -highlightthickness -borderwidth  -background
212    }
213
214    set c $itk_component(view)
215    bind $c <KeyPress-Left>  [list %W xview scroll 10 units]
216    bind $c <KeyPress-Right> [list %W xview scroll -10 units]
217    bind $c <KeyPress-Up>    [list %W yview scroll 10 units]
218    bind $c <KeyPress-Down>  [list %W yview scroll -10 units]
219    bind $c <Enter> "focus %W"
220    bind $c <Control-F1> [itcl::code $this ToggleConsole]
221
222    # Fix the scrollregion in case we go off screen
223    $c configure -scrollregion [$c bbox all]
224
225    set _map(id) [$c create image 0 0 -anchor nw -image $_image(plot)]
226    set _map(cwidth) -1
227    set _map(cheight) -1
228    set _map(zoom) 1.0
229    set _map(original) ""
230
231    set f [$itk_component(main) component controls]
232    itk_component add reset {
233        button $f.reset -borderwidth 1 -padx 1 -pady 1 \
234            -highlightthickness 0 \
235            -image [Rappture::icon reset-view] \
236            -command [itcl::code $this Zoom reset]
237    } {
238        usual
239        ignore -highlightthickness
240    }
241    pack $itk_component(reset) -side top -padx 2 -pady 2
242    Rappture::Tooltip::for $itk_component(reset) \
243        "Reset the view to the default zoom level"
244
245    itk_component add zoomin {
246        button $f.zin -borderwidth 1 -padx 1 -pady 1 \
247            -highlightthickness 0 \
248            -image [Rappture::icon zoom-in] \
249            -command [itcl::code $this Zoom in]
250    } {
251        usual
252        ignore -highlightthickness
253    }
254    pack $itk_component(zoomin) -side top -padx 2 -pady 2
255    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
256
257    itk_component add zoomout {
258        button $f.zout -borderwidth 1 -padx 1 -pady 1 \
259            -highlightthickness 0 \
260            -image [Rappture::icon zoom-out] \
261            -command [itcl::code $this Zoom out]
262    } {
263        usual
264        ignore -highlightthickness
265    }
266    pack $itk_component(zoomout) -side top -padx 2 -pady 2
267    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
268
269    BuildLayerTab
270    BuildCameraTab
271
272    # Legend
273
274    set _image(legend) [image create photo]
275    itk_component add legend {
276        canvas $itk_component(plotarea).legend -width 50 -highlightthickness 0
277    } {
278        usual
279        ignore -highlightthickness
280        rename -background -plotbackground plotBackground Background
281    }
282
283    # Hack around the Tk panewindow.  The problem is that the requested
284    # size of the 3d view isn't set until an image is retrieved from
285    # the server.  So the panewindow uses the tiny size.
286    set w 10000
287    pack forget $itk_component(view)
288    blt::table $itk_component(plotarea) \
289        0,0 $itk_component(view) -fill both -reqwidth $w
290    blt::table configure $itk_component(plotarea) c1 -resize none
291
292    # Bindings for keyboard events
293    bind $itk_component(view) <KeyPress> \
294        [itcl::code $this KeyPress %N]
295    bind $itk_component(view) <KeyRelease> \
296        [itcl::code $this KeyRelease %N]
297
298    # Bindings for rotation via mouse
299    bind $itk_component(view) <ButtonPress-1> \
300        [itcl::code $this MouseClick 1 %x %y]
301        #[itcl::code $this Rotate click %x %y]
302    bind $itk_component(view) <Double-1> \
303        [itcl::code $this MouseDoubleClick 1 %x %y]
304    bind $itk_component(view) <B1-Motion> \
305        [itcl::code $this MouseDrag 1 %x %y]
306        #[itcl::code $this Rotate drag %x %y]
307    bind $itk_component(view) <ButtonRelease-1> \
308        [itcl::code $this MouseRelease 1 %x %y]
309        #[itcl::code $this Rotate release %x %y]
310    bind $itk_component(view) <Configure> \
311        [itcl::code $this EventuallyResize %w %h]
312
313    # Bindings for panning via mouse
314    bind $itk_component(view) <ButtonPress-2> \
315        [itcl::code $this MouseClick 2 %x %y]
316        #[itcl::code $this Pan click %x %y]
317    bind $itk_component(view) <Double-2> \
318        [itcl::code $this MouseDoubleClick 2 %x %y]
319    bind $itk_component(view) <B2-Motion> \
320        [itcl::code $this MouseDrag 2 %x %y]
321        #[itcl::code $this Pan drag %x %y]
322    bind $itk_component(view) <ButtonRelease-2> \
323        [itcl::code $this MouseRelease 2 %x %y]
324        #[itcl::code $this Pan release %x %y]
325
326    bind $itk_component(view) <ButtonPress-3> \
327        [itcl::code $this MouseClick 3 %x %y]
328    bind $itk_component(view) <Double-3> \
329        [itcl::code $this MouseDoubleClick 3 %x %y]
330    bind $itk_component(view) <B3-Motion> \
331        [itcl::code $this MouseDrag 3 %x %y]
332    bind $itk_component(view) <ButtonRelease-3> \
333        [itcl::code $this MouseRelease 3 %x %y]
334
335    bind $itk_component(view) <Motion> \
336        [itcl::code $this EventuallyHandleMotionEvent %x %y]
337
338    # Bindings for panning via keyboard
339    bind $itk_component(view) <KeyPress-Left> \
340        [itcl::code $this Pan set -10 0]
341    bind $itk_component(view) <KeyPress-Right> \
342        [itcl::code $this Pan set 10 0]
343    bind $itk_component(view) <KeyPress-Up> \
344        [itcl::code $this Pan set 0 -10]
345    bind $itk_component(view) <KeyPress-Down> \
346        [itcl::code $this Pan set 0 10]
347    bind $itk_component(view) <Shift-KeyPress-Left> \
348        [itcl::code $this Pan set -2 0]
349    bind $itk_component(view) <Shift-KeyPress-Right> \
350        [itcl::code $this Pan set 2 0]
351    bind $itk_component(view) <Shift-KeyPress-Up> \
352        [itcl::code $this Pan set 0 -2]
353    bind $itk_component(view) <Shift-KeyPress-Down> \
354        [itcl::code $this Pan set 0 2]
355
356    # Bindings for zoom via keyboard
357    bind $itk_component(view) <KeyPress-Prior> \
358        [itcl::code $this Zoom out]
359    bind $itk_component(view) <KeyPress-Next> \
360        [itcl::code $this Zoom in]
361
362    bind $itk_component(view) <Enter> "focus $itk_component(view)"
363
364    if {[string equal "x11" [tk windowingsystem]]} {
365        # Bindings for zoom via mouse
366        #bind $itk_component(view) <4> [itcl::code $this Zoom out]
367        #bind $itk_component(view) <5> [itcl::code $this Zoom in]
368        bind $itk_component(view) <4> [itcl::code $this MouseScroll up]
369        bind $itk_component(view) <5> [itcl::code $this MouseScroll down]
370    }
371
372    set _image(download) [image create photo]
373
374    eval itk_initialize $args
375    Connect
376} errs] != 0 } {
377        puts stderr errs=$errs
378    }
379}
380
381# ----------------------------------------------------------------------
382# DESTRUCTOR
383# ----------------------------------------------------------------------
384itcl::body Rappture::MapViewer::destructor {} {
385    Disconnect
386    $_dispatcher cancel !rebuild
387    $_dispatcher cancel !resize
388    $_dispatcher cancel !rotate
389    image delete $_image(plot)
390    image delete $_image(download)
391    catch { blt::arcball destroy $_arcball }
392}
393
394itcl::body Rappture::MapViewer::DoResize {} {
395    set sendResize 1
396    if { $_width < 2 } {
397        set _width 500
398        set sendResize 0
399    }
400    if { $_height < 2 } {
401        set _height 500
402        set sendResize 0
403    }
404    set _start [clock clicks -milliseconds]
405    if {$sendResize} {
406        SendCmd "screen size $_width $_height"
407    }
408    set _resizePending 0
409}
410
411itcl::body Rappture::MapViewer::DoRotate {} {
412    set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
413    SendCmd "camera orient $q"
414    set _rotatePending 0
415}
416
417itcl::body Rappture::MapViewer::EventuallyResize { w h } {
418    set _width $w
419    set _height $h
420    $_arcball resize $w $h
421    if { !$_resizePending } {
422        set _resizePending 1
423        $_dispatcher event -after 200 !resize
424    }
425}
426
427itcl::body Rappture::MapViewer::EventuallyRotate { q } {
428    foreach { _view(qw) _view(qx) _view(qy) _view(qz) } $q break
429    if { !$_rotatePending } {
430        set _rotatePending 1
431        $_dispatcher event -after $_rotateDelay !rotate
432    }
433}
434
435# ----------------------------------------------------------------------
436# USAGE: add <dataobj> ?<settings>?
437#
438# Clients use this to add a data object to the plot.  The optional
439# <settings> are used to configure the plot.  Allowed settings are
440# -color, -brightness, -width, -linestyle, and -raise.
441# ----------------------------------------------------------------------
442itcl::body Rappture::MapViewer::add {dataobj {settings ""}} {
443    array set params {
444        -color auto
445        -width 1
446        -linestyle solid
447        -brightness 0
448        -raise 0
449        -description ""
450        -param ""
451        -type ""
452    }
453    array set params $settings
454    set params(-description) ""
455    set params(-param) ""
456    array set params $settings
457
458    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
459        # can't handle -autocolors yet
460        set params(-color) black
461    }
462    set pos [lsearch -exact $_dlist $dataobj]
463    if {$pos < 0} {
464        #if {[llength $_dlist] > 0} {
465        #    error "Can't add more than 1 map to mapviewer"
466        #}
467        lappend _dlist $dataobj
468    }
469    set _obj2ovride($dataobj-color) $params(-color)
470    set _obj2ovride($dataobj-width) $params(-width)
471    set _obj2ovride($dataobj-raise) $params(-raise)
472    $_dispatcher event -idle !rebuild
473}
474
475# ----------------------------------------------------------------------
476# USAGE: delete ?<dataobj1> <dataobj2> ...?
477#
478#       Clients use this to delete a dataobj from the plot.  If no dataobjs
479#       are specified, then all dataobjs are deleted.  No data objects are
480#       deleted.  They are only removed from the display list.
481#
482# ----------------------------------------------------------------------
483itcl::body Rappture::MapViewer::delete {args} {
484    if { [llength $args] == 0} {
485        set args $_dlist
486    }
487    # Delete all specified dataobjs
488    set changed 0
489    foreach dataobj $args {
490        set pos [lsearch -exact $_dlist $dataobj]
491        if { $pos < 0 } {
492            continue;                   # Don't know anything about it.
493        }
494        # When a map is marked deleted, we hide its layers.
495        foreach layer [$dataobj layers] {
496            set tag $dataobj-$layer
497            SendCmd "map layer visible 0 $tag"
498            set _visibility($tag) 0
499        }
500        # Remove it from the dataobj list.
501        set _dlist [lreplace $_dlist $pos $pos]
502        array unset _obj2ovride $dataobj-*
503        array unset _settings $dataobj-*
504        set changed 1
505    }
506    # If anything changed, then rebuild the plot
507    if { $changed } {
508        $_dispatcher event -idle !rebuild
509    }
510}
511
512# ----------------------------------------------------------------------
513# USAGE: get ?-objects?
514# USAGE: get ?-visible?
515# USAGE: get ?-image view?
516#
517# Clients use this to query the list of objects being plotted, in
518# order from bottom to top of this result.  The optional "-image"
519# flag can also request the internal images being shown.
520# ----------------------------------------------------------------------
521itcl::body Rappture::MapViewer::get {args} {
522    if {[llength $args] == 0} {
523        set args "-objects"
524    }
525
526    set op [lindex $args 0]
527    switch -- $op {
528        "-objects" {
529            # put the dataobj list in order according to -raise options
530            set dlist {}
531            foreach dataobj $_dlist {
532                if { ![$dataobj isvalid] } {
533                    continue
534                }
535                if {[info exists _obj2ovride($dataobj-raise)] &&
536                    $_obj2ovride($dataobj-raise)} {
537                    set dlist [linsert $dlist 0 $dataobj]
538                } else {
539                    lappend dlist $dataobj
540                }
541            }
542            return $dlist
543        }
544        "-visible" {
545            set dlist {}
546            foreach dataobj $_dlist {
547                if { ![$dataobj isvalid] } {
548                    continue
549                }
550                if { ![info exists _obj2ovride($dataobj-raise)] } {
551                    # No setting indicates that the object isn't visible.
552                    continue
553                }
554                # Otherwise use the -raise parameter to put the object to
555                # the front of the list.
556                if { $_obj2ovride($dataobj-raise) } {
557                    set dlist [linsert $dlist 0 $dataobj]
558                } else {
559                    lappend dlist $dataobj
560                }
561            }
562            return $dlist
563        }           
564        -image {
565            if {[llength $args] != 2} {
566                error "wrong # args: should be \"get -image view\""
567            }
568            switch -- [lindex $args end] {
569                view {
570                    return $_image(plot)
571                }
572                default {
573                    error "bad image name \"[lindex $args end]\": should be view"
574                }
575            }
576        }
577        default {
578            error "bad option \"$op\": should be -objects or -image"
579        }
580    }
581}
582
583# ----------------------------------------------------------------------
584# USAGE: scale ?<data1> <data2> ...?
585#
586# Sets the default limits for the overall plot according to the
587# limits of the data for all of the given <data> objects.  This
588# accounts for all objects--even those not showing on the screen.
589# Because of this, the limits are appropriate for all objects as
590# the user scans through data in the ResultSet viewer.
591# ----------------------------------------------------------------------
592itcl::body Rappture::MapViewer::scale {args} {
593    array unset _mapsettings
594
595    # Verify that all the maps have the same global settings. For example,
596    # you can't have one map type "geocentric" and the other "projected".
597
598    foreach dataobj $args {
599        if { ![$dataobj isvalid] } {
600            continue
601        }
602        array unset hints
603        array set hints [$dataobj hints]
604        if { ![info exists overall(type)] } {
605            set _mapsettings(type) $hints(type)
606        } elseif { $hints(type) != $_mapsettings(type) } {
607            error "maps \"$hints(label)\" have differing types"
608        }
609        if { ![info exists _mapsettings(projection)] } {
610            set _mapsettings(projection) $hints(projection)
611        } elseif { $hints(projection) != $_mapsettings(projection) } {
612            error "maps \"$hints(label)\" have differing projections"
613        }
614        if { ![info exists _mapsettings(extents)] } {
615            set _mapsettings(extents) $hints(extents)
616        } elseif { $hints(extents) != $_mapsettings(extents) } {
617            error "maps \"$hints(label)\" have differing extents"
618        }
619
620        foreach layer [$dataobj layers] {
621            set type [$dataobj layer $layer]
622            switch -- $type {
623                "elevation" {
624                    set _haveTerrain 1
625                }
626            }
627        }
628    }
629    if { $_haveTerrain } {
630        if { ![$itk_component(main) exists "Terrain Settings"] } {
631            if { [catch { BuildTerrainTab } errs ]  != 0 } {
632                puts stderr "errs=$errs"
633            }
634        }
635    }
636}
637
638# ----------------------------------------------------------------------
639# USAGE: download coming
640# USAGE: download controls <downloadCommand>
641# USAGE: download now
642#
643# Clients use this method to create a downloadable representation
644# of the plot.  Returns a list of the form {ext string}, where
645# "ext" is the file extension (indicating the type of data) and
646# "string" is the data itself.
647# ----------------------------------------------------------------------
648itcl::body Rappture::MapViewer::download {option args} {
649    switch $option {
650        coming {
651            if {[catch {
652                blt::winop snap $itk_component(plotarea) $_image(download)
653            }]} {
654                $_image(download) configure -width 1 -height 1
655                $_image(download) put #000000
656            }
657        }
658        controls {
659            set popup .mapviewerdownload
660            if { ![winfo exists .mapviewerdownload] } {
661                set inner [BuildDownloadPopup $popup [lindex $args 0]]
662            } else {
663                set inner [$popup component inner]
664            }
665            set _downloadPopup(image_controls) $inner.image_frame
666            set num [llength [get]]
667            set num [expr {($num == 1) ? "1 result" : "$num results"}]
668            set word [Rappture::filexfer::label downloadWord]
669            $inner.summary configure -text "$word $num in the following format:"
670            update idletasks            ;# Fix initial sizes
671            return $popup
672        }
673        now {
674            set popup .mapviewerdownload
675            if {[winfo exists .mapviewerdownload]} {
676                $popup deactivate
677            }
678            switch -- $_downloadPopup(format) {
679                "image" {
680                    return [$this GetImage [lindex $args 0]]
681                }
682            }
683            return ""
684        }
685        default {
686            error "bad option \"$option\": should be coming, controls, now"
687        }
688    }
689}
690
691# ----------------------------------------------------------------------
692# USAGE: Connect ?<host:port>,<host:port>...?
693#
694# Clients use this method to establish a connection to a new
695# server, or to reestablish a connection to the previous server.
696# Any existing connection is automatically closed.
697# ----------------------------------------------------------------------
698itcl::body Rappture::MapViewer::Connect {} {
699    global readyForNextFrame
700    set readyForNextFrame 1
701    set _hosts [GetServerList "geovis"]
702    if { "" == $_hosts } {
703        return 0
704    }
705    set result [VisViewer::Connect $_hosts]
706    if { $result } {
707        if { $_reportClientInfo }  {
708            # Tell the server the viewer, hub, user and session.
709            # Do this immediately on connect before buffering any commands
710            global env
711
712            set info {}
713            set user "???"
714            if { [info exists env(USER)] } {
715                set user $env(USER)
716            }
717            set session "???"
718            if { [info exists env(SESSION)] } {
719                set session $env(SESSION)
720            }
721            lappend info "hub" [exec hostname]
722            lappend info "client" "mapviewer"
723            lappend info "user" $user
724            lappend info "session" $session
725            SendCmd "clientinfo [list $info]"
726        }
727
728        set w [winfo width $itk_component(view)]
729        set h [winfo height $itk_component(view)]
730        EventuallyResize $w $h
731    }
732    return $result
733}
734
735#
736# isconnected --
737#
738#       Indicates if we are currently connected to the visualization server.
739#
740itcl::body Rappture::MapViewer::isconnected {} {
741    return [VisViewer::IsConnected]
742}
743
744#
745# disconnect --
746#
747itcl::body Rappture::MapViewer::disconnect {} {
748    Disconnect
749    set _reset 1
750}
751
752#
753# Disconnect --
754#
755#       Clients use this method to disconnect from the current rendering
756#       server.
757#
758itcl::body Rappture::MapViewer::Disconnect {} {
759    VisViewer::Disconnect
760
761    # disconnected -- no more data sitting on server
762    array unset _datasets
763    global readyForNextFrame
764    set readyForNextFrame 1
765}
766
767# ----------------------------------------------------------------------
768# USAGE: ReceiveImage -bytes <size> -type <type> -token <token>
769#
770# Invoked automatically whenever the "image" command comes in from
771# the rendering server.  Indicates that binary image data with the
772# specified <size> will follow.
773# ----------------------------------------------------------------------
774itcl::body Rappture::MapViewer::ReceiveImage { args } {
775    global readyForNextFrame
776    set readyForNextFrame 1
777    array set info {
778        -token "???"
779        -bytes 0
780        -type image
781    }
782    array set info $args
783    set bytes [ReceiveBytes $info(-bytes)]
784    if { $info(-type) == "image" } {
785        $_image(plot) configure -data $bytes
786    } elseif { $info(type) == "print" } {
787        set tag $this-print-$info(-token)
788        set _hardcopy($tag) $bytes
789    }
790}
791
792#
793# ReceiveDataset --
794#
795itcl::body Rappture::MapViewer::ReceiveDataset { args } {
796    if { ![isconnected] } {
797        return
798    }
799    set option [lindex $args 0]
800    switch -- $option {
801        "coords" {
802            foreach { x y z } [lrange $args 1 end] break
803            puts stderr "Coords: $x $y $z"
804        }
805        "scalar" {
806            set option [lindex $args 1]
807            switch -- $option {
808                "world" {
809                    foreach { x y z value tag } [lrange $args 2 end] break
810                }
811                "pixel" {
812                    foreach { x y value tag } [lrange $args 2 end] break
813                }
814            }
815        }
816        "vector" {
817            set option [lindex $args 1]
818            switch -- $option {
819                "world" {
820                    foreach { x y z vx vy vz tag } [lrange $args 2 end] break
821                }
822                "pixel" {
823                    foreach { x y vx vy vz tag } [lrange $args 2 end] break
824                }
825            }
826        }
827        "names" {
828            foreach { name } [lindex $args 1] {
829                #puts stderr "Dataset: $name"
830            }
831        }
832        default {
833            error "unknown dataset option \"$option\" from server"
834        }
835    }
836}
837
838# ----------------------------------------------------------------------
839# USAGE: Rebuild
840#
841# Called automatically whenever something changes that affects the
842# data in the widget.  Clears any existing data and rebuilds the
843# widget to display new data.
844# ----------------------------------------------------------------------
845itcl::body Rappture::MapViewer::Rebuild {} {
846
847    set w [winfo width $itk_component(view)]
848    set h [winfo height $itk_component(view)]
849    if { $w < 2 || $h < 2 } {
850        $_dispatcher event -idle !rebuild
851        return
852    }
853
854    # Turn on buffering of commands to the server.  We don't want to be
855    # preempted by a server disconnect/reconnect (which automatically
856    # generates a new call to Rebuild).
857    StartBufferingCommands
858
859    if { $_reset } {
860        set _width $w
861        set _height $h
862        $_arcball resize $w $h
863        DoResize
864
865        if { [info exists _mapsettings(type)] } {
866
867            # The map must be reset once before any layers are added This
868            # should not be done more than once as it is very expensive.
869
870            if { $_mapsettings(type) == "geocentric" } {
871                SendCmd "map reset geocentric"
872            } else {
873                if { $_mapsettings(extents) == ""} {
874                    SendCmd "map reset projected global-mercator"
875                } else {
876                    SendCmd \
877        "map reset projected $_mapsettings(projection) $_mapsettings(extents)"
878                }
879            }
880            if { $_haveTerrain } {
881                FixSettings terrain-edges terrain-lighting terrain-vertscale \
882                    terrain-wireframe
883            }
884            SendCmd "imgflush"
885        }
886    }
887
888    set _limits(zmin) ""
889    set _limits(zmax) ""
890    set _first ""
891    set count 0
892
893    foreach dataobj [get -objects] {
894        set _obj2datasets($dataobj) ""
895        foreach layer [$dataobj layers] {
896            array unset info
897            array set info [$dataobj layer $layer]
898            set tag $dataobj-$layer
899            if { ![info exists _datasets($tag)] } {
900                if { ![info exists info(url)] }  {
901                    continue
902                }
903                # FIXME: wms, tms layers have additional options
904                switch -- $info(type) {
905                    "raster" {
906                        set type "image"
907                    }
908                    default {
909                        set type "$info(type)"
910                    }
911                }
912                if { $_reportClientInfo }  {
913                    set cinfo {}
914                    lappend cinfo "tool_id"       [$dataobj hints toolId]
915                    lappend cinfo "tool_name"     [$dataobj hints toolName]
916                    lappend cinfo "tool_version"  [$dataobj hints toolRevision]
917                    lappend cinfo "tool_title"    [$dataobj hints toolTitle]
918                    lappend cinfo "dataset_label" [$dataobj hints label]
919                    lappend cinfo "dataset_tag"   $tag
920                    SendCmd [list "clientinfo" $cinfo]
921                }
922                SendCmd [list map layer add $type $info(url) $tag]
923                set _datasets($tag) 1
924                SetObjectStyle $dataobj $layer
925            }
926            lappend _obj2datasets($dataobj) $tag
927            if { [info exists _obj2ovride($dataobj-raise)] } {
928                SendCmd "map layer visible 1 $tag"
929                set _visibility($tag) 1
930                #SetLayerOpacity $tag
931            }
932        }
933    }
934    if {"" != $_first} {
935        set location [$_first hints camera]
936        if { $location != "" } {
937            array set view $location
938        }
939    }
940    if { $_reset } {
941        set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
942        $_arcball quaternion $q
943        SendCmd "camera reset"
944        DoRotate
945        PanCamera
946        Zoom reset
947    }
948    UpdateLayerControls
949    set _reset 0
950    global readyForNextFrame
951    set readyForNextFrame 0;            # Don't advance to the next frame
952                                        # until we get an image.
953
954    # Actually write the commands to the server socket.  If it fails, we
955    # don't care.  We're finished here.
956    blt::busy hold $itk_component(hull)
957    StopBufferingCommands
958    blt::busy release $itk_component(hull)
959}
960
961# ----------------------------------------------------------------------
962# USAGE: CurrentDatasets ?-all -visible? ?dataobjs?
963#
964# Returns a list of server IDs for the current datasets being displayed.
965# This is normally a single ID, but it might be a list of IDs if the
966# current data object has multiple components.
967# ----------------------------------------------------------------------
968itcl::body Rappture::MapViewer::CurrentDatasets {args} {
969    set flag [lindex $args 0]
970    switch -- $flag {
971        "-all" {
972            if { [llength $args] > 1 } {
973                error "CurrentDatasets: can't specify dataobj after \"-all\""
974            }
975            set dlist [get -objects]
976        }
977        "-visible" {
978            if { [llength $args] > 1 } {
979                set dlist {}
980                set args [lrange $args 1 end]
981                foreach dataobj $args {
982                    if { [info exists _obj2ovride($dataobj-raise)] } {
983                        lappend dlist $dataobj
984                    }
985                }
986            } else {
987                set dlist [get -visible]
988            }
989        }           
990        default {
991            set dlist $args
992        }
993    }
994    set rlist ""
995    foreach dataobj $dlist {
996        foreach layer [$dataobj layers] {
997            set tag $dataobj-$layer
998            if { [info exists _datasets($tag)] && $_datasets($tag) } {
999                lappend rlist $tag
1000            }
1001        }
1002    }
1003    return $rlist
1004}
1005
1006itcl::body Rappture::MapViewer::KeyPress {k} {
1007    SendCmd "key press $k"
1008}
1009
1010itcl::body Rappture::MapViewer::KeyRelease {k} {
1011    SendCmd "key release $k"
1012}
1013
1014itcl::body Rappture::MapViewer::MouseClick {button x y} {
1015    if {0} {
1016    set w [winfo width $itk_component(view)]
1017    set h [winfo height $itk_component(view)]
1018    set x [expr {(2.0 * double($x)/$w) - 1.0}]
1019    set y [expr {(2.0 * double($y)/$h) - 1.0}]
1020    }
1021    SendCmd "mouse click $button $x $y"
1022}
1023
1024itcl::body Rappture::MapViewer::MouseDoubleClick {button x y} {
1025    if {0} {
1026    set w [winfo width $itk_component(view)]
1027    set h [winfo height $itk_component(view)]
1028    set x [expr {(2.0 * double($x)/$w) - 1.0}]
1029    set y [expr {(2.0 * double($y)/$h) - 1.0}]
1030    }
1031    SendCmd "mouse dblclick $button $x $y"
1032}
1033
1034itcl::body Rappture::MapViewer::MouseDrag {button x y} {
1035    if {0} {
1036    set w [winfo width $itk_component(view)]
1037    set h [winfo height $itk_component(view)]
1038    set x [expr {(2.0 * double($x)/$w) - 1.0}]
1039    set y [expr {(2.0 * double($y)/$h) - 1.0}]
1040    }
1041    SendCmd "mouse drag $button $x $y"
1042}
1043
1044itcl::body Rappture::MapViewer::MouseRelease {button x y} {
1045    if {0} {
1046    set w [winfo width $itk_component(view)]
1047    set h [winfo height $itk_component(view)]
1048    set x [expr {(2.0 * double($x)/$w) - 1.0}]
1049    set y [expr {(2.0 * double($y)/$h) - 1.0}]
1050    }
1051    SendCmd "mouse release $button $x $y"
1052}
1053
1054#
1055# EventuallyHandleMotionEvent --
1056#
1057#       This routine compresses (no button press) motion events.  It
1058#       delivers a server mouse command once every 100 milliseconds (if a
1059#       motion event is pending).
1060#
1061itcl::body Rappture::MapViewer::EventuallyHandleMotionEvent {x y} {
1062    set _motion(x) $x
1063    set _motion(y) $y
1064    if { !$_motion(compress) } {
1065        MouseMotion
1066        return
1067    }
1068    if { !$_motion(pending) } {
1069        set _motion(pending) 1
1070        $_dispatcher event -after $_motion(delay) !motion
1071    }
1072}
1073
1074itcl::body Rappture::MapViewer::MouseMotion {} {
1075    if {0} {
1076    set w [winfo width $itk_component(view)]
1077    set h [winfo height $itk_component(view)]
1078    set x [expr {(2.0 * double($_motion(x))/$w) - 1.0}]
1079    set y [expr {(2.0 * double($_motion(y))/$h) - 1.0}]
1080    }
1081    SendCmd "mouse motion $_motion(x) $_motion(y)"
1082    set _motion(pending) 0
1083}
1084
1085itcl::body Rappture::MapViewer::MouseScroll {direction} {
1086    switch -- $direction {
1087        "up" {
1088            SendCmd "mouse scroll 1"
1089        }
1090        "down" {
1091            SendCmd "mouse scroll -1"
1092        }
1093    }
1094}
1095
1096# ----------------------------------------------------------------------
1097# USAGE: Zoom in
1098# USAGE: Zoom out
1099# USAGE: Zoom reset
1100#
1101# Called automatically when the user clicks on one of the zoom
1102# controls for this widget.  Changes the zoom for the current view.
1103# ----------------------------------------------------------------------
1104itcl::body Rappture::MapViewer::Zoom {option} {
1105    switch -- $option {
1106        "in" {
1107            set _view(zoom) [expr {$_view(zoom)*1.25}]
1108            #SendCmd "camera zoom $_view(zoom)"
1109            set z -0.25
1110            SendCmd "camera zoom $z"
1111        }
1112        "out" {
1113            set _view(zoom) [expr {$_view(zoom)*0.8}]
1114            #SendCmd "camera zoom $_view(zoom)"
1115            set z 0.25
1116            SendCmd "camera zoom $z"
1117        }
1118        "reset" {
1119            array set _view {
1120                qw      1.0
1121                qx      0.0
1122                qy      0.0
1123                qz      0.0
1124                zoom    1.0
1125                xpan    0.0
1126                ypan    0.0
1127            }
1128            if { $_first != "" } {
1129                set location [$_first hints camera]
1130                if { $location != "" } {
1131                    array set _view $location
1132                }
1133            }
1134            set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
1135            $_arcball quaternion $q
1136            DoRotate
1137            SendCmd "camera reset"
1138        }
1139    }
1140}
1141
1142itcl::body Rappture::MapViewer::PanCamera {} {
1143    set x $_view(xpan)
1144    set y $_view(ypan)
1145    SendCmd "camera pan $x $y"
1146}
1147
1148# ----------------------------------------------------------------------
1149# USAGE: Rotate click <x> <y>
1150# USAGE: Rotate drag <x> <y>
1151# USAGE: Rotate release <x> <y>
1152#
1153# Called automatically when the user clicks/drags/releases in the
1154# plot area.  Moves the plot according to the user's actions.
1155# ----------------------------------------------------------------------
1156itcl::body Rappture::MapViewer::Rotate {option x y} {
1157    switch -- $option {
1158        "click" {
1159            $itk_component(view) configure -cursor fleur
1160            set _click(x) $x
1161            set _click(y) $y
1162        }
1163        "drag" {
1164            if {[array size _click] == 0} {
1165                Rotate click $x $y
1166            } else {
1167                set w [winfo width $itk_component(view)]
1168                set h [winfo height $itk_component(view)]
1169                if {$w <= 0 || $h <= 0} {
1170                    return
1171                }
1172
1173                if {[catch {
1174                    # this fails sometimes for no apparent reason
1175                    set dx [expr {double($x-$_click(x))/$w}]
1176                    set dy [expr {double($y-$_click(y))/$h}]
1177                }]} {
1178                    return
1179                }
1180                if { $dx == 0 && $dy == 0 } {
1181                    return
1182                }
1183                set q [$_arcball rotate $x $y $_click(x) $_click(y)]
1184                EventuallyRotate $q
1185                set _click(x) $x
1186                set _click(y) $y
1187            }
1188        }
1189        "release" {
1190            Rotate drag $x $y
1191            $itk_component(view) configure -cursor ""
1192            catch {unset _click}
1193        }
1194        default {
1195            error "bad option \"$option\": should be click, drag, release"
1196        }
1197    }
1198}
1199
1200itcl::body Rappture::MapViewer::Pick {x y} {
1201    foreach tag [CurrentDatasets -visible] {
1202        SendCmd "dataset getscalar pixel $x $y $tag"
1203    }
1204}
1205
1206# ----------------------------------------------------------------------
1207# USAGE: $this Pan click x y
1208#        $this Pan drag x y
1209#        $this Pan release x y
1210#
1211# Called automatically when the user clicks on one of the zoom
1212# controls for this widget.  Changes the zoom for the current view.
1213# ----------------------------------------------------------------------
1214itcl::body Rappture::MapViewer::Pan {option x y} {
1215    switch -- $option {
1216        "set" {
1217            set w [winfo width $itk_component(view)]
1218            set h [winfo height $itk_component(view)]
1219            set x [expr $x / double($w)]
1220            set y [expr $y / double($h)]
1221            set _view(xpan) [expr $_view(xpan) + $x]
1222            set _view(ypan) [expr $_view(ypan) + $y]
1223            PanCamera
1224            return
1225        }
1226        "click" {
1227            set _click(x) $x
1228            set _click(y) $y
1229            $itk_component(view) configure -cursor hand1
1230        }
1231        "drag" {
1232            if { ![info exists _click(x)] } {
1233                set _click(x) $x
1234            }
1235            if { ![info exists _click(y)] } {
1236                set _click(y) $y
1237            }
1238            set w [winfo width $itk_component(view)]
1239            set h [winfo height $itk_component(view)]
1240            set dx [expr ($_click(x) - $x)/double($w)]
1241            set dy [expr ($_click(y) - $y)/double($h)]
1242            set _click(x) $x
1243            set _click(y) $y
1244            set _view(xpan) [expr $_view(xpan) - $dx]
1245            set _view(ypan) [expr $_view(ypan) - $dy]
1246            PanCamera
1247        }
1248        "release" {
1249            Pan drag $x $y
1250            $itk_component(view) configure -cursor ""
1251        }
1252        default {
1253            error "unknown option \"$option\": should set, click, drag, or release"
1254        }
1255    }
1256}
1257
1258# ----------------------------------------------------------------------
1259# USAGE: FixSettings <what> ?<value>?
1260#
1261# Used internally to update rendering settings whenever parameters
1262# change in the popup settings panel.  Sends the new settings off
1263# to the back end.
1264# ----------------------------------------------------------------------
1265itcl::body Rappture::MapViewer::FixSettings { args } {
1266    foreach setting $args {
1267        AdjustSetting $setting
1268    }
1269}
1270
1271#
1272# AdjustSetting --
1273#
1274#       Changes/updates a specific setting in the widget.  There are
1275#       usually user-setable option.  Commands are sent to the render
1276#       server.
1277#
1278itcl::body Rappture::MapViewer::AdjustSetting {what {value ""}} {
1279    if { ![isconnected] } {
1280        return
1281    }
1282    switch -- $what {
1283        "terrain-edges" {
1284            set bool $_settings(terrain-edges)
1285            SendCmd "map terrain edges $bool"
1286        }
1287        "terrain-lighting" {
1288            set bool $_settings(terrain-lighting)
1289            SendCmd "map terrain lighting $bool"
1290        }
1291        "terrain-palette" {
1292            set cmap [$itk_component(terrainpalette) value]
1293            #SendCmd "map terrain colormap $cmap"
1294        }
1295        "terrain-vertscale" {
1296            set val $_settings(terrain-vertscale)
1297            SendCmd "map terrain vertscale $val"
1298        }
1299        "terrain-wireframe" {
1300            set bool $_settings(terrain-wireframe)
1301            SendCmd "map terrain wireframe $bool"
1302        }
1303        default {
1304            error "don't know how to fix $what"
1305        }
1306    }
1307}
1308
1309# ----------------------------------------------------------------------
1310# CONFIGURATION OPTION: -plotbackground
1311# ----------------------------------------------------------------------
1312itcl::configbody Rappture::MapViewer::plotbackground {
1313    if { [isconnected] } {
1314        foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break
1315        SendCmd "screen bgcolor $r $g $b"
1316    }
1317}
1318
1319# ----------------------------------------------------------------------
1320# CONFIGURATION OPTION: -plotforeground
1321# ----------------------------------------------------------------------
1322itcl::configbody Rappture::MapViewer::plotforeground {
1323    if { [isconnected] } {
1324        foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break
1325        #fix this!
1326        #SendCmd "color background $r $g $b"
1327    }
1328}
1329
1330itcl::body Rappture::MapViewer::limits { dataobj } {
1331    error "no limits"
1332    foreach layer [$dataobj layers] {
1333        set tag $dataobj-$layer
1334
1335        foreach { xMin xMax yMin yMax zMin zMax} $_limits($tag) break
1336        if {![info exists limits(xmin)] || $limits(xmin) > $xMin} {
1337            set limits(xmin) $xMin
1338        }
1339        if {![info exists limits(xmax)] || $limits(xmax) < $xMax} {
1340            set limits(xmax) $xMax
1341        }
1342        if {![info exists limits(ymin)] || $limits(ymin) > $yMin} {
1343            set limits(ymin) $xMin
1344        }
1345        if {![info exists limits(ymax)] || $limits(ymax) < $yMax} {
1346            set limits(ymax) $yMax
1347        }
1348        if {![info exists limits(zmin)] || $limits(zmin) > $zMin} {
1349            set limits(zmin) $zMin
1350        }
1351        if {![info exists limits(zmax)] || $limits(zmax) < $zMax} {
1352            set limits(zmax) $zMax
1353        }
1354    }
1355    return [array get limits]
1356}
1357
1358itcl::body Rappture::MapViewer::BuildTerrainTab {} {
1359
1360    set fg [option get $itk_component(hull) font Font]
1361    #set bfg [option get $itk_component(hull) boldFont Font]
1362
1363    set inner [$itk_component(main) insert end \
1364        -title "Terrain Settings" \
1365        -icon [Rappture::icon mesh]]
1366    $inner configure -borderwidth 4
1367
1368    checkbutton $inner.wireframe \
1369        -text "Show Wireframe" \
1370        -variable [itcl::scope _settings(terrain-wireframe)] \
1371        -command [itcl::code $this AdjustSetting terrain-wireframe] \
1372        -font "Arial 9" -anchor w
1373
1374    checkbutton $inner.lighting \
1375        -text "Enable Lighting" \
1376        -variable [itcl::scope _settings(terrain-lighting)] \
1377        -command [itcl::code $this AdjustSetting terrain-lighting] \
1378        -font "Arial 9" -anchor w
1379
1380    checkbutton $inner.edges \
1381        -text "Show Edges" \
1382        -variable [itcl::scope _settings(terrain-edges)] \
1383        -command [itcl::code $this AdjustSetting terrain-edges] \
1384        -font "Arial 9" -anchor w
1385
1386    label $inner.palette_l -text "Palette" -font "Arial 9" -anchor w
1387    itk_component add terrainpalette {
1388        Rappture::Combobox $inner.palette -width 10 -editable no
1389    }
1390    $inner.palette choices insert end \
1391        "BCGYR"              "BCGYR"            \
1392        "BGYOR"              "BGYOR"            \
1393        "blue"               "blue"             \
1394        "blue-to-brown"      "blue-to-brown"    \
1395        "blue-to-orange"     "blue-to-orange"   \
1396        "blue-to-grey"       "blue-to-grey"     \
1397        "green-to-magenta"   "green-to-magenta" \
1398        "greyscale"          "greyscale"        \
1399        "nanohub"            "nanohub"          \
1400        "rainbow"            "rainbow"          \
1401        "spectral"           "spectral"         \
1402        "ROYGB"              "ROYGB"            \
1403        "RYGCB"              "RYGCB"            \
1404        "brown-to-blue"      "brown-to-blue"    \
1405        "grey-to-blue"       "grey-to-blue"     \
1406        "orange-to-blue"     "orange-to-blue"   
1407
1408    $itk_component(terrainpalette) value "BCGYR"
1409    bind $inner.palette <<Value>> \
1410        [itcl::code $this AdjustSetting terrain-palette]
1411
1412    label $inner.vscale_l -text "Vertical Scale" -font "Arial 9" -anchor w
1413    ::scale $inner.vscale -from 0 -to 100 -orient horizontal \
1414        -variable [itcl::scope _settings(terrain-vertscale)] \
1415        -width 10 \
1416        -showvalue off \
1417        -command [itcl::code $this AdjustSetting terrain-vertscale]
1418    $inner.vscale set $_settings(terrain-vertscale)
1419
1420    blt::table $inner \
1421        0,0 $inner.wireframe -cspan 2  -anchor w -pady 2 \
1422        1,0 $inner.lighting  -cspan 2  -anchor w -pady 2 \
1423        2,0 $inner.edges     -cspan 2  -anchor w -pady 2 \
1424        4,0 $inner.vscale_l  -anchor w -pady 2 \
1425        4,1 $inner.vscale    -fill x   -pady 2 \
1426        5,0 $inner.palette_l -anchor w -pady 2 \
1427        5,1 $inner.palette   -fill x   -pady 2 
1428
1429    blt::table configure $inner r* c* -resize none
1430    blt::table configure $inner r7 c1 -resize expand
1431}
1432
1433itcl::body Rappture::MapViewer::BuildLayerTab {} {
1434
1435    set fg [option get $itk_component(hull) font Font]
1436    #set bfg [option get $itk_component(hull) boldFont Font]
1437
1438    set inner [$itk_component(main) insert end \
1439        -title "Layers" \
1440        -icon [Rappture::icon wrench]]
1441    $inner configure -borderwidth 4
1442    set f [frame $inner.layers]
1443    blt::table $inner \
1444        0,0 $f -fill both
1445    set _layers $inner
1446}
1447
1448itcl::body Rappture::MapViewer::BuildCameraTab {} {
1449    set inner [$itk_component(main) insert end \
1450        -title "Camera Settings" \
1451        -icon [Rappture::icon camera]]
1452    $inner configure -borderwidth 4
1453
1454    label $inner.view_l -text "view" -font "Arial 9"
1455    set f [frame $inner.view]
1456    foreach side { front back left right top bottom } {
1457        button $f.$side  -image [Rappture::icon view$side] \
1458            -command [itcl::code $this SetOrientation $side]
1459        Rappture::Tooltip::for $f.$side "Change the view to $side"
1460        pack $f.$side -side left
1461    }
1462
1463    blt::table $inner \
1464        0,0 $inner.view_l -anchor e -pady 2 \
1465        0,1 $inner.view -anchor w -pady 2
1466
1467    set labels { qx qy qz qw xpan ypan zoom }
1468    set row 1
1469    foreach tag $labels {
1470        label $inner.${tag}label -text $tag -font "Arial 9"
1471        entry $inner.${tag} -font "Arial 9"  -bg white \
1472            -textvariable [itcl::scope _view($tag)]
1473        bind $inner.${tag} <KeyPress-Return> \
1474            [itcl::code $this camera set ${tag}]
1475        blt::table $inner \
1476            $row,0 $inner.${tag}label -anchor e -pady 2 \
1477            $row,1 $inner.${tag} -anchor w -pady 2
1478        blt::table configure $inner r$row -resize none
1479        incr row
1480    }
1481
1482    blt::table configure $inner c* r* -resize none
1483    blt::table configure $inner c2 -resize expand
1484    blt::table configure $inner r$row -resize expand
1485}
1486
1487#
1488#  camera --
1489#
1490itcl::body Rappture::MapViewer::camera {option args} {
1491    switch -- $option {
1492        "show" {
1493            puts [array get _view]
1494        }
1495        "set" {
1496            set who [lindex $args 0]
1497            set x $_view($who)
1498            set code [catch { string is double $x } result]
1499            if { $code != 0 || !$result } {
1500                return
1501            }
1502            switch -- $who {
1503                "xpan" - "ypan" {
1504                    PanCamera
1505                }
1506                "qx" - "qy" - "qz" - "qw" {
1507                    set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
1508                    $_arcball quaternion $q
1509                    EventuallyRotate $q
1510                }
1511                "zoom" {
1512                    SendCmd "camera zoom $_view(zoom)"
1513                }
1514            }
1515        }
1516    }
1517}
1518
1519itcl::body Rappture::MapViewer::GetImage { args } {
1520    if { [image width $_image(download)] > 0 &&
1521         [image height $_image(download)] > 0 } {
1522        set bytes [$_image(download) data -format "jpeg -quality 100"]
1523        set bytes [Rappture::encoding::decode -as b64 $bytes]
1524        return [list .jpg $bytes]
1525    }
1526    return ""
1527}
1528
1529itcl::body Rappture::MapViewer::BuildDownloadPopup { popup command } {
1530    Rappture::Balloon $popup \
1531        -title "[Rappture::filexfer::label downloadWord] as..."
1532    set inner [$popup component inner]
1533    label $inner.summary -text "" -anchor w
1534
1535    radiobutton $inner.image_button -text "Image File" \
1536        -variable [itcl::scope _downloadPopup(format)] \
1537        -value image
1538    Rappture::Tooltip::for $inner.image_button \
1539        "Save as digital image."
1540
1541    button $inner.ok -text "Save" \
1542        -highlightthickness 0 -pady 2 -padx 3 \
1543        -command $command \
1544        -compound left \
1545        -image [Rappture::icon download]
1546
1547    button $inner.cancel -text "Cancel" \
1548        -highlightthickness 0 -pady 2 -padx 3 \
1549        -command [list $popup deactivate] \
1550        -compound left \
1551        -image [Rappture::icon cancel]
1552
1553    blt::table $inner \
1554        0,0 $inner.summary -cspan 2  \
1555        2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \
1556        4,1 $inner.cancel -width .9i -fill y \
1557        4,0 $inner.ok -padx 2 -width .9i -fill y
1558    blt::table configure $inner r3 -height 4
1559    blt::table configure $inner r4 -pady 4
1560    raise $inner.image_button
1561    $inner.image_button invoke
1562    return $inner
1563}
1564
1565itcl::body Rappture::MapViewer::SetObjectStyle { dataobj layer } {
1566    set tag $dataobj-$layer
1567    set _visibility($tag) 1
1568
1569    return
1570
1571    # The following code is a place holder for terrain styles.
1572
1573    set type [$dataobj type $layer]
1574    set style [$dataobj style $layer]
1575    if { $dataobj != $_first } {
1576        set settings(-wireframe) 1
1577    }
1578    switch -- $type {
1579        "elevation" {
1580            array set settings {
1581                -edgecolor black
1582                -edges 0
1583                -lighting 1
1584                -linewidth 1.0
1585                -vertscale 1.0
1586                -wireframe 0
1587            }
1588            array set settings $style
1589            SendCmd "map terrain edges $settings(-edges) $tag"
1590            set _settings(terrain-edges) $settings(-edges)
1591            SendCmd "map terrain color [Color2RGB $settings(-color)] $tag"
1592            #SendCmd "map terrain colormode constant {} $tag"
1593            SendCmd "map terrain lighting $settings(-lighting) $tag"
1594            set _settings(terrain-lighting) $settings(-lighting)
1595            SendCmd "map terrain linecolor [Color2RGB $settings(-edgecolor)] $tag"
1596            SendCmd "map terrain linewidth $settings(-linewidth) $tag"
1597            SendCmd "map terrain wireframe $settings(-wireframe) $tag"
1598            set _settings(terrain-wireframe) $settings(-wireframe)
1599        }
1600    }
1601    #SetColormap $dataobj $layer
1602}
1603
1604itcl::body Rappture::MapViewer::SetOrientation { side } {
1605    array set positions {
1606        front "1 0 0 0"
1607        back  "0 0 1 0"
1608        left  "0.707107 0 -0.707107 0"
1609        right "0.707107 0 0.707107 0"
1610        top   "0.707107 -0.707107 0 0"
1611        bottom "0.707107 0.707107 0 0"
1612    }
1613    foreach name { qw qx qy qz } value $positions($side) {
1614        set _view($name) $value
1615    }
1616    set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
1617    $_arcball quaternion $q
1618    SendCmd "camera orient $q"
1619    #SendCmd "camera reset"
1620    set _view(xpan) 0
1621    set _view(ypan) 0
1622    set _view(zoom) 1.0
1623}
1624
1625itcl::body Rappture::MapViewer::SetOpacity { dataset } {
1626    foreach {dataobj layer} [split $dataset -] break
1627    set type [$dataobj type $layer]
1628    set val $_settings(-opacity)
1629    set sval [expr { 0.01 * double($val) }]
1630    if { !$_obj2ovride($dataobj-raise) } {
1631        # This is wrong.  Need to figure out why raise isn't set with 1
1632        #set sval [expr $sval * .6]
1633    }
1634    SendCmd "$type opacity $sval $dataset"
1635}
1636
1637itcl::body Rappture::MapViewer::ChangeLayerVisibility { dataobj layer } {
1638    set tag $dataobj-$layer
1639    set bool $_visibility($tag)
1640    SendCmd "map layer visible $bool $tag"
1641}
1642
1643itcl::body Rappture::MapViewer::UpdateLayerControls {} {
1644    set row 0
1645    set inner $_layers
1646    if { [winfo exists $inner.layers] } {
1647        foreach w [winfo children $inner.layers] {
1648            destroy $w
1649        }
1650    }
1651    set f $inner.layers
1652    foreach dataobj [get -objects] {
1653        foreach name [$dataobj layers] {
1654            array unset info
1655            array set info [$dataobj layer $name]
1656            set tag $dataobj-$name
1657            set w [string range $dataobj$name 2 end]
1658            checkbutton $f.$w \
1659                -text $info(title) \
1660                -variable [itcl::scope _visibility($tag)] \
1661                -command [itcl::code $this \
1662                              ChangeLayerVisibility $dataobj $name] \
1663                    -font "Arial 9" -anchor w
1664            blt::table $f $row,0 $f.$w -anchor w -pady 2
1665            Rappture::Tooltip::for $f.$w $info(description)
1666            incr row
1667        }
1668    }
1669    if { $row > 0 } {
1670        blt::table configure $f r* c* -resize none
1671        blt::table configure $f r$row c1 -resize expand
1672    }
1673}
Note: See TracBrowser for help on using the repository browser.