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

Last change on this file since 1394 was 1391, checked in by mmc, 15 years ago

Final touches on the sidebar:

  • click tabs to open/close
  • added tooltips to tabs
  • fixed highlight thickness for buttons in control area
  • added padding above first control button
  • snap to close when sidebar is too small
  • sidebar never resize sash never gets lost when window is sized smaller
  • new icons for volume & cutplane in nanovis sidebar
  • added "show volume" control to volume options in nanovis sidebar
File size: 37.3 KB
Line 
1
2# ----------------------------------------------------------------------
3#  COMPONENT: heightmapviewer - 3D volume rendering
4#
5#  This widget performs volume rendering on 3D scalar/vector datasets.
6#  It connects to the Nanovis server running on a rendering farm,
7#  transmits data, and displays the results.
8# ======================================================================
9#  AUTHOR:  Michael McLennan, Purdue University
10#  Copyright (c) 2004-2005  Purdue Research Foundation
11#
12#  See the file "license.terms" for information on usage and
13#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14# ======================================================================
15
16package require Itk
17package require BLT
18package require Img
19
20option add *HeightmapViewer.width 4i widgetDefault
21option add *HeightmapViewer.height 4i widgetDefault
22option add *HeightmapViewer.foreground black widgetDefault
23option add *HeightmapViewer.plotBackground black widgetDefault
24option add *HeightmapViewer.plotForeground white widgetDefault
25option add *HeightmapViewer.plotOutline white widgetDefault
26option add *HeightmapViewer.font \
27    -*-helvetica-medium-r-normal-*-12-* widgetDefault
28
29# must use this name -- plugs into Rappture::resources::load
30proc HeightmapViewer_init_resources {} {
31    Rappture::resources::register \
32        nanovis_server Rappture::HeightmapViewer::SetServerList
33}
34
35itcl::class Rappture::HeightmapViewer {
36    inherit Rappture::VisViewer
37
38    itk_option define -plotforeground plotForeground Foreground ""
39    itk_option define -plotbackground plotBackground Background ""
40    itk_option define -plotoutline plotOutline PlotOutline ""
41
42    constructor { hostlist args } {
43        Rappture::VisViewer::constructor $hostlist
44    } {
45        # defined below
46    }
47    destructor {
48        # defined below
49    }
50
51    public proc SetServerList { namelist } {
52        Rappture::VisViewer::SetServerList "nanovis" $namelist
53    }
54    public method add {dataobj {settings ""}}
55    public method get {args}
56    public method delete {args}
57    public method scale {args}
58    public method download {option args}
59    public method parameters {title args} {
60        # do nothing
61    }
62    public method camera {option args}
63    protected method Connect {}
64    protected method Disconnect {}
65
66    protected method _send {string}
67    protected method _send_dataobjs {}
68    protected method ReceiveImage { args }
69    private method _ReceiveLegend {tf vmin vmax size}
70    private method _BuildViewTab {}
71    private method _BuildCameraTab {}
72    private method _PanCamera {}
73    protected method _receive_echo {channel {data ""}}
74
75    protected method _rebuild {}
76    protected method _zoom {option}
77    protected method _pan {option x y}
78    protected method _rotate {option x y}
79
80    protected method _state {comp}
81    protected method _fixSettings {what {value ""}}
82    protected method _getTransfuncData {dataobj comp}
83    private method Resize { w h }
84
85    private variable outbuf_       ;# buffer for outgoing commands
86
87    private variable dlist_ ""     ;# list of data objects
88    private variable obj2style_    ;# maps dataobj => style settings
89    private variable obj2ovride_   ;# maps dataobj => style override
90    private variable obj2id_       ;# maps dataobj => heightmap ID in server
91    private variable id2obj_       ;# maps heightmap ID => dataobj in server
92    private variable sendobjs_ ""  ;# list of data objs to send to server
93    private variable receiveIds_   ;# list of data responses from the server
94    private variable click_        ;# info used for _rotate operations
95    private variable limits_       ;# autoscale min/max for all axes
96    private variable view_         ;# view params for 3D view
97    private common settings_      ;# Array used for checkbuttons and radiobuttons
98    private common hardcopy_
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 ReceiveImage]
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        pan-x   0
137        pan-y   0
138    }
139    set obj2id_(count) 0
140
141    set f [$itk_component(main) component controls]
142    itk_component add zoom {
143        frame $f.zoom
144    }
145    pack $itk_component(zoom) -side top
146
147    itk_component add reset {
148        button $f.reset -borderwidth 1 -padx 1 -pady 1 \
149            -highlightthickness 0 \
150            -image [Rappture::icon reset-view] \
151            -command [itcl::code $this _zoom reset]
152    } {
153        usual
154        ignore -highlightthickness
155    }
156    pack $itk_component(reset) -side top -padx 1 -pady { 4 0 }
157    Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
158
159    itk_component add zoomin {
160        button $f.zin -borderwidth 1 -padx 1 -pady 1 \
161            -highlightthickness 0 \
162            -image [Rappture::icon zoom-in] \
163            -command [itcl::code $this _zoom in]
164    } {
165        usual
166        ignore -highlightthickness
167    }
168    pack $itk_component(zoomin) -side top -padx 1 -pady { 4 0 }
169    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
170
171    itk_component add zoomout {
172        button $f.zout -borderwidth 1 -padx 1 -pady 1 \
173            -highlightthickness 0 \
174            -image [Rappture::icon zoom-out] \
175            -command [itcl::code $this _zoom out]
176    } {
177        usual
178        ignore -highlightthickness
179    }
180    pack $itk_component(zoomout) -side top -padx 1 -pady { 4 }
181    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
182
183    _BuildViewTab
184    _BuildCameraTab
185
186    # Legend
187    set _image(legend) [image create photo]
188    itk_component add legend {
189        canvas $itk_component(plotarea).legend -width 30 -highlightthickness 0
190    } {
191        usual
192        ignore -highlightthickness
193        rename -background -plotbackground plotBackground Background
194    }
195    set w [expr [winfo reqwidth $itk_component(hull)] - 80]
196    pack forget $itk_component(3dview)
197    pack $itk_component(3dview) -side left -fill both -expand yes
198    pack $itk_component(legend) -side left -fill y
199
200    bind $itk_component(legend) <Configure> \
201        [list $_dispatcher event -idle !legend]
202
203    # Bindings for rotation via mouse
204    bind $itk_component(3dview) <ButtonPress-1> \
205        [itcl::code $this _rotate click %x %y]
206    bind $itk_component(3dview) <B1-Motion> \
207        [itcl::code $this _rotate drag %x %y]
208    bind $itk_component(3dview) <ButtonRelease-1> \
209        [itcl::code $this _rotate release %x %y]
210    bind $itk_component(3dview) <Configure> \
211        [itcl::code $this Resize %w %h]
212
213    # Bindings for panning via mouse
214    bind $itk_component(3dview) <ButtonPress-2> \
215        [itcl::code $this _pan click %x %y]
216    bind $itk_component(3dview) <B2-Motion> \
217        [itcl::code $this _pan drag %x %y]
218    bind $itk_component(3dview) <ButtonRelease-2> \
219        [itcl::code $this _pan release %x %y]
220
221    # Bindings for panning via keyboard
222    bind $itk_component(3dview) <KeyPress-Left> \
223        [itcl::code $this _pan set -10 0]
224    bind $itk_component(3dview) <KeyPress-Right> \
225        [itcl::code $this _pan set 10 0]
226    bind $itk_component(3dview) <KeyPress-Up> \
227        [itcl::code $this _pan set 0 -10]
228    bind $itk_component(3dview) <KeyPress-Down> \
229        [itcl::code $this _pan set 0 10]
230    bind $itk_component(3dview) <Shift-KeyPress-Left> \
231        [itcl::code $this _pan set -2 0]
232    bind $itk_component(3dview) <Shift-KeyPress-Right> \
233        [itcl::code $this _pan set 2 0]
234    bind $itk_component(3dview) <Shift-KeyPress-Up> \
235        [itcl::code $this _pan set 0 -2]
236    bind $itk_component(3dview) <Shift-KeyPress-Down> \
237        [itcl::code $this _pan set 0 2]
238
239    # Bindings for zoom via keyboard
240    bind $itk_component(3dview) <KeyPress-Prior> \
241        [itcl::code $this _zoom out]
242    bind $itk_component(3dview) <KeyPress-Next> \
243        [itcl::code $this _zoom in]
244
245    bind $itk_component(3dview) <Enter> "focus $itk_component(3dview)"
246
247    if {[string equal "x11" [tk windowingsystem]]} {
248        # Bindings for zoom via mouse
249        bind $itk_component(3dview) <4> [itcl::code $this _zoom out]
250        bind $itk_component(3dview) <5> [itcl::code $this _zoom in]
251    }
252
253    set _image(download) [image create photo]
254    eval itk_initialize $args
255    Connect
256}
257
258# ----------------------------------------------------------------------
259# DESTRUCTOR
260# ----------------------------------------------------------------------
261itcl::body Rappture::HeightmapViewer::destructor {} {
262    set sendobjs_ ""  ;# stop any send in progress
263    $_dispatcher cancel !rebuild
264    $_dispatcher cancel !send_dataobjs
265    image delete $_image(plot)
266    image delete $_image(legend)
267    image delete $_image(download)
268}
269
270# ----------------------------------------------------------------------
271# USAGE: add <dataobj> ?<settings>?
272#
273# Clients use this to add a data object to the plot.  The optional
274# <settings> are used to configure the plot.  Allowed settings are
275# -color, -brightness, -width, -linestyle, and -raise.
276# ----------------------------------------------------------------------
277itcl::body Rappture::HeightmapViewer::add {dataobj {settings ""}} {
278    array set params {
279        -color auto
280        -width 1
281        -linestyle solid
282        -brightness 0
283        -raise 0
284        -description ""
285        -param ""
286    }
287    foreach {opt val} $settings {
288        if {![info exists params($opt)]} {
289            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
290        }
291        set params($opt) $val
292    }
293    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
294        # can't handle -autocolors yet
295        set params(-color) black
296    }
297    set location [$dataobj hints camera]
298    if { $location != "" } {
299        array set view_ $location
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                set limits_(${axis}range) [expr {$max - $min}]
422            }
423        }
424    }
425}
426
427# ----------------------------------------------------------------------
428# USAGE: download coming
429# USAGE: download controls <downloadCommand>
430# USAGE: download now
431#
432# Clients use this method to create a downloadable representation
433# of the plot.  Returns a list of the form {ext string}, where
434# "ext" is the file extension (indicating the type of data) and
435# "string" is the data itself.
436# ----------------------------------------------------------------------
437itcl::body Rappture::HeightmapViewer::download {option args} {
438    switch $option {
439        coming {
440            if {[catch {
441                blt::winop snap $itk_component(plotarea) $_image(download)
442            }]} {
443                $_image(download) configure -width 1 -height 1
444                $_image(download) put #000000
445            }
446        }
447        controls {
448            # no controls for this download yet
449            return ""
450        }
451        now {
452            # Get the image data (as base64) and decode it back to binary.
453            # This is better than writing to temporary files.  When we switch
454            # to the BLT picture image it won't be necessary to decode the
455            # image data.
456            set bytes [$_image(download) data -format "jpeg -quality 100"]
457            set bytes [Rappture::encoding::decode -as b64 $bytes]
458            return [list .jpg $bytes]
459        }
460        default {
461            error "bad option \"$option\": should be coming, controls, now"
462        }
463    }
464}
465
466# ----------------------------------------------------------------------
467# USAGE: Connect ?<host:port>,<host:port>...?
468#
469# Clients use this method to establish a connection to a new
470# server, or to reestablish a connection to the previous server.
471# Any existing connection is automatically closed.
472# ----------------------------------------------------------------------
473itcl::body Rappture::HeightmapViewer::Connect {} {
474    Disconnect
475    set _hosts [GetServerList "nanovis"]
476    if { "" == $_hosts } {
477        return 0
478    }
479    set result [VisViewer::Connect $_hosts]
480    return $result
481}
482
483# ----------------------------------------------------------------------
484# USAGE: Disconnect
485#
486# Clients use this method to disconnect from the current rendering
487# server.
488# ----------------------------------------------------------------------
489itcl::body Rappture::HeightmapViewer::Disconnect {} {
490    VisViewer::Disconnect
491
492    set outbuf_ ""
493    # disconnected -- no more data sitting on server
494    catch {unset obj2id_}
495    array unset id2obj_
496    set obj2id_(count) 0
497    set id2obj_(cound) 0
498    set sendobjs_ ""
499}
500
501#
502# _send
503#
504#       Send commands off to the rendering server.  If we're currently
505#       sending data objects to the server, buffer the commands to be
506#       sent later.
507#
508itcl::body Rappture::HeightmapViewer::_send {string} {
509    if {[llength $sendobjs_] > 0} {
510        append outbuf_ $string "\n"
511    } else {
512        if {[SendBytes $string]} {
513            foreach line [split $string \n] {
514                SendEcho >>line $line
515            }
516        }
517    }
518}
519
520# ----------------------------------------------------------------------
521# USAGE: _send_dataobjs
522#
523# Used internally to send a series of volume objects off to the
524# server.  Sends each object, a little at a time, with updates in
525# between so the interface doesn't lock up.
526# ----------------------------------------------------------------------
527itcl::body Rappture::HeightmapViewer::_send_dataobjs {} {
528    blt::busy hold $itk_component(hull); update idletasks
529
530    # Reset the overall limits
531    if { $sendobjs_ != "" } {
532        set limits_(vmin) ""
533        set limits_(vmax) ""
534    }
535    foreach dataobj $sendobjs_ {
536        foreach comp [$dataobj components] {
537            set data [$dataobj blob $comp]
538
539            foreach { vmin vmax }  [$dataobj limits v] break
540            if { $limits_(vmin) == "" || $vmin < $limits_(vmin) } {
541                set limits_(vmin) $vmin
542            }
543            if { $limits_(vmax) == "" || $vmax > $limits_(vmax) } {
544                set limits_(vmax) $vmax
545            }
546
547            # tell the engine to expect some data
548            set nbytes [string length $data]
549            if { ![SendBytes "heightmap data follows $nbytes"] } {
550                return
551
552            }
553            if { ![SendBytes $data] } {
554                return
555            }
556            set id $obj2id_(count)
557            incr obj2id_(count)
558            set id2obj_($id) [list $dataobj $comp]
559            set obj2id_($dataobj-$comp) $id
560            set receiveIds_($id) 1
561
562            #
563            # Determine the transfer function needed for this volume
564            # and make sure that it's defined on the server.
565            #
566            foreach {sname cmap wmap} [_getTransfuncData $dataobj $comp] break
567            set cmdstr [list "transfunc" "define" $sname $cmap $wmap]
568            if {![SendBytes $cmdstr]} {
569                return
570            }
571            set obj2style_($dataobj-$comp) $sname
572        }
573    }
574    set sendobjs_ ""
575    blt::busy release $itk_component(hull)
576
577    # activate the proper volume
578    set first [lindex [get] 0]
579    if {"" != $first} {
580        set axis [$first hints updir]
581        if {"" != $axis} {
582            _send "up $axis"
583        }
584    }
585
586    foreach key [array names obj2id_ *-*] {
587        set state [string match $first-* $key]
588        _send "heightmap data visible $state $obj2id_($key)"
589        if {[info exists obj2style_($key)]} {
590            _send "heightmap transfunc $obj2style_($key) $obj2id_($key)"
591        }
592    }
593
594    # if there are any commands in the buffer, send them now that we're done
595    SendBytes $outbuf_
596    set outbuf_ ""
597
598    $_dispatcher event -idle !legend
599}
600
601# ----------------------------------------------------------------------
602# USAGE: ReceiveImage -bytes <size>
603#
604# Invoked automatically whenever the "image" command comes in from
605# the rendering server.  Indicates that binary image data with the
606# specified <size> will follow.
607# ----------------------------------------------------------------------
608itcl::body Rappture::HeightmapViewer::ReceiveImage { args } {
609    if {![IsConnected]} {
610        return
611    }
612    array set info {
613        -type image
614    }
615    array set info $args
616    set bytes [ReceiveBytes $info(-bytes)]
617    ReceiveEcho <<line "<read $info(-bytes) bytes"
618    if { $info(-type) == "image" } {
619        $_image(plot) configure -data $bytes
620        ReceiveEcho <<line "<read for [image width $_image(plot)]x[image height $_image(plot)] image>"
621    } elseif { $info(type) == "print" } {
622        set tag $this-print-$info(-token)
623        set hardcopy_($tag) $bytes
624    }
625}
626
627# ----------------------------------------------------------------------
628# USAGE: _ReceiveLegend <tf> <vmin> <vmax> <size>
629#
630# Invoked automatically whenever the "legend" command comes in from
631# the rendering server.  Indicates that binary image data with the
632# specified <size> will follow.
633# ----------------------------------------------------------------------
634itcl::body Rappture::HeightmapViewer::_ReceiveLegend {tf vmin vmax size} {
635    if { [IsConnected] } {
636        set bytes [ReceiveBytes $size]
637        ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
638        if 1 {
639        set src [image create photo -data $bytes]
640        blt::winop image rotate $src $_image(legend) 90
641        set dst $_image(legend)
642        } else {
643        $_image(legend) configure -data $bytes
644        }
645        set c $itk_component(legend)
646        set w [winfo width $c]
647        set h [winfo height $c]
648        set lineht [expr [font metrics $itk_option(-font) -linespace] + 4]
649        if {"" == [$c find withtag transfunc]} {
650            $c create image 0 [expr $lineht] -anchor ne \
651                 -image $_image(legend) -tags transfunc
652            $c create text 10 [expr {$h-8}] -anchor se \
653                 -fill $itk_option(-plotforeground) -tags vmin
654            $c create text [expr {$w-10}] [expr {$h-8}] -anchor ne \
655                 -fill $itk_option(-plotforeground) -tags vmax
656        }
657        $c coords transfunc [expr $w - 5] [expr $lineht]
658        $c itemconfigure vmin -text $vmin
659        $c itemconfigure vmax -text $vmax
660        $c coords vmax [expr $w - 5] 2
661        $c coords vmin [expr $w - 5] [expr $h - 2]
662    }
663}
664
665# ----------------------------------------------------------------------
666# USAGE: _rebuild
667#
668# Called automatically whenever something changes that affects the
669# data in the widget.  Clears any existing data and rebuilds the
670# widget to display new data.
671# ----------------------------------------------------------------------
672itcl::body Rappture::HeightmapViewer::_rebuild {} {
673    # in the midst of sending data? then bail out
674    if {[llength $sendobjs_] > 0} {
675        return
676    }
677    # Find any new data that needs to be sent to the server.  Queue this up on
678    # the sendobjs_ list, and send it out a little at a time.  Do this first,
679    # before we rebuild the rest.
680    foreach dataobj [get] {
681        set comp [lindex [$dataobj components] 0]
682        if {![info exists obj2id_($dataobj-$comp)]} {
683            set i [lsearch -exact $sendobjs_ $dataobj]
684            if {$i < 0} {
685                lappend sendobjs_ $dataobj
686            }
687        }
688    }
689    if {[llength $sendobjs_] > 0} {
690        # Send off new data objects
691        $_dispatcher event -idle !send_dataobjs
692    } else {
693        # Nothing to send -- activate the proper volume
694        set first [lindex [get] 0]
695        if {"" != $first} {
696            set axis [$first hints updir]
697            if {"" != $axis} {
698                _send "up $axis"
699            }
700        }
701        foreach key [array names obj2id_ *-*] {
702            set state [string match $first-* $key]
703            _send "heightmap data visible $state $obj2id_($key)"
704            if {[info exists obj2style_($key)]} {
705                _send "heightmap transfunc $obj2style_($key) $obj2id_($key)"
706            }
707        }
708        $_dispatcher event -idle !legend
709    }
710
711    # Reset the screen size. 
712    set w [winfo width $itk_component(3dview)]
713    set h [winfo height $itk_component(3dview)]
714    Resize $w $h
715
716    # Reset the camera and other view parameters
717    set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
718    _send "camera angle $xyz"
719    _PanCamera
720    _send "camera zoom $view_(zoom)"
721
722     if {"" == $itk_option(-plotoutline)} {
723         _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
724     }
725    set settings_($this-theta) $view_(theta)
726    set settings_($this-phi) $view_(phi)
727    set settings_($this-psi) $view_(psi)
728    set settings_($this-pan-x) $view_(pan-x)
729    set settings_($this-pan-y) $view_(pan-y)
730    set settings_($this-zoom) $view_(zoom)
731
732    _fixSettings wireframe
733    _fixSettings grid
734    _fixSettings axes
735    _fixSettings contourlines
736}
737
738# ----------------------------------------------------------------------
739# USAGE: _zoom in
740# USAGE: _zoom out
741# USAGE: _zoom reset
742#
743# Called automatically when the user clicks on one of the zoom
744# controls for this widget.  Changes the zoom for the current view.
745# ----------------------------------------------------------------------
746itcl::body Rappture::HeightmapViewer::_zoom {option} {
747    switch -- $option {
748        "in" {
749            set view_(zoom) [expr {$view_(zoom)*1.25}]
750            set settings_($this-zoom) $view_(zoom)
751        }
752        "out" {
753            set view_(zoom) [expr {$view_(zoom)*0.8}]
754            set settings_($this-zoom) $view_(zoom)
755        }
756        "reset" {
757            array set view_ {
758                theta   45
759                phi     45
760                psi     0
761                zoom    1.0
762                pan-x   0
763                pan-y   0
764            }
765            set first [lindex [get] 0]
766            if { $first != "" } {
767                set location [$first hints camera]
768                if { $location != "" } {
769                    array set view_ $location
770                }
771            }
772            set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
773            _send "camera angle $xyz"
774            _PanCamera
775            set settings_($this-theta) $view_(theta)
776            set settings_($this-phi) $view_(phi)
777            set settings_($this-psi) $view_(psi)
778            set settings_($this-pan-x) $view_(pan-x)
779            set settings_($this-pan-y) $view_(pan-y)
780            set settings_($this-zoom) $view_(zoom)
781        }
782    }
783    _send "camera zoom $view_(zoom)"
784}
785
786# ----------------------------------------------------------------------
787# USAGE: $this _pan click x y
788#        $this _pan drag x y
789#        $this _pan release x y
790#
791# Called automatically when the user clicks on one of the zoom
792# controls for this widget.  Changes the zoom for the current view.
793# ----------------------------------------------------------------------
794itcl::body Rappture::HeightmapViewer::_pan {option x y} {
795    # Experimental stuff
796    set w [winfo width $itk_component(3dview)]
797    set h [winfo height $itk_component(3dview)]
798    if { $option == "set" } {
799        set x [expr ($x / double($w)) * $limits_(xrange)]
800        set y [expr ($y / double($h)) * $limits_(yrange)]
801        set view_(pan-x) [expr $view_(pan-x) + $x]
802        set view_(pan-y) [expr $view_(pan-y) + $y]
803        _PanCamera
804        set settings_($this-pan-x) $view_(pan-x)
805        set settings_($this-pan-y) $view_(pan-y)
806        return
807    }
808    if { $option == "click" } {
809        set click_(x) $x
810        set click_(y) $y
811        $itk_component(3dview) configure -cursor hand1
812    }
813    if { $option == "drag" || $option == "release" } {
814        set dx [expr (($click_(x) - $x)/double($w)) * $limits_(xrange)]
815        set dy [expr (($click_(y) - $y)/double($h)) * $limits_(yrange)]
816        set click_(x) $x
817        set click_(y) $y
818        set view_(pan-x) [expr $view_(pan-x) - $dx]
819        set view_(pan-y) [expr $view_(pan-y) - $dy]
820        _PanCamera
821        set settings_($this-pan-x) $view_(pan-x)
822        set settings_($this-pan-y) $view_(pan-y)
823    }
824    if { $option == "release" } {
825        $itk_component(3dview) configure -cursor ""
826    }
827}
828
829itcl::body Rappture::HeightmapViewer::_PanCamera {} {
830    set x [expr ($view_(pan-x)) / $limits_(xrange)]
831    set y [expr ($view_(pan-y)) / $limits_(yrange)]
832    _send "camera pan $x $y"
833}
834
835# ----------------------------------------------------------------------
836# USAGE: _rotate click <x> <y>
837# USAGE: _rotate drag <x> <y>
838# USAGE: _rotate release <x> <y>
839#
840# Called automatically when the user clicks/drags/releases in the
841# plot area.  Moves the plot according to the user's actions.
842# ----------------------------------------------------------------------
843itcl::body Rappture::HeightmapViewer::_rotate {option x y} {
844    switch -- $option {
845        click {
846            $itk_component(3dview) configure -cursor fleur
847            array set click_ [subst {
848                x       $x
849                y       $y
850                theta   $view_(theta)
851                phi     $view_(phi)
852            }]
853        }
854        drag {
855            if {[array size click_] == 0} {
856                _rotate click $x $y
857            } else {
858                set w [winfo width $itk_component(3dview)]
859                set h [winfo height $itk_component(3dview)]
860                if {$w <= 0 || $h <= 0} {
861                    return
862                }
863
864                if {[catch {
865                    # this fails sometimes for no apparent reason
866                    set dx [expr {double($x-$click_(x))/$w}]
867                    set dy [expr {double($y-$click_(y))/$h}]
868                }] != 0 } {
869                    return
870                }
871
872                #
873                # Rotate the camera in 3D
874                #
875                if {$view_(psi) > 90 || $view_(psi) < -90} {
876                    # when psi is flipped around, theta moves backwards
877                    set dy [expr {-$dy}]
878                }
879                set theta [expr {$view_(theta) - $dy*180}]
880                while {$theta < 0} { set theta [expr {$theta+180}] }
881                while {$theta > 180} { set theta [expr {$theta-180}] }
882
883                if {abs($theta) >= 30 && abs($theta) <= 160} {
884                    set phi [expr {$view_(phi) - $dx*360}]
885                    while {$phi < 0} { set phi [expr {$phi+360}] }
886                    while {$phi > 360} { set phi [expr {$phi-360}] }
887                    set psi $view_(psi)
888                } else {
889                    set phi $view_(phi)
890                    set psi [expr {$view_(psi) - $dx*360}]
891                    while {$psi < -180} { set psi [expr {$psi+360}] }
892                    while {$psi > 180} { set psi [expr {$psi-360}] }
893                }
894
895                set view_(theta)        $theta
896                set view_(phi)          $phi
897                set view_(psi)          $psi
898                set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
899                set settings_($this-theta) $view_(theta)
900                set settings_($this-phi) $view_(phi)
901                set settings_($this-psi) $view_(psi)
902                _send "camera angle $xyz"
903                set click_(x) $x
904                set click_(y) $y
905            }
906        }
907        release {
908            _rotate drag $x $y
909            $itk_component(3dview) configure -cursor ""
910            catch {unset click_}
911        }
912        default {
913            error "bad option \"$option\": should be click, drag, release"
914        }
915    }
916}
917
918# ----------------------------------------------------------------------
919# USAGE: _state <component>
920#
921# Used internally to determine the state of a toggle button.
922# The <component> is the itk component name of the button.
923# Returns on/off for the state of the button.
924# ----------------------------------------------------------------------
925itcl::body Rappture::HeightmapViewer::_state {comp} {
926    if {[$itk_component($comp) cget -relief] == "sunken"} {
927        return "on"
928    }
929    return "off"
930}
931
932# ----------------------------------------------------------------------
933# USAGE: _fixSettings <what> ?<value>?
934#
935# Used internally to update rendering settings whenever parameters
936# change in the popup settings panel.  Sends the new settings off
937# to the back end.
938# ----------------------------------------------------------------------
939itcl::body Rappture::HeightmapViewer::_fixSettings { what {value ""} } {
940    switch -- $what {
941        "legend" {
942            if { $settings_($this-legend) } {
943                pack $itk_component(legend) -side left -fill y
944            } else {
945                pack forget $itk_component(legend)
946            }
947            set lineht [expr [font metrics $itk_option(-font) -linespace] + 4]
948            set w [expr {[winfo height $itk_component(legend)] - 2*$lineht}]
949            set h [expr {[winfo width $itk_component(legend)] - 16}]
950            set imap ""
951            set dataobj [lindex [get] 0]
952            if {"" != $dataobj} {
953                set comp [lindex [$dataobj components] 0]
954                if {[info exists obj2id_($dataobj-$comp)]} {
955                    set imap $obj2id_($dataobj-$comp)
956                }
957            }
958            if {$w > 0 && $h > 0 && "" != $imap} {
959                _send "heightmap legend $imap $w $h"
960            } else {
961                $itk_component(legend) delete all
962            }
963        }
964        "grid" {
965            if { [IsConnected] } {
966                _send "grid visible $settings_($this-grid)"
967            }
968        }
969        "axes" {
970            if { [IsConnected] } {
971                _send "axis visible $settings_($this-axes)"
972            }
973        }
974        "wireframe" {
975            if { [IsConnected] } {
976                _send "heightmap polygon $settings_($this-wireframe)"
977            }
978        }
979        "contourlines" {
980            if {[IsConnected]} {
981                set dataobj [lindex [get] 0]
982                if {"" != $dataobj} {
983                    set comp [lindex [$dataobj components] 0]
984                    if {[info exists obj2id_($dataobj-$comp)]} {
985                        set i $obj2id_($dataobj-$comp)
986                        set bool $settings_($this-contourlines)
987                        _send "heightmap linecontour visible $bool $i"
988                    }
989                }
990            }
991        }
992        default {
993            error "don't know how to fix $what: should be grid, axes, contourlines, or legend"
994        }
995    }
996}
997
998# ----------------------------------------------------------------------
999# USAGE: _getTransfuncData <dataobj> <comp>
1000#
1001# Used internally to compute the colormap and alpha map used to define
1002# a transfer function for the specified component in a data object.
1003# Returns: name {v r g b ...} {v w ...}
1004# ----------------------------------------------------------------------
1005itcl::body Rappture::HeightmapViewer::_getTransfuncData {dataobj comp} {
1006    array set style {
1007        -color rainbow
1008        -levels 6
1009        -opacity 0.5
1010    }
1011    array set style [lindex [$dataobj components -style $comp] 0]
1012    set sname "$style(-color):$style(-levels):$style(-opacity)"
1013
1014    if {$style(-color) == "rainbow"} {
1015        set style(-color) "white:yellow:green:cyan:blue:magenta"
1016    }
1017    set clist [split $style(-color) :]
1018    set color white
1019    set cmap "0.0 [Color2RGB $color] "
1020    set range [expr $limits_(vmax) - $limits_(vmin)]
1021    for {set i 0} {$i < [llength $clist]} {incr i} {
1022        set xval [expr {double($i+1)/([llength $clist]+1)}]
1023        set color [lindex $clist $i]
1024        append cmap "$xval [Color2RGB $color] "
1025    }
1026    append cmap "1.0 [Color2RGB $color] "
1027
1028    set opacity $style(-opacity)
1029    set levels $style(-levels)
1030    set wmap {}
1031    if {[string is int $levels]} {
1032        lappend wmap 0.0 0.0
1033        set delta [expr {0.125/($levels+1)}]
1034        for {set i 1} {$i <= $levels} {incr i} {
1035            # add spikes in the middle
1036            set xval [expr {double($i)/($levels+1)}]
1037            lappend wmap [expr {$xval-$delta-0.01}] 0.0
1038            lappend wmap [expr {$xval-$delta}] $opacity
1039            lappend wmap [expr {$xval+$delta}] $opacity
1040            lappend wmap [expr {$xval+$delta+0.01}] 0.0
1041        }
1042        lappend wmap 1.0 0.0
1043    } else {
1044        lappend wmap 0.0 0.0
1045        set delta 0.05
1046        foreach xval [split $levels ,] {
1047            lappend wmap [expr {$xval-$delta}] 0.0
1048            lappend $xval $opacity
1049            lappend [expr {$xval+$delta}] 0.0
1050        }
1051        lappend wmap 1.0 0.0
1052    }
1053    return [list $sname $cmap $wmap]
1054}
1055
1056# ----------------------------------------------------------------------
1057# CONFIGURATION OPTION: -plotbackground
1058# ----------------------------------------------------------------------
1059itcl::configbody Rappture::HeightmapViewer::plotbackground {
1060    foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break
1061    #fix this!
1062    #_send "color background $r $g $b"
1063}
1064
1065# ----------------------------------------------------------------------
1066# CONFIGURATION OPTION: -plotforeground
1067# ----------------------------------------------------------------------
1068itcl::configbody Rappture::HeightmapViewer::plotforeground {
1069    foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break
1070    #fix this!
1071    #_send "color background $r $g $b"
1072}
1073
1074# ----------------------------------------------------------------------
1075# CONFIGURATION OPTION: -plotoutline
1076# ----------------------------------------------------------------------
1077itcl::configbody Rappture::HeightmapViewer::plotoutline {
1078    if {[IsConnected]} {
1079        _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
1080    }
1081}
1082
1083
1084
1085#  camera --
1086#
1087itcl::body Rappture::HeightmapViewer::camera {option args} {
1088    switch -- $option {
1089        "show" {
1090            puts [array get view_]
1091        }
1092        "set" {
1093            set who [lindex $args 0]
1094            set x $settings_($this-$who)
1095            set code [catch { string is double $x } result]
1096            if { $code != 0 || !$result } {
1097                set settings_($this-$who) $view_($who)
1098                return
1099            }
1100            switch -- $who {
1101                "pan-x" - "pan-y" {
1102                    set view_($who) $settings_($this-$who)
1103                    _PanCamera
1104                }
1105                "phi" - "theta" - "psi" {
1106                    set view_($who) $settings_($this-$who)
1107                    set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
1108                    _send "camera angle $xyz"
1109                }
1110                "zoom" {
1111                    set view_($who) $settings_($this-$who)
1112                    _send "camera zoom $view_(zoom)"
1113                }
1114            }
1115        }
1116    }
1117}
1118
1119itcl::body Rappture::HeightmapViewer::_BuildViewTab {} {
1120    set fg [option get $itk_component(hull) font Font]
1121
1122    set inner [$itk_component(main) insert end \
1123        -title "View Settings" \
1124        -icon [Rappture::icon wrench]]
1125    $inner configure -borderwidth 4
1126
1127    foreach { key value } {
1128        grid            1
1129        axes            0
1130        contourlines    1
1131        wireframe       fill
1132        legend          1
1133    } {
1134        set settings_($this-$key) $value
1135    }
1136
1137    checkbutton $inner.grid \
1138        -text "grid" \
1139        -variable [itcl::scope settings_($this-grid)] \
1140        -command [itcl::code $this _fixSettings grid] \
1141        -font "Arial 9"
1142    checkbutton $inner.axes \
1143        -text "axes" \
1144        -variable ::Rappture::HeightmapViewer::settings_($this-axes) \
1145        -command [itcl::code $this _fixSettings axes] \
1146        -font "Arial 9"
1147    checkbutton $inner.contourlines \
1148        -text "contour lines" \
1149        -variable ::Rappture::HeightmapViewer::settings_($this-contourlines) \
1150        -command [itcl::code $this _fixSettings contourlines]\
1151        -font "Arial 9"
1152    checkbutton $inner.wireframe \
1153        -text "wireframe" \
1154        -onvalue "wireframe" -offvalue "fill" \
1155        -variable ::Rappture::HeightmapViewer::settings_($this-wireframe) \
1156        -command [itcl::code $this _fixSettings wireframe]\
1157        -font "Arial 9"
1158    checkbutton $inner.legend \
1159        -text "legend" \
1160        -variable ::Rappture::HeightmapViewer::settings_($this-legend) \
1161        -command [itcl::code $this _fixSettings legend]\
1162        -font "Arial 9"
1163
1164    blt::table $inner \
1165        1,1 $inner.grid -anchor w  \
1166        2,1 $inner.axes -anchor w \
1167        3,1 $inner.contourlines -anchor w \
1168        4,1 $inner.wireframe -anchor w \
1169        5,1 $inner.legend -anchor w
1170
1171    blt::table configure $inner c2 -resize expand
1172    blt::table configure $inner c1 -resize none
1173    for {set n 0} {$n <= 5} {incr n} {
1174        blt::table configure $inner r$n -resize none
1175    }
1176    blt::table configure $inner r$n -resize expand
1177}
1178
1179itcl::body Rappture::HeightmapViewer::_BuildCameraTab {} {
1180    set fg [option get $itk_component(hull) font Font]
1181
1182    set inner [$itk_component(main) insert end \
1183        -title "Camera Settings" \
1184        -icon [Rappture::icon camera]]
1185    $inner configure -borderwidth 4
1186
1187    set labels { phi theta psi pan-x pan-y zoom }
1188    set row 1
1189    foreach tag $labels {
1190        label $inner.${tag}label -text $tag -font "Arial 9"
1191        entry $inner.${tag} -font "Arial 9" -bg white -width 10 \
1192            -textvariable [itcl::scope settings_($this-$tag)]
1193        bind $inner.${tag} <KeyPress-Return> \
1194            [itcl::code $this camera set ${tag}]
1195        blt::table $inner \
1196            $row,1 $inner.${tag}label -anchor e \
1197            $row,2 $inner.${tag} -anchor w
1198        blt::table configure $inner r$row -resize none
1199        incr row
1200    }
1201    blt::table configure $inner c1 c2 -resize none
1202    blt::table configure $inner c3 -resize expand
1203    blt::table configure $inner r$row -resize expand
1204}
1205
1206itcl::body Rappture::HeightmapViewer::Resize { w h } {
1207    #puts stderr "w=$w h=$h"
1208    _send "screen $w $h"
1209}
Note: See TracBrowser for help on using the repository browser.