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

Last change on this file since 1111 was 1111, checked in by gah, 16 years ago

nanovis/heightmap update
File size: 35.2 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: heightmapviewer - 3D volume rendering
3#
4#  This widget performs volume rendering on 3D scalar/vector datasets.
5#  It connects to the Nanovis server running on a rendering farm,
6#  transmits data, and displays the results.
7# ======================================================================
8#  AUTHOR:  Michael McLennan, Purdue University
9#  Copyright (c) 2004-2005  Purdue Research Foundation
10#
11#  See the file "license.terms" for information on usage and
12#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13# ======================================================================
14
15package require Itk
16package require BLT
17package require Img
18
19option add *HeightmapViewer.width 4i widgetDefault
20option add *HeightmapViewer.height 4i widgetDefault
21option add *HeightmapViewer.foreground black widgetDefault
22option add *HeightmapViewer.controlBackground gray widgetDefault
23option add *HeightmapViewer.controlDarkBackground #999999 widgetDefault
24option add *HeightmapViewer.plotBackground black widgetDefault
25option add *HeightmapViewer.plotForeground white widgetDefault
26option add *HeightmapViewer.plotOutline white widgetDefault
27option add *HeightmapViewer.font \
28    -*-helvetica-medium-r-normal-*-12-* widgetDefault
29
30# must use this name -- plugs into Rappture::resources::load
31proc HeightmapViewer_init_resources {} {
32    Rappture::resources::register \
33        nanovis_server Rappture::HeightmapViewer::SetServerList
34}
35
36itcl::class Rappture::HeightmapViewer {
37    inherit Rappture::VisViewer
38
39    itk_option define -plotforeground plotForeground Foreground ""
40    itk_option define -plotbackground plotBackground Background ""
41    itk_option define -plotoutline plotOutline PlotOutline ""
42
43    constructor { hostlist args } {
44        Rappture::VisViewer::constructor $hostlist
45    } {
46        # defined below
47    }
48    destructor {
49        # defined below
50    }
51
52    public proc SetServerList { namelist } {
53        Rappture::VisViewer::SetServerList "nanovis" $namelist
54    }
55    public method isconnected {}
56    public method add {dataobj {settings ""}}
57    public method get {args}
58    public method delete {args}
59    public method scale {args}
60    public method download {option args}
61    public method parameters {title args} {
62        # do nothing
63    }
64    protected method Connect {}
65    protected method Disconnect {}
66
67    protected method _send {string}
68    protected method _send_dataobjs {}
69    protected method _receive_image {option size}
70    protected method ReceiveLegend {ivol vmin vmax size}
71    protected method _receive_echo {channel {data ""}}
72
73    protected method _rebuild {}
74    protected method _zoom {option}
75    protected method _move {option x y}
76
77    protected method _state {comp}
78    protected method _fixSettings {what {value ""}}
79    protected method _getTransfuncData {dataobj comp}
80
81
82    private variable _outbuf       ;# buffer for outgoing commands
83
84    private variable _dlist ""     ;# list of data objects
85    private variable _dims ""      ;# dimensionality of data objects
86    private variable _obj2style    ;# maps dataobj => style settings
87    private variable _obj2ovride   ;# maps dataobj => style override
88    private variable _obj2id       ;# maps dataobj => heightmap ID in server
89    private variable _id2obj       ;# maps heightmap ID => dataobj in server
90    private variable _sendobjs ""  ;# list of data objs to send to server
91    private variable _receiveids   ;# list of data responses from the server
92    private variable _click        ;# info used for _move operations
93    private variable _limits       ;# autoscale min/max for all axes
94    private variable _view         ;# view params for 3D view
95
96    private common _settings      ;# Array used for checkbuttons and radiobuttons
97                       
98}
99
100itk::usual HeightmapViewer {
101    keep -background -foreground -cursor -font
102    keep -plotbackground -plotforeground
103}
104
105# ----------------------------------------------------------------------
106# CONSTRUCTOR
107# ----------------------------------------------------------------------
108itcl::body Rappture::HeightmapViewer::constructor {hostlist args} {
109    # Draw legend event
110    $_dispatcher register !legend
111    $_dispatcher dispatch $this !legend \
112        "[itcl::code $this _fixSettings legend]; list"
113    # Send dataobjs event
114    $_dispatcher register !send_dataobjs
115    $_dispatcher dispatch $this !send_dataobjs \
116        "[itcl::code $this _send_dataobjs]; list"
117    # Rebuild event
118    $_dispatcher register !rebuild
119    $_dispatcher dispatch $this !rebuild "[itcl::code $this _rebuild]; list"
120
121    set _outbuf ""
122
123    #
124    # Populate parser with commands handle incoming requests
125    #
126    $_parser alias image [itcl::code $this _receive_image]
127    $_parser alias legend [itcl::code $this ReceiveLegend]
128
129    # Initialize the view to some default parameters.
130    array set _view {
131        theta   45
132        phi     45
133        psi     0
134        zoom    1.0
135        xfocus  0
136        yfocus  0
137        zfocus  0
138    }
139    set _obj2id(count) 0
140
141    itk_component add zoom {
142        frame $itk_component(controls).zoom
143    } {
144        usual
145        rename -background -controlbackground controlBackground Background
146    }
147    pack $itk_component(zoom) -side top
148
149    itk_component add reset {
150        button $itk_component(zoom).reset \
151            -borderwidth 1 -padx 1 -pady 1 \
152            -bitmap [Rappture::icon reset] \
153            -command [itcl::code $this _zoom reset]
154    } {
155        usual
156        ignore -borderwidth
157        rename -highlightbackground -controlbackground controlBackground Background
158    }
159    pack $itk_component(reset) -side left -padx {4 1} -pady 4
160    Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
161
162    itk_component add zoomin {
163        button $itk_component(zoom).zin \
164            -borderwidth 1 -padx 1 -pady 1 \
165            -bitmap [Rappture::icon zoomin] \
166            -command [itcl::code $this _zoom in]
167    } {
168        usual
169        ignore -borderwidth
170        rename -highlightbackground -controlbackground controlBackground Background
171    }
172    pack $itk_component(zoomin) -side left -padx 1 -pady 4
173    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
174
175    itk_component add zoomout {
176        button $itk_component(zoom).zout \
177            -borderwidth 1 -padx 1 -pady 1 \
178            -bitmap [Rappture::icon zoomout] \
179            -command [itcl::code $this _zoom out]
180    } {
181        usual
182        ignore -borderwidth
183        rename -highlightbackground -controlbackground controlBackground Background
184    }
185    pack $itk_component(zoomout) -side left -padx {1 4} -pady 4
186    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
187
188    #
189    # Settings panel...
190    #
191    itk_component add settings {
192        button $itk_component(controls).settings -text "Settings..." \
193            -borderwidth 1 -relief flat -overrelief raised \
194            -padx 2 -pady 1 \
195            -command [list $itk_component(controls).panel activate $itk_component(controls).settings left]
196    } {
197        usual
198        ignore -borderwidth
199        rename -background -controlbackground controlBackground Background
200        rename -highlightbackground -controlbackground controlBackground Background
201    }
202    pack $itk_component(settings) -side top -pady 8
203
204    Rappture::Balloon $itk_component(controls).panel -title "Settings"
205    set inner [$itk_component(controls).panel component inner]
206   
207    frame $inner.f
208    pack $inner.f -side top -fill x
209    grid columnconfigure $inner.f 1 -weight 1
210    set fg [option get $itk_component(hull) font Font]
211   
212    set ::Rappture::HeightmapViewer::_settings($this-grid) 1
213    ::checkbutton $inner.f.grid \
214        -text "Grid" \
215        -variable ::Rappture::HeightmapViewer::_settings($this-grid) \
216        -command [itcl::code $this _fixSettings grid]
217    grid $inner.f.grid -row 0 -column 0 -sticky w
218
219    set ::Rappture::HeightmapViewer::_settings($this-axes) 1
220    ::checkbutton $inner.f.axes \
221        -text "Axes" \
222        -variable ::Rappture::HeightmapViewer::_settings($this-axes) \
223        -command [itcl::code $this _fixSettings axes]
224    grid $inner.f.axes -row 1 -column 0 -sticky w
225
226    set ::Rappture::HeightmapViewer::_settings($this-contourlines) 1
227    ::checkbutton $inner.f.contour \
228        -text "Contour Lines" \
229        -variable ::Rappture::HeightmapViewer::_settings($this-contourlines) \
230        -command [itcl::code $this _fixSettings contourlines]
231    grid $inner.f.contour -row 2 -column 0 -sticky w
232
233    set ::Rappture::HeightmapViewer::_settings($this-wireframe) "fill"
234    ::checkbutton $inner.f.wireframe \
235        -text "Wireframe" \
236        -onvalue "wireframe" -offvalue "fill" \
237        -variable ::Rappture::HeightmapViewer::_settings($this-wireframe) \
238        -command [itcl::code $this _fixSettings wireframe]
239    grid $inner.f.wireframe -row 3 -column 0 -sticky w
240
241    set ::Rappture::HeightmapViewer::_settings($this-shading) "smooth"
242    ::checkbutton $inner.f.shading \
243        -text "Flat Shading" \
244        -onvalue "flat" -offvalue "smooth" \
245        -variable ::Rappture::HeightmapViewer::_settings($this-shading) \
246        -command [itcl::code $this _fixSettings shading]
247    grid $inner.f.shading -row 4 -column 0 -sticky w
248
249    # Legend
250    set _image(legend) [image create photo]
251    itk_component add legend {
252        canvas $itk_component(area).legend -height 50 -highlightthickness 0
253    } {
254        usual
255        ignore -highlightthickness
256        rename -background -plotbackground plotBackground Background
257    }
258    pack $itk_component(legend) -side bottom -fill x
259    bind $itk_component(legend) <Configure> \
260        [list $_dispatcher event -idle !legend]
261
262    # set up bindings for rotation
263    bind $itk_component(3dview) <ButtonPress> \
264        [itcl::code $this _move click %x %y]
265    bind $itk_component(3dview) <B1-Motion> \
266        [itcl::code $this _move drag %x %y]
267    bind $itk_component(3dview) <ButtonRelease> \
268        [itcl::code $this _move release %x %y]
269    bind $itk_component(3dview) <Configure> \
270        [itcl::code $this _send "screen %w %h"]
271
272    set _image(download) [image create photo]
273
274    eval itk_initialize $args
275
276    Connect
277}
278
279# ----------------------------------------------------------------------
280# DESTRUCTOR
281# ----------------------------------------------------------------------
282itcl::body Rappture::HeightmapViewer::destructor {} {
283    set _sendobjs ""  ;# stop any send in progress
284    $_dispatcher cancel !rebuild
285    $_dispatcher cancel !send_dataobjs
286    image delete $_image(plot)
287    image delete $_image(legend)
288    image delete $_image(download)
289}
290
291# ----------------------------------------------------------------------
292# USAGE: add <dataobj> ?<settings>?
293#
294# Clients use this to add a data object to the plot.  The optional
295# <settings> are used to configure the plot.  Allowed settings are
296# -color, -brightness, -width, -linestyle, and -raise.
297# ----------------------------------------------------------------------
298itcl::body Rappture::HeightmapViewer::add {dataobj {settings ""}} {
299    array set params {
300        -color auto
301        -width 1
302        -linestyle solid
303        -brightness 0
304        -raise 0
305        -description ""
306        -param ""
307    }
308    foreach {opt val} $settings {
309        if {![info exists params($opt)]} {
310            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
311        }
312        set params($opt) $val
313    }
314    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
315        # can't handle -autocolors yet
316        set params(-color) black
317    }
318
319    set pos [lsearch -exact $dataobj $_dlist]
320    if {$pos < 0} {
321        lappend _dlist $dataobj
322        set _obj2ovride($dataobj-color) $params(-color)
323        set _obj2ovride($dataobj-width) $params(-width)
324        set _obj2ovride($dataobj-raise) $params(-raise)
325        $_dispatcher event -idle !rebuild
326    }
327}
328
329# ----------------------------------------------------------------------
330# USAGE: get ?-objects?
331# USAGE: get ?-image 3dview|legend?
332#
333# Clients use this to query the list of objects being plotted, in
334# order from bottom to top of this result.  The optional "-image"
335# flag can also request the internal images being shown.
336# ----------------------------------------------------------------------
337itcl::body Rappture::HeightmapViewer::get {args} {
338    if {[llength $args] == 0} {
339        set args "-objects"
340    }
341
342    set op [lindex $args 0]
343    switch -- $op {
344      -objects {
345        # put the dataobj list in order according to -raise options
346        set dlist $_dlist
347        foreach obj $dlist {
348            if { [info exists _obj2ovride($obj-raise)] &&
349                 $_obj2ovride($obj-raise)} {
350                set i [lsearch -exact $dlist $obj]
351                if {$i >= 0} {
352                    set dlist [lreplace $dlist $i $i]
353                    lappend dlist $obj
354                }
355            }
356        }
357        return $dlist
358      }
359      -image {
360        if {[llength $args] != 2} {
361            error "wrong # args: should be \"get -image 3dview|legend\""
362        }
363        switch -- [lindex $args end] {
364            3dview {
365                return $_image(plot)
366            }
367            legend {
368                return $_image(legend)
369            }
370            default {
371                error "bad image name \"[lindex $args end]\": should be 3dview or legend"
372            }
373        }
374      }
375      default {
376        error "bad option \"$op\": should be -objects or -image"
377      }
378    }
379}
380
381# ----------------------------------------------------------------------
382# USAGE: delete ?<dataobj1> <dataobj2> ...?
383#
384# Clients use this to delete a dataobj from the plot.  If no dataobjs
385# are specified, then all dataobjs are deleted.
386# ----------------------------------------------------------------------
387itcl::body Rappture::HeightmapViewer::delete {args} {
388    if {[llength $args] == 0} {
389        set args $_dlist
390    }
391
392    # delete all specified dataobjs
393    set changed 0
394    foreach dataobj $args {
395        set pos [lsearch -exact $_dlist $dataobj]
396        if {$pos >= 0} {
397            set _dlist [lreplace $_dlist $pos $pos]
398            foreach key [array names _obj2ovride $dataobj-*] {
399                unset _obj2ovride($key)
400            }
401            set changed 1
402        }
403    }
404
405    # if anything changed, then rebuild the plot
406    if {$changed} {
407        $_dispatcher event -idle !rebuild
408    }
409}
410
411# ----------------------------------------------------------------------
412# USAGE: scale ?<data1> <data2> ...?
413#
414# Sets the default limits for the overall plot according to the
415# limits of the data for all of the given <data> objects.  This
416# accounts for all objects--even those not showing on the screen.
417# Because of this, the limits are appropriate for all objects as
418# the user scans through data in the ResultSet viewer.
419# ----------------------------------------------------------------------
420itcl::body Rappture::HeightmapViewer::scale {args} {
421    foreach val {xmin xmax ymin ymax zmin zmax vmin vmax} {
422        set _limits($val) ""
423    }
424    foreach obj $args {
425        foreach axis {x y z v} {
426            foreach {min max} [$obj limits $axis] break
427            if {"" != $min && "" != $max} {
428                if {"" == $_limits(${axis}min)} {
429                    set _limits(${axis}min) $min
430                    set _limits(${axis}max) $max
431                } else {
432                    if {$min < $_limits(${axis}min)} {
433                        set _limits(${axis}min) $min
434                    }
435                    if {$max > $_limits(${axis}max)} {
436                        set _limits(${axis}max) $max
437                    }
438                }
439            }
440        }
441    }
442}
443
444# ----------------------------------------------------------------------
445# USAGE: download coming
446# USAGE: download controls <downloadCommand>
447# USAGE: download now
448#
449# Clients use this method to create a downloadable representation
450# of the plot.  Returns a list of the form {ext string}, where
451# "ext" is the file extension (indicating the type of data) and
452# "string" is the data itself.
453# ----------------------------------------------------------------------
454itcl::body Rappture::HeightmapViewer::download {option args} {
455    switch $option {
456        coming {
457            if {[catch {
458                blt::winop snap $itk_component(area) $_image(download)
459            }]} {
460                $_image(download) configure -width 1 -height 1
461                $_image(download) put #000000
462            }
463        }
464        controls {
465            # no controls for this download yet
466            return ""
467        }
468        now {
469            #
470            # Hack alert!  Need data in binary format,
471            # so we'll save to a file and read it back.
472            #
473            set tmpfile /tmp/image[pid].jpg
474            $_image(download) write $tmpfile -format jpeg
475            set fid [open $tmpfile r]
476            fconfigure $fid -encoding binary -translation binary
477            set bytes [read $fid]
478            close $fid
479            file delete -force $tmpfile
480
481            return [list .jpg $bytes]
482        }
483        default {
484            error "bad option \"$option\": should be coming, controls, now"
485        }
486    }
487}
488
489# ----------------------------------------------------------------------
490# USAGE: isconnected
491#
492# Clients use this method to see if we are currently connected to
493# a server.
494# ----------------------------------------------------------------------
495itcl::body Rappture::HeightmapViewer::isconnected {} {
496    return [VisViewer::IsConnected]
497}
498
499# ----------------------------------------------------------------------
500# USAGE: Connect ?<host:port>,<host:port>...?
501#
502# Clients use this method to establish a connection to a new
503# server, or to reestablish a connection to the previous server.
504# Any existing connection is automatically closed.
505# ----------------------------------------------------------------------
506itcl::body Rappture::HeightmapViewer::Connect {} {
507    Disconnect
508    set _hosts [GetServerList "nanovis"]
509    if { "" == $_hosts } {
510        return 0
511    }
512    set result [VisViewer::Connect $_hosts]
513    return $result
514}
515
516# ----------------------------------------------------------------------
517# USAGE: Disconnect
518#
519# Clients use this method to disconnect from the current rendering
520# server.
521# ----------------------------------------------------------------------
522itcl::body Rappture::HeightmapViewer::Disconnect {} {
523    VisViewer::Disconnect
524
525    set _outbuf ""
526    # disconnected -- no more data sitting on server
527    catch {unset _obj2id}
528    array unset _id2obj
529    set _obj2id(count) 0
530    set _id2obj(cound) 0
531    set _sendobjs ""
532}
533
534#
535# _send
536#
537#       Send commands off to the rendering server.  If we're currently
538#       sending data objects to the server, buffer the commands to be
539#       sent later.
540#
541itcl::body Rappture::HeightmapViewer::_send {string} {
542    if {[llength $_sendobjs] > 0} {
543        append _outbuf $string "\n"
544    } else {
545        if {[SendBytes $string]} {
546            foreach line [split $string \n] {
547                SendEcho >>line $line
548            }
549        }
550    }
551}
552
553# ----------------------------------------------------------------------
554# USAGE: _send_dataobjs
555#
556# Used internally to send a series of volume objects off to the
557# server.  Sends each object, a little at a time, with updates in
558# between so the interface doesn't lock up.
559# ----------------------------------------------------------------------
560itcl::body Rappture::HeightmapViewer::_send_dataobjs {} {
561    blt::busy hold $itk_component(hull); update idletasks
562
563    # Reset the overall limits
564    if { $_sendobjs != "" } {
565        set _limits(vmin) ""
566        set _limits(vmax) ""
567    }
568    foreach dataobj $_sendobjs {
569        foreach comp [$dataobj components] {
570            set data [$dataobj blob $comp]
571
572            foreach { vmin vmax }  [$dataobj limits v] break
573            if { $_limits(vmin) == "" || $vmin < $_limits(vmin) } {
574                set _limits(vmin) $vmin
575            }
576            if { $_limits(vmax) == "" || $vmax > $_limits(vmax) } {
577                set _limits(vmax) $vmax
578            }
579
580            # tell the engine to expect some data
581            set nbytes [string length $data]
582            if { ![SendBytes "heightmap data follows $nbytes"] } {
583                return
584            }
585            if { ![SendBytes $data] } {
586                return
587            }
588            set id $_obj2id(count)
589            incr _obj2id(count)
590            set _id2obj($id) [list $dataobj $comp]
591            set _obj2id($dataobj-$comp) $id
592            set _receiveids($id) 1
593
594            #
595            # Determine the transfer function needed for this volume
596            # and make sure that it's defined on the server.
597            #
598            foreach {sname cmap wmap} [_getTransfuncData $dataobj $comp] break
599            set cmdstr [list "transfunc" "define" $sname $cmap $wmap]
600            if {![SendBytes $cmdstr]} {
601                return
602            }
603            set _obj2style($dataobj-$comp) $sname
604        }
605    }
606    set _sendobjs ""
607    blt::busy release $itk_component(hull)
608
609    # activate the proper volume
610    set first [lindex [get] 0]
611    if {"" != $first} {
612        set axis [$first hints updir]
613        if {"" != $axis} {
614            _send "up $axis"
615        }
616    }
617
618    foreach key [array names _obj2id *-*] {
619        set state [string match $first-* $key]
620        _send "heightmap data visible $state $_obj2id($key)"
621        if {[info exists _obj2style($key)]} {
622            _send "heightmap transfunc $_obj2style($key) $_obj2id($key)"
623        }
624    }
625
626    # if there are any commands in the buffer, send them now that we're done
627    SendBytes $_outbuf
628    set _outbuf ""
629
630    $_dispatcher event -idle !legend
631}
632
633# ----------------------------------------------------------------------
634# USAGE: _receive_image -bytes <size>
635#
636# Invoked automatically whenever the "image" command comes in from
637# the rendering server.  Indicates that binary image data with the
638# specified <size> will follow.
639# ----------------------------------------------------------------------
640itcl::body Rappture::HeightmapViewer::_receive_image {option size} {
641    if {[isconnected]} {
642        set bytes [ReceiveBytes $size]
643        $_image(plot) configure -data $bytes
644        ReceiveEcho <<line "<read $size bytes for [image width $_image(plot)]x[image height $_image(plot)] image>"
645    }
646}
647
648# ----------------------------------------------------------------------
649# USAGE: ReceiveLegend <volume> <vmin> <vmax> <size>
650#
651# Invoked automatically whenever the "legend" 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::ReceiveLegend {ivol vmin vmax size} {
656    if { [isconnected] } {
657        set bytes [ReceiveBytes $size]
658        $_image(legend) configure -data $bytes
659        ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
660
661        set c $itk_component(legend)
662        set w [winfo width $c]
663        set h [winfo height $c]
664        if {"" == [$c find withtag transfunc]} {
665            $c create image 10 10 -anchor nw \
666                 -image $_image(legend) -tags transfunc
667
668            $c create text 10 [expr {$h-8}] -anchor sw \
669                 -fill $itk_option(-plotforeground) -tags vmin
670            $c create text [expr {$w-10}] [expr {$h-8}] -anchor se \
671                 -fill $itk_option(-plotforeground) -tags vmax
672        }
673        $c itemconfigure vmin -text $vmin
674        $c coords vmin 10 [expr {$h-8}]
675        $c itemconfigure vmax -text $vmax
676        $c coords vmax [expr {$w-10}] [expr {$h-8}]
677    }
678}
679
680# ----------------------------------------------------------------------
681# USAGE: _rebuild
682#
683# Called automatically whenever something changes that affects the
684# data in the widget.  Clears any existing data and rebuilds the
685# widget to display new data.
686# ----------------------------------------------------------------------
687itcl::body Rappture::HeightmapViewer::_rebuild {} {
688    # in the midst of sending data? then bail out
689    if {[llength $_sendobjs] > 0} {
690        return
691    }
692    # Find any new data that needs to be sent to the server.  Queue this up on
693    # the _sendobjs list, and send it out a little at a time.  Do this first,
694    # before we rebuild the rest.
695    foreach dataobj [get] {
696        set comp [lindex [$dataobj components] 0]
697        if {![info exists _obj2id($dataobj-$comp)]} {
698            set i [lsearch -exact $_sendobjs $dataobj]
699            if {$i < 0} {
700                lappend _sendobjs $dataobj
701            }
702        }
703    }
704    if {[llength $_sendobjs] > 0} {
705        # Send off new data objects
706        $_dispatcher event -idle !send_dataobjs
707    } else {
708        # Nothing to send -- activate the proper volume
709        set first [lindex [get] 0]
710        if {"" != $first} {
711            set axis [$first hints updir]
712            if {"" != $axis} {
713                _send "up $axis"
714            }
715        }
716        foreach key [array names _obj2id *-*] {
717            set state [string match $first-* $key]
718            _send "heightmap data visible $state $_obj2id($key)"
719            if {[info exists _obj2style($key)]} {
720                _send "heightmap transfunc $_obj2style($key) $_obj2id($key)"
721            }
722        }
723        $_dispatcher event -idle !legend
724    }
725
726    #
727    # Reset the camera and other view parameters
728    #
729    _send "camera angle [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]"
730    _send "camera zoom $_view(zoom)"
731
732     if {"" == $itk_option(-plotoutline)} {
733         _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
734     }
735    _fixSettings shading
736    _fixSettings wireframe
737    _fixSettings grid
738    _fixSettings axes
739    _fixSettings contourlines
740}
741
742# ----------------------------------------------------------------------
743# USAGE: _zoom in
744# USAGE: _zoom out
745# USAGE: _zoom reset
746#
747# Called automatically when the user clicks on one of the zoom
748# controls for this widget.  Changes the zoom for the current view.
749# ----------------------------------------------------------------------
750itcl::body Rappture::HeightmapViewer::_zoom {option} {
751    switch -- $option {
752        "in" {
753            set _view(zoom) [expr {$_view(zoom)*1.25}]
754        }
755        "out" {
756            set _view(zoom) [expr {$_view(zoom)*0.8}]
757        }
758        "reset" {
759            array set _view {
760                theta   45
761                phi     45
762                psi     0
763                zoom    1.0
764            }
765            set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
766            _send "camera angle $xyz"
767        }
768    }
769    _send "camera zoom $_view(zoom)"
770}
771
772# ----------------------------------------------------------------------
773# USAGE: _move click <x> <y>
774# USAGE: _move drag <x> <y>
775# USAGE: _move release <x> <y>
776#
777# Called automatically when the user clicks/drags/releases in the
778# plot area.  Moves the plot according to the user's actions.
779# ----------------------------------------------------------------------
780itcl::body Rappture::HeightmapViewer::_move {option x y} {
781    switch -- $option {
782        click {
783            $itk_component(3dview) configure -cursor fleur
784            set _click(x)       $x
785            set _click(y)       $y
786            set _click(theta)   $_view(theta)
787            set _click(phi)     $_view(phi)
788        }
789        drag {
790            if {[array size _click] == 0} {
791                _move click $x $y
792            } else {
793                set w [winfo width $itk_component(3dview)]
794                set h [winfo height $itk_component(3dview)]
795                if {$w <= 0 || $h <= 0} {
796                    return
797                }
798
799                if {[catch {
800                    # this fails sometimes for no apparent reason
801                    set dx [expr {double($x-$_click(x))/$w}]
802                    set dy [expr {double($y-$_click(y))/$h}]
803                }]} {
804                    return
805                }
806
807                #
808                # Rotate the camera in 3D
809                #
810                if {$_view(psi) > 90 || $_view(psi) < -90} {
811                    # when psi is flipped around, theta moves backwards
812                    set dy [expr {-$dy}]
813                }
814                set theta [expr {$_view(theta) - $dy*180}]
815                while {$theta < 0} { set theta [expr {$theta+180}] }
816                while {$theta > 180} { set theta [expr {$theta-180}] }
817
818                if {abs($theta) >= 30 && abs($theta) <= 160} {
819                    set phi [expr {$_view(phi) - $dx*360}]
820                    while {$phi < 0} { set phi [expr {$phi+360}] }
821                    while {$phi > 360} { set phi [expr {$phi-360}] }
822                    set psi $_view(psi)
823                } else {
824                    set phi $_view(phi)
825                    set psi [expr {$_view(psi) - $dx*360}]
826                    while {$psi < -180} { set psi [expr {$psi+360}] }
827                    while {$psi > 180} { set psi [expr {$psi-360}] }
828                }
829
830                set _view(theta)        $theta
831                set _view(phi)          $phi
832                set _view(psi)          $psi
833                set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
834                _send "camera angle $xyz"
835                set _click(x) $x
836                set _click(y) $y
837            }
838        }
839        release {
840            _move drag $x $y
841            $itk_component(3dview) configure -cursor ""
842            catch {unset _click}
843        }
844        default {
845            error "bad option \"$option\": should be click, drag, release"
846        }
847    }
848}
849
850# ----------------------------------------------------------------------
851# USAGE: _state <component>
852#
853# Used internally to determine the state of a toggle button.
854# The <component> is the itk component name of the button.
855# Returns on/off for the state of the button.
856# ----------------------------------------------------------------------
857itcl::body Rappture::HeightmapViewer::_state {comp} {
858    if {[$itk_component($comp) cget -relief] == "sunken"} {
859        return "on"
860    }
861    return "off"
862}
863
864# ----------------------------------------------------------------------
865# USAGE: _fixSettings <what> ?<value>?
866#
867# Used internally to update rendering settings whenever parameters
868# change in the popup settings panel.  Sends the new settings off
869# to the back end.
870# ----------------------------------------------------------------------
871itcl::body Rappture::HeightmapViewer::_fixSettings { what {value ""} } {
872    switch -- $what {
873        "legend" {
874            set lineht [font metrics $itk_option(-font) -linespace]
875            set w [expr {[winfo width $itk_component(legend)]-20}]
876            set h [expr {[winfo height $itk_component(legend)]-20-$lineht}]
877            set imap ""
878           
879            set dataobj [lindex [get] 0]
880            if {"" != $dataobj} {
881                set comp [lindex [$dataobj components] 0]
882                if {[info exists _obj2id($dataobj-$comp)]} {
883                    set imap $_obj2id($dataobj-$comp)
884                }
885            }
886            if {$w > 0 && $h > 0 && "" != $imap} {
887                _send "heightmap legend $imap $w $h"
888            } else {
889                $itk_component(legend) delete all
890            }
891        }
892        "grid" {
893            if { [isconnected] } {
894                _send "grid visible $_settings($this-grid)"
895            }
896        }
897        "axes" {
898            if { [isconnected] } {
899                _send "axis visible $_settings($this-axes)"
900            }
901        }
902        "shading" {
903            if { [isconnected] } {
904                _send "heightmap shading $_settings($this-shading)"
905            }
906        }
907        "wireframe" {
908            if { [isconnected] } {
909                _send "heightmap polygon $_settings($this-wireframe)"
910            }
911        }
912        "contourlines" {
913            if {[isconnected]} {
914                set dataobj [lindex [get] 0]
915                if {"" != $dataobj} {
916                    set comp [lindex [$dataobj components] 0]
917                    if {[info exists _obj2id($dataobj-$comp)]} {
918                        set i $_obj2id($dataobj-$comp)
919                        set bool $_settings($this-contourlines)
920                        _send "heightmap linecontour visible $bool $i"
921                    }
922                }
923            }
924        }
925        default {
926            error "don't know how to fix $what: should be grid, axes, contourlines, or legend"
927        }
928    }
929}
930
931# ----------------------------------------------------------------------
932# USAGE: _getTransfuncData <dataobj> <comp>
933#
934# Used internally to compute the colormap and alpha map used to define
935# a transfer function for the specified component in a data object.
936# Returns: name {v r g b ...} {v w ...}
937# ----------------------------------------------------------------------
938itcl::body Rappture::HeightmapViewer::_getTransfuncData {dataobj comp} {
939    array set style {
940        -color rainbow
941        -levels 6
942        -opacity 0.5
943    }
944    array set style [lindex [$dataobj components -style $comp] 0]
945    set sname "$style(-color):$style(-levels):$style(-opacity)"
946
947    if {$style(-color) == "rainbow"} {
948        set style(-color) "white:yellow:green:cyan:blue:magenta"
949    }
950    set clist [split $style(-color) :]
951    set color white
952    set cmap "0.0 [Color2RGB $color] "
953    set range [expr $_limits(vmax) - $_limits(vmin)]
954    for {set i 0} {$i < [llength $clist]} {incr i} {
955        set xval [expr {double($i+1)/([llength $clist]+1)}]
956        set color [lindex $clist $i]
957        append cmap "$xval [Color2RGB $color] "
958    }
959    append cmap "1.0 [Color2RGB $color] "
960
961    set opacity $style(-opacity)
962    set levels $style(-levels)
963    set wmap {}
964    if {[string is int $levels]} {
965        lappend wmap 0.0 0.0
966        set delta [expr {0.125/($levels+1)}]
967        for {set i 1} {$i <= $levels} {incr i} {
968            # add spikes in the middle
969            set xval [expr {double($i)/($levels+1)}]
970            lappend wmap [expr {$xval-$delta-0.01}] 0.0
971            lappend wmap [expr {$xval-$delta}] $opacity
972            lappend wmap [expr {$xval+$delta}] $opacity
973            lappend wmap [expr {$xval+$delta+0.01}] 0.0
974        }
975        lappend wmap 1.0 0.0
976    } else {
977        lappend wmap 0.0 0.0
978        set delta 0.05
979        foreach xval [split $levels ,] {
980            lappend wmap [expr {$xval-$delta}] 0.0 
981            lappend $xval $opacity
982            lappend [expr {$xval+$delta}] 0.0
983        }
984        lappend wmap 1.0 0.0
985    }
986    return [list $sname $cmap $wmap]
987}
988
989# ----------------------------------------------------------------------
990# CONFIGURATION OPTION: -plotbackground
991# ----------------------------------------------------------------------
992itcl::configbody Rappture::HeightmapViewer::plotbackground {
993    foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break
994    #fix this!
995    #_send "color background $r $g $b"
996}
997
998# ----------------------------------------------------------------------
999# CONFIGURATION OPTION: -plotforeground
1000# ----------------------------------------------------------------------
1001itcl::configbody Rappture::HeightmapViewer::plotforeground {
1002    foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break
1003    #fix this!
1004    #_send "color background $r $g $b"
1005}
1006
1007# ----------------------------------------------------------------------
1008# CONFIGURATION OPTION: -plotoutline
1009# ----------------------------------------------------------------------
1010itcl::configbody Rappture::HeightmapViewer::plotoutline {
1011    if {[isconnected]} {
1012        _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
1013    }
1014}
Note: See TracBrowser for help on using the repository browser.