source: branches/nanovis2/gui/scripts/heightmapviewer.tcl @ 3176

Last change on this file since 3176 was 3176, checked in by ldelgass, 12 years ago

Use arcball camera in heightmap viewer, update quat entries on camera tab when
rotating.
File size: 52.8 KB
Line 
1
2# ----------------------------------------------------------------------
3#  Component: heightmapviewer - 3D surface rendering
4#
5#  This widget performs surface rendering on 3D scalar/vector datasets.
6#  It connects to the Nanovis server running on a rendering farm,
7#  transmits data, and displays the results.
8# ======================================================================
9#  AUTHOR:  Michael McLennan, Purdue University
10#  Copyright (c) 2004-2005  Purdue Research Foundation
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# ======================================================================
15
16package require Itk
17package require BLT
18package require Img
19
20option add *HeightmapViewer.width 4i widgetDefault
21option add *HeightmapViewer.height 4i widgetDefault
22option add *HeightmapViewer.foreground black widgetDefault
23option add *HeightmapViewer.plotBackground black widgetDefault
24option add *HeightmapViewer.plotForeground white widgetDefault
25option add *HeightmapViewer.plotOutline white widgetDefault
26option add *HeightmapViewer.font -*-helvetica-medium-r-normal-*-12-* widgetDefault
27
28# must use this name -- plugs into Rappture::resources::load
29proc HeightmapViewer_init_resources {} {
30    Rappture::resources::register \
31        nanovis_server Rappture::HeightmapViewer::SetServerList
32}
33
34itcl::class Rappture::HeightmapViewer {
35    inherit Rappture::VisViewer
36
37    itk_option define -plotforeground plotForeground Foreground ""
38    itk_option define -plotbackground plotBackground Background ""
39    itk_option define -plotoutline plotOutline PlotOutline ""
40
41    constructor { hostlist args } {
42        Rappture::VisViewer::constructor $hostlist
43    } {
44        # defined below
45    }
46    destructor {
47        # defined below
48    }
49
50    public proc SetServerList { namelist } {
51        Rappture::VisViewer::SetServerList "nanovis" $namelist
52    }
53    public method add {dataobj {settings ""}}
54    public method get {args}
55    public method delete {args}
56    public method scale {args}
57    public method snap { w h }
58    public method download {option args}
59    public method parameters {title args} {
60        # do nothing
61    }
62    public method camera {option args}
63
64    protected method Connect {}
65    protected method Disconnect {}
66    public method isconnected {}
67
68    protected method SendCmd {string}
69    protected method ReceiveImage { args }
70    private method ReceiveLegend {tf vmin vmax size}
71    private method BuildViewTab {}
72    private method BuildCameraTab {}
73    private method PanCamera {}
74
75    private method AddImageControls { frame widget }
76    private method SetWaitVariable { value } {
77        set _getimage $value
78    }
79    private method GetWaitVariable {} {
80        return $_getimage
81    }
82    private method WaitForImage {} {
83        tkwait variable [itcl::scope _getimage]
84        return $_getimage
85    }
86
87    protected method CurrentSurfaces {{what -all}}
88    protected method Rebuild {}
89    protected method Zoom {option}
90    protected method Pan {option x y}
91    protected method Rotate {option x y}
92
93    protected method State {comp}
94    protected method FixSettings {what {value ""}}
95    protected method GetTransfuncData {dataobj comp}
96    protected method Resize {}
97    private method EventuallyResize { w h }
98
99    private variable _arcball ""
100    private variable _useArcball 1
101    private variable _outbuf       ;# buffer for outgoing commands
102
103    private variable _dlist ""     ;# list of data objects
104    private variable _obj2style    ;# maps dataobj => style settings
105    private variable _obj2ovride   ;# maps dataobj => style override
106    private variable _click        ;# info used for Rotate operations
107    private variable _limits       ;# autoscale min/max for all axes
108    private variable _view         ;# view params for 3D view
109    private common _settings       ;# Array of used for global variables
110                                    # for checkbuttons and radiobuttons.
111    private variable _serverObjs   ;# contains all the dataobj-component
112                                   ;# to heightmaps in the server
113    private variable _location ""
114    private variable _first ""
115    private variable _width 0
116    private variable _height 0
117    private common _hardcopy
118    private variable _buffering 0
119    private variable _resizePending 0
120    private variable _resizeLegendPending 0
121    private variable _frame 0;          # Current frame number.
122    private variable _getimage 0;
123    private variable _downloadPopup
124}
125
126itk::usual HeightmapViewer {
127    keep -background -foreground -cursor -font
128    keep -plotbackground -plotforeground
129}
130
131# ----------------------------------------------------------------------
132# CONSTRUCTOR
133# ----------------------------------------------------------------------
134itcl::body Rappture::HeightmapViewer::constructor {hostlist args} {
135    set _serverType "nanovis"
136
137    # Draw legend event
138    $_dispatcher register !legend
139    $_dispatcher dispatch $this !legend \
140        "[itcl::code $this FixSettings legend]; list"
141
142    # Rebuild event
143    $_dispatcher register !rebuild
144    $_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
145
146    # Resize event.
147    $_dispatcher register !resize
148    $_dispatcher dispatch $this !resize "[itcl::code $this Resize]; list"
149
150    set _outbuf ""
151
152    #
153    # Populate parser with commands handle incoming requests
154    #
155    $_parser alias image [itcl::code $this ReceiveImage]
156    $_parser alias legend [itcl::code $this ReceiveLegend]
157
158    array set _downloadPopup {
159        format image
160        image_controls ""
161    }
162    # Initialize the view to some default parameters.
163    array set _view {
164        qw      0.853553
165        qx      -0.353553
166        qy      0.353553
167        qz      0.146447
168        theta   45
169        phi     45
170        psi     0
171        zoom    1.0
172        pan-x   0
173        pan-y   0
174    }
175    set _arcball [blt::arcball create 100 100]
176    set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
177    $_arcball quaternion $q
178
179    foreach val {xmin xmax ymin ymax zmin zmax vmin vmax} {
180        set _limits($val) ""
181    }
182    array set _settings [subst {
183        $this-qw                $_view(qw)
184        $this-qx                $_view(qx)
185        $this-qy                $_view(qy)
186        $this-qz                $_view(qz)
187        $this-phi               $_view(phi)
188        $this-psi               $_view(psi)
189        $this-theta             $_view(theta)
190        $this-pan-x             $_view(pan-x)
191        $this-pan-y             $_view(pan-y)
192        $this-surface           1
193        $this-xcutplane         0
194        $this-xcutposition      0
195        $this-ycutplane         0
196        $this-ycutposition      0
197        $this-zcutplane         0
198        $this-zcutposition      0
199        $this-zoom              $_view(zoom)
200    }]
201
202    itk_component add 3dview {
203        canvas $itk_component(plotarea).view \
204            -highlightthickness 0 -borderwidth 0
205    } {
206        usual
207        ignore -highlightthickness -borderwidth  -background
208    }
209    $_image(plot) configure -data ""
210    $itk_component(3dview) create image 0 0 -anchor nw -image $_image(plot)
211    set f [$itk_component(main) component controls]
212    itk_component add zoom {
213        frame $f.zoom
214    }
215    pack $itk_component(zoom) -side top
216
217    itk_component add reset {
218        button $f.reset -borderwidth 1 -padx 1 -pady 1 \
219            -highlightthickness 0 \
220            -image [Rappture::icon reset-view] \
221            -command [itcl::code $this Zoom reset]
222    } {
223        usual
224        ignore -highlightthickness
225    }
226    pack $itk_component(reset) -side top -padx 1 -pady { 4 0 }
227    Rappture::Tooltip::for $itk_component(reset) \
228        "Reset the view to the default zoom level"
229
230    itk_component add zoomin {
231        button $f.zin -borderwidth 1 -padx 1 -pady 1 \
232            -highlightthickness 0 \
233            -image [Rappture::icon zoom-in] \
234            -command [itcl::code $this Zoom in]
235    } {
236        usual
237        ignore -highlightthickness
238    }
239    pack $itk_component(zoomin) -side top -padx 1 -pady { 4 0 }
240    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
241
242    itk_component add zoomout {
243        button $f.zout -borderwidth 1 -padx 1 -pady 1 \
244            -highlightthickness 0 \
245            -image [Rappture::icon zoom-out] \
246            -command [itcl::code $this Zoom out]
247    } {
248        usual
249        ignore -highlightthickness
250    }
251    pack $itk_component(zoomout) -side top -padx 1 -pady { 4 }
252    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
253
254    itk_component add surface {
255        Rappture::PushButton $f.surface \
256            -onimage [Rappture::icon volume-on] \
257            -offimage [Rappture::icon volume-off] \
258            -command [itcl::code $this FixSettings surface] \
259            -variable [itcl::scope _settings($this-surface)]
260    }
261    $itk_component(surface) select
262    Rappture::Tooltip::for $itk_component(surface) \
263        "Toggle surfaces on/off"
264    pack $itk_component(surface) -padx 2 -pady 2
265
266    BuildViewTab
267    BuildCameraTab
268
269    set w [expr [winfo reqwidth $itk_component(hull)] - 80]
270    pack forget $itk_component(3dview)
271    pack $itk_component(3dview) -side left -fill both -expand yes
272
273
274    # Bindings for rotation via mouse
275    bind $itk_component(3dview) <ButtonPress-1> \
276        [itcl::code $this Rotate click %x %y]
277    bind $itk_component(3dview) <B1-Motion> \
278        [itcl::code $this Rotate drag %x %y]
279    bind $itk_component(3dview) <ButtonRelease-1> \
280        [itcl::code $this Rotate release %x %y]
281    bind $itk_component(3dview) <Configure> \
282        [itcl::code $this EventuallyResize %w %h]
283
284    # Bindings for panning via mouse
285    bind $itk_component(3dview) <ButtonPress-2> \
286        [itcl::code $this Pan click %x %y]
287    bind $itk_component(3dview) <B2-Motion> \
288        [itcl::code $this Pan drag %x %y]
289    bind $itk_component(3dview) <ButtonRelease-2> \
290        [itcl::code $this Pan release %x %y]
291
292    # Bindings for panning via keyboard
293    bind $itk_component(3dview) <KeyPress-Left> \
294        [itcl::code $this Pan set -10 0]
295    bind $itk_component(3dview) <KeyPress-Right> \
296        [itcl::code $this Pan set 10 0]
297    bind $itk_component(3dview) <KeyPress-Up> \
298        [itcl::code $this Pan set 0 -10]
299    bind $itk_component(3dview) <KeyPress-Down> \
300        [itcl::code $this Pan set 0 10]
301    bind $itk_component(3dview) <Shift-KeyPress-Left> \
302        [itcl::code $this Pan set -2 0]
303    bind $itk_component(3dview) <Shift-KeyPress-Right> \
304        [itcl::code $this Pan set 2 0]
305    bind $itk_component(3dview) <Shift-KeyPress-Up> \
306        [itcl::code $this Pan set 0 -2]
307    bind $itk_component(3dview) <Shift-KeyPress-Down> \
308        [itcl::code $this Pan set 0 2]
309
310    # Bindings for zoom via keyboard
311    bind $itk_component(3dview) <KeyPress-Prior> \
312        [itcl::code $this Zoom out]
313    bind $itk_component(3dview) <KeyPress-Next> \
314        [itcl::code $this Zoom in]
315
316    bind $itk_component(3dview) <Enter> "focus $itk_component(3dview)"
317
318    if {[string equal "x11" [tk windowingsystem]]} {
319        # Bindings for zoom via mouse
320        bind $itk_component(3dview) <4> [itcl::code $this Zoom out]
321        bind $itk_component(3dview) <5> [itcl::code $this Zoom in]
322    }
323
324    set _image(download) [image create photo]
325    eval itk_initialize $args
326    Connect
327}
328
329# ----------------------------------------------------------------------
330# DESTRUCTOR
331# ----------------------------------------------------------------------
332itcl::body Rappture::HeightmapViewer::destructor {} {
333    $_dispatcher cancel !rebuild
334    image delete $_image(plot)
335    image delete $_image(legend)
336    image delete $_image(download)
337    catch { blt::arcball destroy $_arcball }
338}
339
340# ----------------------------------------------------------------------
341# USAGE: add <dataobj> ?<settings>?
342#
343# Clients use this to add a data object to the plot.  The optional
344# <settings> are used to configure the plot.  Allowed settings are
345# -color, -brightness, -width, -linestyle, and -raise.
346# ----------------------------------------------------------------------
347itcl::body Rappture::HeightmapViewer::add {dataobj {settings ""}} {
348    array set params {
349        -color auto
350        -width 1
351        -linestyle solid
352        -brightness 0
353        -raise 0
354        -description ""
355        -param ""
356    }
357    foreach {opt val} $settings {
358        if {![info exists params($opt)]} {
359            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
360        }
361        set params($opt) $val
362    }
363    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
364        # can't handle -autocolors yet
365        set params(-color) black
366    }
367    set pos [lsearch -exact $dataobj $_dlist]
368    if {$pos < 0} {
369        lappend _dlist $dataobj
370        set _obj2ovride($dataobj-color) $params(-color)
371        set _obj2ovride($dataobj-width) $params(-width)
372        set _obj2ovride($dataobj-raise) $params(-raise)
373        set _obj2ovride($dataobj-brightness) $params(-brightness)
374        $_dispatcher event -idle !rebuild
375    }
376    scale $dataobj
377}
378
379# ----------------------------------------------------------------------
380# USAGE: get ?-objects?
381# USAGE: get ?-image 3dview|legend?
382#
383# Clients use this to query the list of objects being plotted, in
384# order from bottom to top of this result.  The optional "-image"
385# flag can also request the internal images being shown.
386# ----------------------------------------------------------------------
387itcl::body Rappture::HeightmapViewer::get { args } {
388    if {[llength $args] == 0} {
389        set args "-objects"
390    }
391
392    set op [lindex $args 0]
393    switch -- $op {
394      -objects {
395        # put the dataobj list in order according to -raise options
396        set dlist $_dlist
397        foreach obj $dlist {
398            if { [info exists _obj2ovride($obj-raise)] &&
399                 $_obj2ovride($obj-raise)} {
400                set i [lsearch -exact $dlist $obj]
401                if {$i >= 0} {
402                    set dlist [lreplace $dlist $i $i]
403                    lappend dlist $obj
404                }
405            }
406        }
407        return $dlist
408      }
409      -image {
410        if {[llength $args] != 2} {
411            error "wrong # args: should be \"get -image 3dview|legend\""
412        }
413        switch -- [lindex $args end] {
414            3dview {
415                return $_image(plot)
416            }
417            legend {
418                return $_image(legend)
419            }
420            default {
421                error "bad image name \"[lindex $args end]\": should be 3dview or legend"
422            }
423        }
424      }
425      default {
426        error "bad option \"$op\": should be -objects or -image"
427      }
428    }
429}
430
431# ----------------------------------------------------------------------
432# USAGE: delete ?<dataobj1> <dataobj2> ...?
433#
434# Clients use this to delete a dataobj from the plot.  If no dataobjs
435# are specified, then all dataobjs are deleted.
436# ----------------------------------------------------------------------
437itcl::body Rappture::HeightmapViewer::delete { args } {
438    if {[llength $args] == 0} {
439        set args $_dlist
440    }
441
442    # delete all specified dataobjs
443    set changed 0
444    foreach dataobj $args {
445        set pos [lsearch -exact $_dlist $dataobj]
446        if {$pos >= 0} {
447            set _dlist [lreplace $_dlist $pos $pos]
448            foreach key [array names _obj2ovride $dataobj-*] {
449                unset _obj2ovride($key)
450            }
451            array unset _serverObjs $dataobj-*
452            set changed 1
453        }
454    }
455
456    # if anything changed, then rebuild the plot
457    if {$changed} {
458        $_dispatcher event -idle !rebuild
459    }
460}
461
462# ----------------------------------------------------------------------
463# USAGE: scale ?<data1> <data2> ...?
464#
465# Sets the default limits for the overall plot according to the
466# limits of the data for all of the given <data> objects.  This
467# accounts for all objects--even those not showing on the screen.
468# Because of this, the limits are appropriate for all objects as
469# the user scans through data in the ResultSet viewer.
470# ----------------------------------------------------------------------
471itcl::body Rappture::HeightmapViewer::scale { args } {
472    if 0 {
473    foreach val {xmin xmax ymin ymax zmin zmax vmin vmax} {
474        set _limits($val) ""
475    }
476    }
477    foreach obj $args {
478        foreach axis {x y z v} {
479            foreach {min max} [$obj limits $axis] break
480            if {"" != $min && "" != $max} {
481                if {"" == $_limits(${axis}min)} {
482                    set _limits(${axis}min) $min
483                    set _limits(${axis}max) $max
484                } else {
485                    if {$min < $_limits(${axis}min)} {
486                        set _limits(${axis}min) $min
487                    }
488                    if {$max > $_limits(${axis}max)} {
489                        set _limits(${axis}max) $max
490                    }
491                }
492                set _limits(${axis}range) [expr {$max - $min}]
493            }
494        }
495    }
496}
497
498# ----------------------------------------------------------------------
499# USAGE: download coming
500# USAGE: download controls <downloadCommand>
501# USAGE: download now
502#
503# Clients use this method to create a downloadable representation
504# of the plot.  Returns a list of the form {ext string}, where
505# "ext" is the file extension (indicating the type of data) and
506# "string" is the data itself.
507# ----------------------------------------------------------------------
508itcl::body Rappture::HeightmapViewer::download {option args} {
509    switch $option {
510        coming {
511            if {[catch {
512                blt::winop snap $itk_component(plotarea) $_image(download)
513            }]} {
514                $_image(download) configure -width 1 -height 1
515                $_image(download) put #000000
516            }
517        }
518        controls {
519            set popup .heightmapviewerdownload
520            if {![winfo exists $popup]} {
521                # If we haven't created the popup yet, do it now
522                Rappture::Balloon $popup \
523                    -title "[Rappture::filexfer::label downloadWord] as..."
524                set inner [$popup component inner]
525                label $inner.summary -text "" -anchor w
526                pack $inner.summary -side top
527                radiobutton $inner.image -text "Image (PNG/JPEG/GIF)" \
528                    -variable \
529                    ::Rappture::HeightmapViewer::_downloadPopup(format) \
530                    -font "Arial 10 " \
531                    -value image
532                Rappture::Tooltip::for $inner.image "Save as image."
533                pack $inner.image -anchor w
534                button $inner.go -text [Rappture::filexfer::label download] \
535                    -command [lindex $args 0]
536                pack $inner.go -side bottom -pady 4
537                $inner.image select
538            } else {
539                set inner [$popup component inner]
540            }
541            set num [llength [get]]
542            set num [expr {($num == 1) ? "1 result" : "$num results"}]
543            set word [Rappture::filexfer::label downloadWord]
544            $inner.summary configure -text "$word $num in the following format:"
545            update idletasks ;          # Fix initial sizes
546            return $popup
547        }
548        now {
549            set popup .heightmapviewerdownload
550            if { [winfo exists $popup] } {
551                $popup deactivate
552            }
553            switch -- $_downloadPopup(format) {
554                "image" {
555                    set popup .heightmapviewerimage
556                    if { ![winfo exists $popup] } {
557                        # Create the balloon popup and and the print image
558                        # dialog widget to it.
559                        Rappture::Balloon $popup -title "Save as image..." \
560                            -deactivatecommand \
561                            [itcl::code $this SetWaitVariable 0]
562                        set inner [$popup component inner]
563                        AddImageControls $inner [lindex $args 0]
564                    } else {
565                        set inner [$popup component inner]
566                    }                   
567                    set _downloadPopup(image_controls) $inner
568                    update
569                    # Activate the popup and call for the output.
570                    foreach { widget toolName plotName } $args break
571                    SetWaitVariable 0
572                    $popup activate $widget left
573                    set bool [WaitForImage]
574                    $popup deactivate
575                    if { $bool } {
576                        set inner $_downloadPopup(image_controls)
577                        set fmt [$inner.format translate [$inner.format value]]
578                        # Get the image data (as base64) and decode it back to
579                        # binary.  This is better than writing to temporary
580                        # files.  When we switch to the BLT picture image it
581                        # won't be necessary to decode the image data.
582                        switch $fmt {
583                            "jpg" {
584                                set bytes [$_image(download) data \
585                                               -format "jpeg -quality 100"]
586                            }
587                            "png" {
588                                set bytes [$_image(download) data -format "png"]
589                            }
590                            "gif" {
591                                set bytes [$_image(download) data -format "gif"]
592                            }
593                            default {
594                                return ""
595                            }
596                        }
597                        set bytes [Rappture::encoding::decode -as b64 $bytes]
598                        return [list .$fmt $bytes]
599                    }
600                }
601            }
602            return ""
603        }
604        default {
605            error "bad option \"$option\": should be coming, controls, now"
606        }
607    }
608}
609
610#
611# isconnected --
612#
613#       Indicates if we are currently connected to the visualization server.
614#
615itcl::body Rappture::HeightmapViewer::isconnected {} {
616    return [VisViewer::IsConnected]
617}
618
619# ----------------------------------------------------------------------
620# USAGE: Connect ?<host:port>,<host:port>...?
621#
622# Clients use this method to establish a connection to a new
623# server, or to reestablish a connection to the previous server.
624# Any existing connection is automatically closed.
625# ----------------------------------------------------------------------
626itcl::body Rappture::HeightmapViewer::Connect {} {
627    global readyForNextFrame
628    set readyForNextFrame 1
629    Disconnect
630    set _hosts [GetServerList "nanovis"]
631    if { "" == $_hosts } {
632        return 0
633    }
634    catch {unset _serverObjs}
635    set result [VisViewer::Connect $_hosts]
636    return $result
637}
638
639# ----------------------------------------------------------------------
640# USAGE: Disconnect
641#
642# Clients use this method to disconnect from the current rendering
643# server.
644# ----------------------------------------------------------------------
645itcl::body Rappture::HeightmapViewer::Disconnect {} {
646    VisViewer::Disconnect
647
648    set _outbuf ""
649    # disconnected -- no more data sitting on server
650    global readyForNextFrame
651    set readyForNextFrame 1
652}
653
654#
655# SendCmd
656#
657#       Send commands off to the rendering server.  If we're currently
658#       sending data objects to the server, buffer the commands to be
659#       sent later.
660#
661itcl::body Rappture::HeightmapViewer::SendCmd {string} {
662    if { $_buffering } {
663        append _outbuf $string "\n"
664    } else {
665        foreach line [split $string \n] {
666            SendEcho >>line $line
667        }
668        SendBytes "$string\n"
669    }
670}
671
672# ----------------------------------------------------------------------
673# USAGE: ReceiveImage -bytes <size>
674#
675# Invoked automatically whenever the "image" command comes in from
676# the rendering server.  Indicates that binary image data with the
677# specified <size> will follow.
678# ----------------------------------------------------------------------
679itcl::body Rappture::HeightmapViewer::ReceiveImage { args } {
680    global readyForNextFrame
681    set readyForNextFrame 1
682    if {![IsConnected]} {
683        return
684    }
685    array set info {
686        -type image
687    }
688    array set info $args
689    set bytes [ReceiveBytes $info(-bytes)]
690    ReceiveEcho <<line "<read $info(-bytes) bytes"
691    if { $info(-type) == "image" } {
692        $_image(plot) configure -data $bytes
693        ReceiveEcho <<line "<read for [image width $_image(plot)]x[image height $_image(plot)] image>"
694    } elseif { $info(type) == "print" } {
695        set tag $this-print-$info(-token)
696        set _hardcopy($tag) $bytes
697    }
698}
699
700# ----------------------------------------------------------------------
701# USAGE: ReceiveLegend <tf> <vmin> <vmax> <size>
702#
703# Invoked automatically whenever the "legend" command comes in from
704# the rendering server.  Indicates that binary image data with the
705# specified <size> will follow.
706# ----------------------------------------------------------------------
707itcl::body Rappture::HeightmapViewer::ReceiveLegend {obj vmin vmax size} {
708    if { [IsConnected] } {
709        set bytes [ReceiveBytes $size]
710        if { ![info exists _image(legend)] } {
711            set _image(legend) [image create photo]
712        }
713        ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
714        set src [image create photo -data $bytes]
715        blt::winop image rotate $src $_image(legend) 90
716        set dst $_image(legend)
717
718        set c $itk_component(3dview)
719        set w [winfo width $c]
720        set h [winfo height $c]
721        set lineht [font metrics $itk_option(-font) -linespace]
722
723        if { $_settings($this-legend) } {
724            if { [$c find withtag "legend"] == "" } {
725                $c create image [expr {$w-2}] [expr {$lineht+2}] -anchor ne \
726                    -image $_image(legend) -tags "transfunc legend"
727                $c create text [expr {$w-2}] 2 -anchor ne \
728                    -fill $itk_option(-plotforeground) -tags "vmax legend" \
729                    -font "Arial 8 bold"
730                $c create text [expr {$w-2}] [expr {$h-2}] -anchor se \
731                    -fill $itk_option(-plotforeground) -tags "vmin legend" \
732                    -font "Arial 8 bold"
733            }
734            # Reset the item coordinates according the current size of the plot.
735            $c coords transfunc [expr {$w-2}] [expr {$lineht+2}]
736            $c itemconfigure vmin -text $vmin
737            $c itemconfigure vmax -text $vmax
738            $c coords vmin [expr {$w-2}] [expr {$h-2}]
739            $c coords vmax [expr {$w-2}] 2
740        }
741    }
742}
743
744# ----------------------------------------------------------------------
745# USAGE: Rebuild
746#
747# Called automatically whenever something changes that affects the
748# data in the widget.  Clears any existing data and rebuilds the
749# widget to display new data.
750# ----------------------------------------------------------------------
751itcl::body Rappture::HeightmapViewer::Rebuild {} {
752
753    # Turn on buffering of commands to the server.  We don't want to
754    # be preempted by a server disconnect/reconnect (which automatically
755    # generates a new call to Rebuild).   
756    set _buffering 1
757
758    # Reset the overall limits
759    set _limits(vmin) ""
760    set _limits(vmax) ""
761
762    set _first ""
763    # Turn on buffering of commands to the server.  We don't want to
764    # be preempted by a server disconnect/reconnect (which automatically
765    # generates a new call to Rebuild).   
766    set _buffering 1
767
768    set w [winfo width $itk_component(3dview)]
769    set h [winfo height $itk_component(3dview)]
770    $_arcball resize $w $h
771    EventuallyResize $w $h
772
773    foreach dataobj [get] {
774        foreach comp [$dataobj components] {
775            # Tell the engine to expect some data
776            set tag $dataobj-$comp
777            if { ![info exists _serverObjs($tag)] } {
778                set data [$dataobj blob $comp]
779                set nbytes [string length $data]
780                append _outbuf "heightmap data follows $nbytes $dataobj-$comp\n"
781                append _outbuf $data
782               
783                set _serverObjs($tag) $tag
784               
785                # Determine the transfer function needed for this surface
786                # and make sure that it's defined on the server.
787                foreach {sname cmap wmap} [GetTransfuncData $dataobj $comp] break
788                SendCmd [list "transfunc" "define" $sname $cmap $wmap]
789                set _obj2style($tag) $sname
790            }
791        }
792    }
793
794    # Nothing to send -- activate the proper surface
795    set _first [lindex [get] 0]
796    if {"" != $_first} {
797        set axis [$_first hints updir]
798        if {"" != $axis} {
799            SendCmd "up $axis"
800        }
801        # This is where the initial camera position is set.
802        set location [$_first hints camera]
803        if { $_location == "" && $location != "" } {
804            array set _view $location
805            set _location $location
806        }
807    }
808    SendCmd "heightmap data visible 0"
809    set heightmaps [CurrentSurfaces]
810    if { $heightmaps != ""  && $_settings($this-surface) } {
811        SendCmd "heightmap data visible 1 $heightmaps"
812    }
813    set heightmaps [CurrentSurfaces -raise]
814    if { $heightmaps != "" } {
815        SendCmd "heightmap opacity 0.25"
816        SendCmd "heightmap opacity 0.95 $heightmaps"
817    } else {
818        SendCmd "heightmap opacity 0.85"
819    }
820    foreach key $heightmaps {
821        if {[info exists _obj2style($key)]} {
822            SendCmd "heightmap transfunc $_obj2style($key) $key"
823        }
824    }
825    $_dispatcher event -idle !legend
826
827    if {"" == $itk_option(-plotoutline)} {
828        SendCmd "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
829    }
830    # Reset the camera and other view parameters
831    set _settings($this-qw)    $_view(qw)
832    set _settings($this-qx)    $_view(qx)
833    set _settings($this-qy)    $_view(qy)
834    set _settings($this-qz)    $_view(qz)
835    set _settings($this-theta) $_view(theta)
836    set _settings($this-phi)   $_view(phi)
837    set _settings($this-psi)   $_view(psi)
838    set _settings($this-pan-x) $_view(pan-x)
839    set _settings($this-pan-y) $_view(pan-y)
840    set _settings($this-zoom)  $_view(zoom)
841
842    if {$_useArcball} {
843        set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
844        $_arcball quaternion $q
845        SendCmd "camera orient $q"
846    } else { 
847        set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
848        SendCmd "camera angle $xyz"
849    }
850    PanCamera
851    SendCmd "camera zoom $_view(zoom)"
852
853    FixSettings wireframe
854    FixSettings grid
855    FixSettings axes
856    FixSettings contourlines
857
858    # Actually write the commands to the server socket.  If it fails, we don't
859    # care.  We're finished here.
860    blt::busy hold $itk_component(hull)
861    SendBytes $_outbuf;                 
862    blt::busy release $itk_component(hull)
863
864    # The "readyForNextFrame" variable throttles the sequence play rate.
865    global readyForNextFrame
866    set readyForNextFrame 0;            # Don't advance to the next frame
867                                        # until we get an image.
868    set _buffering 0;                   # Turn off buffering.
869    set _outbuf "";                     # Clear the buffer.             
870}
871
872# ----------------------------------------------------------------------
873# USAGE: Zoom in
874# USAGE: Zoom out
875# USAGE: Zoom reset
876#
877# Called automatically when the user clicks on one of the zoom
878# controls for this widget.  Changes the zoom for the current view.
879# ----------------------------------------------------------------------
880itcl::body Rappture::HeightmapViewer::Zoom {option} {
881    switch -- $option {
882        "in" {
883            set _view(zoom) [expr {$_view(zoom)*1.25}]
884            set _settings($this-zoom) $_view(zoom)
885        }
886        "out" {
887            set _view(zoom) [expr {$_view(zoom)*0.8}]
888            set _settings($this-zoom) $_view(zoom)
889        }
890        "reset" {
891            array set _view {
892                qw      0.853553
893                qx      -0.353553
894                qy      0.353553
895                qz      0.146447
896                theta   45
897                phi     45
898                psi     0
899                zoom    1.0
900                pan-x   0
901                pan-y   0
902            }
903            if { $_first != "" } {
904                set location [$_first hints camera]
905                if { $location != "" } {
906                    array set _view $location
907                }
908            }
909            if {$_useArcball} {
910                set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
911                $_arcball quaternion $q
912                SendCmd "camera orient $q"
913            } else {
914                set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
915                SendCmd "camera angle $xyz"
916            }
917            PanCamera
918            set _settings($this-qw)    $_view(qw)
919            set _settings($this-qx)    $_view(qx)
920            set _settings($this-qy)    $_view(qy)
921            set _settings($this-qz)    $_view(qz)
922            set _settings($this-theta) $_view(theta)
923            set _settings($this-phi) $_view(phi)
924            set _settings($this-psi) $_view(psi)
925            set _settings($this-pan-x) $_view(pan-x)
926            set _settings($this-pan-y) $_view(pan-y)
927            set _settings($this-zoom) $_view(zoom)
928        }
929    }
930    SendCmd "camera zoom $_view(zoom)"
931}
932
933# ----------------------------------------------------------------------
934# USAGE: $this Pan click x y
935#        $this Pan drag x y
936#        $this Pan release x y
937#
938# Called automatically when the user clicks on one of the zoom
939# controls for this widget.  Changes the zoom for the current view.
940# ----------------------------------------------------------------------
941itcl::body Rappture::HeightmapViewer::Pan {option x y} {
942    # Experimental stuff
943    set w [winfo width $itk_component(3dview)]
944    set h [winfo height $itk_component(3dview)]
945    if { $option == "set" } {
946        set x [expr ($x / double($w)) * $_limits(xrange)]
947        set y [expr ($y / double($h)) * $_limits(yrange)]
948        set _view(pan-x) [expr $_view(pan-x) + $x]
949        set _view(pan-y) [expr $_view(pan-y) + $y]
950        PanCamera
951        set _settings($this-pan-x) $_view(pan-x)
952        set _settings($this-pan-y) $_view(pan-y)
953        return
954    }
955    if { $option == "click" } {
956        set _click(x) $x
957        set _click(y) $y
958        $itk_component(3dview) configure -cursor hand1
959    }
960    if { $option == "drag" || $option == "release" } {
961        set dx [expr (($_click(x) - $x)/double($w)) * $_limits(xrange)]
962        set dy [expr (($_click(y) - $y)/double($h)) * $_limits(yrange)]
963        set _click(x) $x
964        set _click(y) $y
965        set _view(pan-x) [expr $_view(pan-x) - $dx]
966        set _view(pan-y) [expr $_view(pan-y) - $dy]
967        PanCamera
968        set _settings($this-pan-x) $_view(pan-x)
969        set _settings($this-pan-y) $_view(pan-y)
970    }
971    if { $option == "release" } {
972        $itk_component(3dview) configure -cursor ""
973    }
974}
975
976itcl::body Rappture::HeightmapViewer::PanCamera {} {
977    set x [expr ($_view(pan-x)) / $_limits(xrange)]
978    set y [expr ($_view(pan-y)) / $_limits(yrange)]
979    SendCmd "camera pan $x $y"
980}
981
982# ----------------------------------------------------------------------
983# USAGE: Rotate click <x> <y>
984# USAGE: Rotate drag <x> <y>
985# USAGE: Rotate release <x> <y>
986#
987# Called automatically when the user clicks/drags/releases in the
988# plot area.  Moves the plot according to the user's actions.
989# ----------------------------------------------------------------------
990itcl::body Rappture::HeightmapViewer::Rotate {option x y} {
991    switch -- $option {
992        click {
993            $itk_component(3dview) configure -cursor fleur
994            array set _click [subst {
995                x       $x
996                y       $y
997                theta   $_view(theta)
998                phi     $_view(phi)
999            }]
1000        }
1001        drag {
1002            if {[array size _click] == 0} {
1003                Rotate click $x $y
1004            } else {
1005                set w [winfo width $itk_component(3dview)]
1006                set h [winfo height $itk_component(3dview)]
1007                if {$w <= 0 || $h <= 0} {
1008                    return
1009                }
1010
1011                if {[catch {
1012                    # this fails sometimes for no apparent reason
1013                    set dx [expr {double($x-$_click(x))/$w}]
1014                    set dy [expr {double($y-$_click(y))/$h}]
1015                }] != 0 } {
1016                    return
1017                }
1018
1019                if {$_useArcball} {
1020                    set q [$_arcball rotate $x $y $_click(x) $_click(y)]
1021                    foreach { _view(qw) _view(qx) _view(qy) _view(qz) } $q break
1022                    set _settings($this-qw) $_view(qw)
1023                    set _settings($this-qx) $_view(qx)
1024                    set _settings($this-qy) $_view(qy)
1025                    set _settings($this-qz) $_view(qz)
1026                    SendCmd "camera orient $q"
1027                } else {
1028                    #
1029                    # Rotate the camera in 3D
1030                    #
1031                    if {$_view(psi) > 90 || $_view(psi) < -90} {
1032                        # when psi is flipped around, theta moves backwards
1033                        set dy [expr {-$dy}]
1034                    }
1035                    set theta [expr {$_view(theta) - $dy*180}]
1036                    while {$theta < 0} { set theta [expr {$theta+180}] }
1037                    while {$theta > 180} { set theta [expr {$theta-180}] }
1038
1039                    if {abs($theta) >= 30 && abs($theta) <= 160} {
1040                        set phi [expr {$_view(phi) - $dx*360}]
1041                        while {$phi < 0} { set phi [expr {$phi+360}] }
1042                        while {$phi > 360} { set phi [expr {$phi-360}] }
1043                        set psi $_view(psi)
1044                    } else {
1045                        set phi $_view(phi)
1046                        set psi [expr {$_view(psi) - $dx*360}]
1047                        while {$psi < -180} { set psi [expr {$psi+360}] }
1048                        while {$psi > 180} { set psi [expr {$psi-360}] }
1049                    }
1050
1051                    set _view(theta)        $theta
1052                    set _view(phi)          $phi
1053                    set _view(psi)          $psi
1054                    set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
1055                    set _settings($this-theta) $_view(theta)
1056                    set _settings($this-phi) $_view(phi)
1057                    set _settings($this-psi) $_view(psi)
1058                    SendCmd "camera angle $xyz"
1059                }
1060                set _click(x) $x
1061                set _click(y) $y
1062            }
1063        }
1064        release {
1065            Rotate drag $x $y
1066            $itk_component(3dview) configure -cursor ""
1067            catch {unset _click}
1068        }
1069        default {
1070            error "bad option \"$option\": should be click, drag, release"
1071        }
1072    }
1073}
1074
1075# ----------------------------------------------------------------------
1076# USAGE: State <component>
1077#
1078# Used internally to determine the state of a toggle button.
1079# The <component> is the itk component name of the button.
1080# Returns on/off for the state of the button.
1081# ----------------------------------------------------------------------
1082itcl::body Rappture::HeightmapViewer::State {comp} {
1083    if {[$itk_component($comp) cget -relief] == "sunken"} {
1084        return "on"
1085    }
1086    return "off"
1087}
1088
1089# ----------------------------------------------------------------------
1090# USAGE: FixSettings <what> ?<value>?
1091#
1092# Used internally to update rendering settings whenever parameters
1093# change in the popup settings panel.  Sends the new settings off
1094# to the back end.
1095# ----------------------------------------------------------------------
1096itcl::body Rappture::HeightmapViewer::FixSettings { what {value ""} } {
1097    switch -- $what {
1098        "legend" {
1099            if { !$_settings($this-legend) } {
1100                $itk_component(3dview) delete "legend"
1101            }
1102            set lineht [font metrics $itk_option(-font) -linespace]
1103            set w [winfo height $itk_component(3dview)]
1104            set h [winfo width $itk_component(3dview)]
1105            set w [expr {$w - 2*$lineht - 4}]
1106            set h 12
1107            set tag ""
1108            if {"" != $_first} {
1109                set comp [lindex [$_first components] 0]
1110                set tag $_first-$comp
1111            }
1112            if {$w > 0 && $h > 0 && "" != $tag} {
1113                SendCmd "heightmap legend $tag $w $h"
1114            } else {
1115                #$itk_component(legend) delete all
1116            }
1117        }
1118        "surface" {
1119            if { [isconnected] } {
1120                SendCmd "heightmap data visible $_settings($this-surface)"
1121            }
1122        }
1123        "grid" {
1124            if { [IsConnected] } {
1125                SendCmd "grid visible $_settings($this-grid)"
1126            }
1127        }
1128        "axes" {
1129            if { [IsConnected] } {
1130                SendCmd "axis visible $_settings($this-axes)"
1131            }
1132        }
1133        "wireframe" {
1134            if { [IsConnected] } {
1135                SendCmd "heightmap polygon $_settings($this-wireframe)"
1136            }
1137        }
1138        "contourlines" {
1139            if {[IsConnected]} {
1140                if {"" != $_first} {
1141                    set comp [lindex [$_first components] 0]
1142                    if { $comp != "" } {
1143                        set tag $_first-$comp
1144                        set bool $_settings($this-contourlines)
1145                        SendCmd "heightmap linecontour visible $bool $tag"
1146                    }
1147                }
1148            }
1149        }
1150        default {
1151            error "don't know how to fix $what: should be grid, axes, contourlines, or legend"
1152        }
1153    }
1154}
1155
1156# ----------------------------------------------------------------------
1157# USAGE: GetTransfuncData <dataobj> <comp>
1158#
1159# Used internally to compute the colormap and alpha map used to define
1160# a transfer function for the specified component in a data object.
1161# Returns: name {v r g b ...} {v w ...}
1162# ----------------------------------------------------------------------
1163itcl::body Rappture::HeightmapViewer::GetTransfuncData {dataobj comp} {
1164    array set style {
1165        -color rainbow
1166        -levels 6
1167        -opacity 0.5
1168    }
1169    array set style [lindex [$dataobj components -style $comp] 0]
1170    set sname "$style(-color):$style(-levels):$style(-opacity)"
1171
1172    if {$style(-color) == "rainbow"} {
1173        set style(-color) "white:yellow:green:cyan:blue:magenta"
1174    }
1175    if { [info exists style(-nonuniformcolors)] } {
1176        foreach { value color } $style(-nonuniformcolors) {
1177            append cmap "$value [Color2RGB $color] "
1178        }
1179    } else {
1180        set clist [split $style(-color) :]
1181        set cmap "0.0 [Color2RGB white] "
1182        for {set i 0} {$i < [llength $clist]} {incr i} {
1183            set x [expr {double($i+1)/([llength $clist]+1)}]
1184            set color [lindex $clist $i]
1185            append cmap "$x [Color2RGB $color] "
1186        }
1187        append cmap "1.0 [Color2RGB $color]"
1188    }
1189    set opacity $style(-opacity)
1190    set levels $style(-levels)
1191    set wmap {}
1192    if {[string is int $levels]} {
1193        lappend wmap 0.0 0.0
1194        set delta [expr {0.125/($levels+1)}]
1195        for {set i 1} {$i <= $levels} {incr i} {
1196            # add spikes in the middle
1197            set xval [expr {double($i)/($levels+1)}]
1198            lappend wmap [expr {$xval-$delta-0.01}] 0.0
1199            lappend wmap [expr {$xval-$delta}] $opacity
1200            lappend wmap [expr {$xval+$delta}] $opacity
1201            lappend wmap [expr {$xval+$delta+0.01}] 0.0
1202        }
1203        lappend wmap 1.0 0.0
1204    } else {
1205        lappend wmap 0.0 0.0
1206        set delta 0.05
1207        foreach xval [split $levels ,] {
1208            lappend wmap [expr {$xval-$delta}] 0.0
1209            lappend $xval $opacity
1210            lappend [expr {$xval+$delta}] 0.0
1211        }
1212        lappend wmap 1.0 0.0
1213    }
1214    return [list $sname $cmap $wmap]
1215}
1216
1217# ----------------------------------------------------------------------
1218# CONFIGURATION OPTION: -plotbackground
1219# ----------------------------------------------------------------------
1220itcl::configbody Rappture::HeightmapViewer::plotbackground {
1221    foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break
1222    #fix this!
1223    #SendCmd "color background $r $g $b"
1224}
1225
1226# ----------------------------------------------------------------------
1227# CONFIGURATION OPTION: -plotforeground
1228# ----------------------------------------------------------------------
1229itcl::configbody Rappture::HeightmapViewer::plotforeground {
1230    foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break
1231    #fix this!
1232    #SendCmd "color background $r $g $b"
1233}
1234
1235# ----------------------------------------------------------------------
1236# CONFIGURATION OPTION: -plotoutline
1237# ----------------------------------------------------------------------
1238itcl::configbody Rappture::HeightmapViewer::plotoutline {
1239    if {[IsConnected]} {
1240        SendCmd "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
1241    }
1242}
1243
1244#  camera --
1245#
1246itcl::body Rappture::HeightmapViewer::camera {option args} {
1247    switch -- $option {
1248        "show" {
1249            puts [array get _view]
1250        }
1251        "set" {
1252            set who [lindex $args 0]
1253            set x $_settings($this-$who)
1254            set code [catch { string is double $x } result]
1255            if { $code != 0 || !$result } {
1256                set _settings($this-$who) $_view($who)
1257                return
1258            }
1259            switch -- $who {
1260                "pan-x" - "pan-y" {
1261                    set _view($who) $_settings($this-$who)
1262                    PanCamera
1263                }
1264                "phi" - "theta" - "psi" {
1265                    set _view($who) $_settings($this-$who)
1266                    set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
1267                    SendCmd "camera angle $xyz"
1268                    if {$_useArcball} {
1269                        $_arcball euler [list [expr {-[lindex $xyz 2]}] [expr {-[lindex $xyz 1]}] [expr {-[lindex $xyz 0]}]]
1270                        set q [$_arcball quaternion]
1271                        foreach { _view(qw) _view(qx) _view(qy) _view(qz) } $q break
1272                        set _settings($this-qw) $_view(qw)
1273                        set _settings($this-qx) $_view(qx)
1274                        set _settings($this-qy) $_view(qy)
1275                        set _settings($this-qz) $_view(qz)
1276                    }
1277                }
1278                "qx" - "qy" - "qz" - "qw" {
1279                    set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
1280                    $_arcball quaternion $q
1281                    SendCmd "camera orient $q"
1282                }
1283                "zoom" {
1284                    set _view($who) $_settings($this-$who)
1285                    SendCmd "camera zoom $_view(zoom)"
1286                }
1287            }
1288        }
1289    }
1290}
1291
1292itcl::body Rappture::HeightmapViewer::BuildViewTab {} {
1293    set fg [option get $itk_component(hull) font Font]
1294
1295    set inner [$itk_component(main) insert end \
1296        -title "View Settings" \
1297        -icon [Rappture::icon wrench]]
1298    $inner configure -borderwidth 4
1299
1300    foreach { key value } {
1301        grid            1
1302        axes            0
1303        contourlines    1
1304        wireframe       fill
1305        legend          1
1306    } {
1307        set _settings($this-$key) $value
1308    }
1309
1310    checkbutton $inner.surface \
1311        -text "surface" \
1312        -variable [itcl::scope _settings($this-surface)] \
1313        -command [itcl::code $this FixSettings surface] \
1314        -font "Arial 9"
1315    checkbutton $inner.grid \
1316        -text "grid" \
1317        -variable [itcl::scope _settings($this-grid)] \
1318        -command [itcl::code $this FixSettings grid] \
1319        -font "Arial 9"
1320    checkbutton $inner.axes \
1321        -text "axes" \
1322        -variable ::Rappture::HeightmapViewer::_settings($this-axes) \
1323        -command [itcl::code $this FixSettings axes] \
1324        -font "Arial 9"
1325    checkbutton $inner.contourlines \
1326        -text "contour lines" \
1327        -variable ::Rappture::HeightmapViewer::_settings($this-contourlines) \
1328        -command [itcl::code $this FixSettings contourlines]\
1329        -font "Arial 9"
1330    checkbutton $inner.wireframe \
1331        -text "wireframe" \
1332        -onvalue "wireframe" -offvalue "fill" \
1333        -variable ::Rappture::HeightmapViewer::_settings($this-wireframe) \
1334        -command [itcl::code $this FixSettings wireframe]\
1335        -font "Arial 9"
1336    checkbutton $inner.legend \
1337        -text "legend" \
1338        -variable ::Rappture::HeightmapViewer::_settings($this-legend) \
1339        -command [itcl::code $this FixSettings legend]\
1340        -font "Arial 9"
1341
1342    blt::table $inner \
1343        0,1 $inner.surface -anchor w  \
1344        1,1 $inner.grid -anchor w  \
1345        2,1 $inner.axes -anchor w \
1346        3,1 $inner.contourlines -anchor w \
1347        4,1 $inner.wireframe -anchor w \
1348        5,1 $inner.legend -anchor w
1349
1350    blt::table configure $inner c2 -resize expand
1351    blt::table configure $inner c1 -resize none
1352    blt::table configure $inner r* -resize none
1353    blt::table configure $inner r6 -resize expand
1354}
1355
1356itcl::body Rappture::HeightmapViewer::BuildCameraTab {} {
1357    set fg [option get $itk_component(hull) font Font]
1358
1359    set inner [$itk_component(main) insert end \
1360        -title "Camera Settings" \
1361        -icon [Rappture::icon camera]]
1362    $inner configure -borderwidth 4
1363
1364    if {$_useArcball} {
1365        set labels { qw qx qy qz pan-x pan-y zoom }
1366    } else {
1367        set labels { phi theta psi pan-x pan-y zoom }
1368    }
1369    set row 1
1370    foreach tag $labels {
1371        label $inner.${tag}label -text $tag -font "Arial 9"
1372        entry $inner.${tag} -font "Arial 9" -bg white -width 10 \
1373            -textvariable [itcl::scope _settings($this-$tag)]
1374        bind $inner.${tag} <KeyPress-Return> \
1375            [itcl::code $this camera set ${tag}]
1376        blt::table $inner \
1377            $row,1 $inner.${tag}label -anchor e \
1378            $row,2 $inner.${tag} -anchor w
1379        blt::table configure $inner r$row -resize none
1380        incr row
1381    }
1382    blt::table configure $inner c1 c2 -resize none
1383    blt::table configure $inner c3 -resize expand
1384    blt::table configure $inner r$row -resize expand
1385}
1386
1387itcl::body Rappture::HeightmapViewer::Resize {} {
1388    SendCmd "screen $_width $_height"
1389    set _resizePending 0
1390    $_dispatcher event -idle !legend
1391}
1392
1393itcl::body Rappture::HeightmapViewer::EventuallyResize { w h } {
1394    set _width $w
1395    set _height $h
1396    $_arcball resize $w $h
1397    if { !$_resizePending } {
1398        $_dispatcher event -after 200 !resize
1399        set _resizePending 1
1400    }
1401}
1402
1403# ----------------------------------------------------------------------
1404# USAGE: CurrentVolumes ?-cutplanes?
1405#
1406# Returns a list of volume server IDs for the current volume being
1407# displayed.  This is normally a single ID, but it might be a list
1408# of IDs if the current data object has multiple components.
1409# ----------------------------------------------------------------------
1410itcl::body Rappture::HeightmapViewer::CurrentSurfaces {{what -all}} {
1411    set list {}
1412    if { $what == "-all" } {
1413        foreach key [array names _serverObjs] {
1414            foreach {dataobj comp} [split $key -] break
1415            if { [info exists _obj2ovride($dataobj-raise)] } {
1416                lappend list $dataobj-$comp
1417            }
1418        }
1419    } else {
1420        foreach key [array names _serverObjs] {
1421            foreach {dataobj comp} [split $key -] break
1422            if { [info exists _obj2ovride($dataobj$what)] &&
1423                 $_obj2ovride($dataobj$what) } {
1424                lappend list $dataobj-$comp
1425            }
1426        }
1427    }
1428    return $list
1429}
1430
1431itcl::body Rappture::HeightmapViewer::snap { w h } {
1432    if { $w <= 0 || $h <= 0 } {
1433        set w [image width $_image(plot)]
1434        set h [image height $_image(plot)]
1435    }
1436    set img [image create picture -width $w -height $h]
1437    $img resample $_image(plot)
1438    return $img
1439}
1440
1441
1442itcl::body Rappture::HeightmapViewer::AddImageControls { inner widget } {
1443    label $inner.size_l -text "Size:" -font "Arial 9"
1444    set _downloadPopup(image_controls) $inner
1445    set img $_image(plot)
1446    set res "[image width $img]x[image height $img]"
1447    Rappture::Combobox $inner.size -width 30 -editable no
1448    $inner.size choices insert end \
1449        "draft"  "Draft ($res)"         
1450
1451    label $inner.bgcolor_l -text "Background:" -font "Arial 9"
1452    Rappture::Combobox $inner.bgcolor -width 30 -editable no
1453    $inner.bgcolor choices insert end \
1454        "black"  "Black" \
1455        "white"  "White"
1456
1457    label $inner.format_l -text "Format:" -font "Arial 9"
1458    Rappture::Combobox $inner.format -width 30 -editable no
1459    $inner.format choices insert end \
1460        "png"  "PNG (Portable Network Graphics format)" \
1461        "jpg"  "JPEG (Joint Photographic Experts Group format)"
1462
1463    button $inner.go -text [Rappture::filexfer::label download] \
1464        -command [itcl::code $this SetWaitVariable 1]
1465
1466    blt::table $inner \
1467        0,0 $inner.format_l -anchor e \
1468        0,1 $inner.format -anchor w -fill x  \
1469        1,0 $inner.size_l -anchor e \
1470        1,1 $inner.size -anchor w -fill x \
1471        2,0 $inner.bgcolor_l -anchor e \
1472        2,1 $inner.bgcolor -anchor w -fill x \
1473        6,0 $inner.go -cspan 2 -pady 5
1474    $inner.bgcolor value "Black"
1475    $inner.size value "Draft ($res)"
1476    $inner.format value  "PNG (Portable Network Graphics format)"
1477}
Note: See TracBrowser for help on using the repository browser.