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

Last change on this file since 4096 was 4075, checked in by ldelgass, 10 years ago

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