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

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

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