source: branches/blt4/gui/scripts/heightmapviewer.tcl @ 2327

Last change on this file since 2327 was 2327, checked in by gah, 13 years ago

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