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

Last change on this file since 921 was 921, checked in by gah, 17 years ago

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