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

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

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