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

Last change on this file since 1120 was 1120, checked in by gah, 16 years ago
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) 0
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            }
586            if { ![SendBytes $data] } {
587                return
588            }
589            set id $_obj2id(count)
590            incr _obj2id(count)
591            set _id2obj($id) [list $dataobj $comp]
592            set _obj2id($dataobj-$comp) $id
593            set _receiveids($id) 1
594
595            #
596            # Determine the transfer function needed for this volume
597            # and make sure that it's defined on the server.
598            #
599            foreach {sname cmap wmap} [_getTransfuncData $dataobj $comp] break
600            set cmdstr [list "transfunc" "define" $sname $cmap $wmap]
601            if {![SendBytes $cmdstr]} {
602                return
603            }
604            set _obj2style($dataobj-$comp) $sname
605        }
606    }
607    set _sendobjs ""
608    blt::busy release $itk_component(hull)
609
610    # activate the proper volume
611    set first [lindex [get] 0]
612    if {"" != $first} {
613        set axis [$first hints updir]
614        if {"" != $axis} {
615            _send "up $axis"
616        }
617    }
618
619    foreach key [array names _obj2id *-*] {
620        set state [string match $first-* $key]
621        _send "heightmap data visible $state $_obj2id($key)"
622        if {[info exists _obj2style($key)]} {
623            _send "heightmap transfunc $_obj2style($key) $_obj2id($key)"
624        }
625    }
626
627    # if there are any commands in the buffer, send them now that we're done
628    SendBytes $_outbuf
629    set _outbuf ""
630
631    $_dispatcher event -idle !legend
632}
633
634# ----------------------------------------------------------------------
635# USAGE: _receive_image -bytes <size>
636#
637# Invoked automatically whenever the "image" command comes in from
638# the rendering server.  Indicates that binary image data with the
639# specified <size> will follow.
640# ----------------------------------------------------------------------
641itcl::body Rappture::HeightmapViewer::_receive_image {option size} {
642    if {[isconnected]} {
643        set bytes [ReceiveBytes $size]
644        $_image(plot) configure -data $bytes
645        ReceiveEcho <<line "<read $size bytes for [image width $_image(plot)]x[image height $_image(plot)] image>"
646    }
647}
648
649# ----------------------------------------------------------------------
650# USAGE: ReceiveLegend <volume> <vmin> <vmax> <size>
651#
652# Invoked automatically whenever the "legend" command comes in from
653# the rendering server.  Indicates that binary image data with the
654# specified <size> will follow.
655# ----------------------------------------------------------------------
656itcl::body Rappture::HeightmapViewer::ReceiveLegend {ivol vmin vmax size} {
657    if { [isconnected] } {
658        set bytes [ReceiveBytes $size]
659        $_image(legend) configure -data $bytes
660        ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
661
662        set c $itk_component(legend)
663        set w [winfo width $c]
664        set h [winfo height $c]
665        if {"" == [$c find withtag transfunc]} {
666            $c create image 10 10 -anchor nw \
667                 -image $_image(legend) -tags transfunc
668
669            $c create text 10 [expr {$h-8}] -anchor sw \
670                 -fill $itk_option(-plotforeground) -tags vmin
671            $c create text [expr {$w-10}] [expr {$h-8}] -anchor se \
672                 -fill $itk_option(-plotforeground) -tags vmax
673        }
674        $c itemconfigure vmin -text $vmin
675        $c coords vmin 10 [expr {$h-8}]
676        $c itemconfigure vmax -text $vmax
677        $c coords vmax [expr {$w-10}] [expr {$h-8}]
678    }
679}
680
681# ----------------------------------------------------------------------
682# USAGE: _rebuild
683#
684# Called automatically whenever something changes that affects the
685# data in the widget.  Clears any existing data and rebuilds the
686# widget to display new data.
687# ----------------------------------------------------------------------
688itcl::body Rappture::HeightmapViewer::_rebuild {} {
689    # in the midst of sending data? then bail out
690    if {[llength $_sendobjs] > 0} {
691        return
692    }
693    # Find any new data that needs to be sent to the server.  Queue this up on
694    # the _sendobjs list, and send it out a little at a time.  Do this first,
695    # before we rebuild the rest.
696    foreach dataobj [get] {
697        set comp [lindex [$dataobj components] 0]
698        if {![info exists _obj2id($dataobj-$comp)]} {
699            set i [lsearch -exact $_sendobjs $dataobj]
700            if {$i < 0} {
701                lappend _sendobjs $dataobj
702            }
703        }
704    }
705    if {[llength $_sendobjs] > 0} {
706        # Send off new data objects
707        $_dispatcher event -idle !send_dataobjs
708    } else {
709        # Nothing to send -- activate the proper volume
710        set first [lindex [get] 0]
711        if {"" != $first} {
712            set axis [$first hints updir]
713            if {"" != $axis} {
714                _send "up $axis"
715            }
716        }
717        foreach key [array names _obj2id *-*] {
718            set state [string match $first-* $key]
719            _send "heightmap data visible $state $_obj2id($key)"
720            if {[info exists _obj2style($key)]} {
721                _send "heightmap transfunc $_obj2style($key) $_obj2id($key)"
722            }
723        }
724        $_dispatcher event -idle !legend
725    }
726
727    #
728    # Reset the camera and other view parameters
729    #
730    _send "camera angle [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]"
731    _send "camera zoom $_view(zoom)"
732
733     if {"" == $itk_option(-plotoutline)} {
734         _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
735     }
736    _fixSettings shading
737    _fixSettings wireframe
738    _fixSettings grid
739    _fixSettings axes
740    _fixSettings contourlines
741}
742
743# ----------------------------------------------------------------------
744# USAGE: _zoom in
745# USAGE: _zoom out
746# USAGE: _zoom reset
747#
748# Called automatically when the user clicks on one of the zoom
749# controls for this widget.  Changes the zoom for the current view.
750# ----------------------------------------------------------------------
751itcl::body Rappture::HeightmapViewer::_zoom {option} {
752    switch -- $option {
753        "in" {
754            set _view(zoom) [expr {$_view(zoom)*1.25}]
755        }
756        "out" {
757            set _view(zoom) [expr {$_view(zoom)*0.8}]
758        }
759        "reset" {
760            array set _view {
761                theta   45
762                phi     45
763                psi     0
764                zoom    1.0
765            }
766            set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
767            _send "camera angle $xyz"
768        }
769    }
770    _send "camera zoom $_view(zoom)"
771}
772
773# ----------------------------------------------------------------------
774# USAGE: _move click <x> <y>
775# USAGE: _move drag <x> <y>
776# USAGE: _move release <x> <y>
777#
778# Called automatically when the user clicks/drags/releases in the
779# plot area.  Moves the plot according to the user's actions.
780# ----------------------------------------------------------------------
781itcl::body Rappture::HeightmapViewer::_move {option x y} {
782    switch -- $option {
783        click {
784            $itk_component(3dview) configure -cursor fleur
785            set _click(x)       $x
786            set _click(y)       $y
787            set _click(theta)   $_view(theta)
788            set _click(phi)     $_view(phi)
789        }
790        drag {
791            if {[array size _click] == 0} {
792                _move click $x $y
793            } else {
794                set w [winfo width $itk_component(3dview)]
795                set h [winfo height $itk_component(3dview)]
796                if {$w <= 0 || $h <= 0} {
797                    return
798                }
799
800                if {[catch {
801                    # this fails sometimes for no apparent reason
802                    set dx [expr {double($x-$_click(x))/$w}]
803                    set dy [expr {double($y-$_click(y))/$h}]
804                }]} {
805                    return
806                }
807
808                #
809                # Rotate the camera in 3D
810                #
811                if {$_view(psi) > 90 || $_view(psi) < -90} {
812                    # when psi is flipped around, theta moves backwards
813                    set dy [expr {-$dy}]
814                }
815                set theta [expr {$_view(theta) - $dy*180}]
816                while {$theta < 0} { set theta [expr {$theta+180}] }
817                while {$theta > 180} { set theta [expr {$theta-180}] }
818
819                if {abs($theta) >= 30 && abs($theta) <= 160} {
820                    set phi [expr {$_view(phi) - $dx*360}]
821                    while {$phi < 0} { set phi [expr {$phi+360}] }
822                    while {$phi > 360} { set phi [expr {$phi-360}] }
823                    set psi $_view(psi)
824                } else {
825                    set phi $_view(phi)
826                    set psi [expr {$_view(psi) - $dx*360}]
827                    while {$psi < -180} { set psi [expr {$psi+360}] }
828                    while {$psi > 180} { set psi [expr {$psi-360}] }
829                }
830
831                set _view(theta)        $theta
832                set _view(phi)          $phi
833                set _view(psi)          $psi
834                set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
835                _send "camera angle $xyz"
836                set _click(x) $x
837                set _click(y) $y
838            }
839        }
840        release {
841            _move drag $x $y
842            $itk_component(3dview) configure -cursor ""
843            catch {unset _click}
844        }
845        default {
846            error "bad option \"$option\": should be click, drag, release"
847        }
848    }
849}
850
851# ----------------------------------------------------------------------
852# USAGE: _state <component>
853#
854# Used internally to determine the state of a toggle button.
855# The <component> is the itk component name of the button.
856# Returns on/off for the state of the button.
857# ----------------------------------------------------------------------
858itcl::body Rappture::HeightmapViewer::_state {comp} {
859    if {[$itk_component($comp) cget -relief] == "sunken"} {
860        return "on"
861    }
862    return "off"
863}
864
865# ----------------------------------------------------------------------
866# USAGE: _fixSettings <what> ?<value>?
867#
868# Used internally to update rendering settings whenever parameters
869# change in the popup settings panel.  Sends the new settings off
870# to the back end.
871# ----------------------------------------------------------------------
872itcl::body Rappture::HeightmapViewer::_fixSettings { what {value ""} } {
873    switch -- $what {
874        "legend" {
875            set lineht [font metrics $itk_option(-font) -linespace]
876            set w [expr {[winfo width $itk_component(legend)]-20}]
877            set h [expr {[winfo height $itk_component(legend)]-20-$lineht}]
878            set imap ""
879           
880            set dataobj [lindex [get] 0]
881            if {"" != $dataobj} {
882                set comp [lindex [$dataobj components] 0]
883                if {[info exists _obj2id($dataobj-$comp)]} {
884                    set imap $_obj2id($dataobj-$comp)
885                }
886            }
887            if {$w > 0 && $h > 0 && "" != $imap} {
888                _send "heightmap legend $imap $w $h"
889            } else {
890                $itk_component(legend) delete all
891            }
892        }
893        "grid" {
894            if { [isconnected] } {
895                _send "grid visible $_settings($this-grid)"
896            }
897        }
898        "axes" {
899            if { [isconnected] } {
900                _send "axis visible $_settings($this-axes)"
901            }
902        }
903        "shading" {
904            if { [isconnected] } {
905                _send "heightmap shading $_settings($this-shading)"
906            }
907        }
908        "wireframe" {
909            if { [isconnected] } {
910                _send "heightmap polygon $_settings($this-wireframe)"
911            }
912        }
913        "contourlines" {
914            if {[isconnected]} {
915                set dataobj [lindex [get] 0]
916                if {"" != $dataobj} {
917                    set comp [lindex [$dataobj components] 0]
918                    if {[info exists _obj2id($dataobj-$comp)]} {
919                        set i $_obj2id($dataobj-$comp)
920                        set bool $_settings($this-contourlines)
921                        _send "heightmap linecontour visible $bool $i"
922                    }
923                }
924            }
925        }
926        default {
927            error "don't know how to fix $what: should be grid, axes, contourlines, or legend"
928        }
929    }
930}
931
932# ----------------------------------------------------------------------
933# USAGE: _getTransfuncData <dataobj> <comp>
934#
935# Used internally to compute the colormap and alpha map used to define
936# a transfer function for the specified component in a data object.
937# Returns: name {v r g b ...} {v w ...}
938# ----------------------------------------------------------------------
939itcl::body Rappture::HeightmapViewer::_getTransfuncData {dataobj comp} {
940    array set style {
941        -color rainbow
942        -levels 6
943        -opacity 0.5
944    }
945    array set style [lindex [$dataobj components -style $comp] 0]
946    set sname "$style(-color):$style(-levels):$style(-opacity)"
947
948    if {$style(-color) == "rainbow"} {
949        set style(-color) "white:yellow:green:cyan:blue:magenta"
950    }
951    set clist [split $style(-color) :]
952    set color white
953    set cmap "0.0 [Color2RGB $color] "
954    set range [expr $_limits(vmax) - $_limits(vmin)]
955    for {set i 0} {$i < [llength $clist]} {incr i} {
956        set xval [expr {double($i+1)/([llength $clist]+1)}]
957        set color [lindex $clist $i]
958        append cmap "$xval [Color2RGB $color] "
959    }
960    append cmap "1.0 [Color2RGB $color] "
961
962    set opacity $style(-opacity)
963    set levels $style(-levels)
964    set wmap {}
965    if {[string is int $levels]} {
966        lappend wmap 0.0 0.0
967        set delta [expr {0.125/($levels+1)}]
968        for {set i 1} {$i <= $levels} {incr i} {
969            # add spikes in the middle
970            set xval [expr {double($i)/($levels+1)}]
971            lappend wmap [expr {$xval-$delta-0.01}] 0.0
972            lappend wmap [expr {$xval-$delta}] $opacity
973            lappend wmap [expr {$xval+$delta}] $opacity
974            lappend wmap [expr {$xval+$delta+0.01}] 0.0
975        }
976        lappend wmap 1.0 0.0
977    } else {
978        lappend wmap 0.0 0.0
979        set delta 0.05
980        foreach xval [split $levels ,] {
981            lappend wmap [expr {$xval-$delta}] 0.0 
982            lappend $xval $opacity
983            lappend [expr {$xval+$delta}] 0.0
984        }
985        lappend wmap 1.0 0.0
986    }
987    return [list $sname $cmap $wmap]
988}
989
990# ----------------------------------------------------------------------
991# CONFIGURATION OPTION: -plotbackground
992# ----------------------------------------------------------------------
993itcl::configbody Rappture::HeightmapViewer::plotbackground {
994    foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break
995    #fix this!
996    #_send "color background $r $g $b"
997}
998
999# ----------------------------------------------------------------------
1000# CONFIGURATION OPTION: -plotforeground
1001# ----------------------------------------------------------------------
1002itcl::configbody Rappture::HeightmapViewer::plotforeground {
1003    foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break
1004    #fix this!
1005    #_send "color background $r $g $b"
1006}
1007
1008# ----------------------------------------------------------------------
1009# CONFIGURATION OPTION: -plotoutline
1010# ----------------------------------------------------------------------
1011itcl::configbody Rappture::HeightmapViewer::plotoutline {
1012    if {[isconnected]} {
1013        _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
1014    }
1015}
Note: See TracBrowser for help on using the repository browser.