source: trunk/gui/scripts/geoviewer.tcl @ 4264

Last change on this file since 4264 was 4264, checked in by ldelgass, 11 years ago

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