source: trunk/gui/scripts/heightmapviewer.tcl @ 1555

Last change on this file since 1555 was 1545, checked in by gah, 15 years ago

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