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

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

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