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

Last change on this file since 1463 was 1463, checked in by gah, 12 years ago
File size: 38.1 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    public method isconnected {}
66
67    protected method SendCmd {string}
68    protected method SendDataObjs {}
69    protected method ReceiveImage { args }
70    private method ReceiveLegend {tf vmin vmax size}
71    private method BuildViewTab {}
72    private method BuildCameraTab {}
73    private method PanCamera {}
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 of used for global variables
98                                    # for checkbuttons and radiobuttons.
99    private common _hardcopy
100    private variable _buffering 0
101}
102
103itk::usual HeightmapViewer {
104    keep -background -foreground -cursor -font
105    keep -plotbackground -plotforeground
106}
107
108# ----------------------------------------------------------------------
109# CONSTRUCTOR
110# ----------------------------------------------------------------------
111itcl::body Rappture::HeightmapViewer::constructor {hostlist args} {
112    # Draw legend event
113    $_dispatcher register !legend
114    $_dispatcher dispatch $this !legend \
115        "[itcl::code $this FixSettings legend]; list"
116    # Send dataobjs event
117    $_dispatcher register !send_dataobjs
118    $_dispatcher dispatch $this !send_dataobjs \
119        "[itcl::code $this SendDataObjs]; list"
120    # Rebuild event
121    $_dispatcher register !rebuild
122    $_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
123
124    set _outbuf ""
125
126    #
127    # Populate parser with commands handle incoming requests
128    #
129    $_parser alias image [itcl::code $this ReceiveImage]
130    $_parser alias legend [itcl::code $this ReceiveLegend]
131
132    # Initialize the view to some default parameters.
133    array set _view {
134        theta   45
135        phi     45
136        psi     0
137        zoom    1.0
138        pan-x   0
139        pan-y   0
140    }
141    set _obj2id(count) 0
142
143    set f [$itk_component(main) component controls]
144    itk_component add zoom {
145        frame $f.zoom
146    }
147    pack $itk_component(zoom) -side top
148
149    itk_component add reset {
150        button $f.reset -borderwidth 1 -padx 1 -pady 1 \
151            -highlightthickness 0 \
152            -image [Rappture::icon reset-view] \
153            -command [itcl::code $this Zoom reset]
154    } {
155        usual
156        ignore -highlightthickness
157    }
158    pack $itk_component(reset) -side top -padx 1 -pady { 4 0 }
159    Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
160
161    itk_component add zoomin {
162        button $f.zin -borderwidth 1 -padx 1 -pady 1 \
163            -highlightthickness 0 \
164            -image [Rappture::icon zoom-in] \
165            -command [itcl::code $this Zoom in]
166    } {
167        usual
168        ignore -highlightthickness
169    }
170    pack $itk_component(zoomin) -side top -padx 1 -pady { 4 0 }
171    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
172
173    itk_component add zoomout {
174        button $f.zout -borderwidth 1 -padx 1 -pady 1 \
175            -highlightthickness 0 \
176            -image [Rappture::icon zoom-out] \
177            -command [itcl::code $this Zoom out]
178    } {
179        usual
180        ignore -highlightthickness
181    }
182    pack $itk_component(zoomout) -side top -padx 1 -pady { 4 }
183    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
184
185    BuildViewTab
186    BuildCameraTab
187
188    # Legend
189    set _image(legend) [image create photo]
190    itk_component add legend {
191        canvas $itk_component(plotarea).legend -width 30 -highlightthickness 0
192    } {
193        usual
194        ignore -highlightthickness
195        rename -background -plotbackground plotBackground Background
196    }
197    set w [expr [winfo reqwidth $itk_component(hull)] - 80]
198    pack forget $itk_component(3dview)
199    pack $itk_component(3dview) -side left -fill both -expand yes
200    pack $itk_component(legend) -side left -fill y
201
202    bind $itk_component(legend) <Configure> \
203        [list $_dispatcher event -idle !legend]
204
205    # Bindings for rotation via mouse
206    bind $itk_component(3dview) <ButtonPress-1> \
207        [itcl::code $this Rotate click %x %y]
208    bind $itk_component(3dview) <B1-Motion> \
209        [itcl::code $this Rotate drag %x %y]
210    bind $itk_component(3dview) <ButtonRelease-1> \
211        [itcl::code $this Rotate release %x %y]
212    bind $itk_component(3dview) <Configure> \
213        [itcl::code $this Resize %w %h]
214
215    # Bindings for panning via mouse
216    bind $itk_component(3dview) <ButtonPress-2> \
217        [itcl::code $this Pan click %x %y]
218    bind $itk_component(3dview) <B2-Motion> \
219        [itcl::code $this Pan drag %x %y]
220    bind $itk_component(3dview) <ButtonRelease-2> \
221        [itcl::code $this Pan release %x %y]
222
223    # Bindings for panning via keyboard
224    bind $itk_component(3dview) <KeyPress-Left> \
225        [itcl::code $this Pan set -10 0]
226    bind $itk_component(3dview) <KeyPress-Right> \
227        [itcl::code $this Pan set 10 0]
228    bind $itk_component(3dview) <KeyPress-Up> \
229        [itcl::code $this Pan set 0 -10]
230    bind $itk_component(3dview) <KeyPress-Down> \
231        [itcl::code $this Pan set 0 10]
232    bind $itk_component(3dview) <Shift-KeyPress-Left> \
233        [itcl::code $this Pan set -2 0]
234    bind $itk_component(3dview) <Shift-KeyPress-Right> \
235        [itcl::code $this Pan set 2 0]
236    bind $itk_component(3dview) <Shift-KeyPress-Up> \
237        [itcl::code $this Pan set 0 -2]
238    bind $itk_component(3dview) <Shift-KeyPress-Down> \
239        [itcl::code $this Pan set 0 2]
240
241    # Bindings for zoom via keyboard
242    bind $itk_component(3dview) <KeyPress-Prior> \
243        [itcl::code $this Zoom out]
244    bind $itk_component(3dview) <KeyPress-Next> \
245        [itcl::code $this Zoom in]
246
247    bind $itk_component(3dview) <Enter> "focus $itk_component(3dview)"
248
249    if {[string equal "x11" [tk windowingsystem]]} {
250        # Bindings for zoom via mouse
251        bind $itk_component(3dview) <4> [itcl::code $this Zoom out]
252        bind $itk_component(3dview) <5> [itcl::code $this Zoom in]
253    }
254
255    set _image(download) [image create photo]
256    eval itk_initialize $args
257    Connect
258}
259
260# ----------------------------------------------------------------------
261# DESTRUCTOR
262# ----------------------------------------------------------------------
263itcl::body Rappture::HeightmapViewer::destructor {} {
264    set _sendobjs ""  ;# stop any send in progress
265    $_dispatcher cancel !rebuild
266    $_dispatcher cancel !send_dataobjs
267    image delete $_image(plot)
268    image delete $_image(legend)
269    image delete $_image(download)
270}
271
272# ----------------------------------------------------------------------
273# USAGE: add <dataobj> ?<settings>?
274#
275# Clients use this to add a data object to the plot.  The optional
276# <settings> are used to configure the plot.  Allowed settings are
277# -color, -brightness, -width, -linestyle, and -raise.
278# ----------------------------------------------------------------------
279itcl::body Rappture::HeightmapViewer::add {dataobj {settings ""}} {
280    array set params {
281        -color auto
282        -width 1
283        -linestyle solid
284        -brightness 0
285        -raise 0
286        -description ""
287        -param ""
288    }
289    foreach {opt val} $settings {
290        if {![info exists params($opt)]} {
291            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
292        }
293        set params($opt) $val
294    }
295    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
296        # can't handle -autocolors yet
297        set params(-color) black
298    }
299    set pos [lsearch -exact $dataobj $_dlist]
300    if {$pos < 0} {
301        lappend _dlist $dataobj
302        set _obj2ovride($dataobj-color) $params(-color)
303        set _obj2ovride($dataobj-width) $params(-width)
304        set _obj2ovride($dataobj-raise) $params(-raise)
305        $_dispatcher event -idle !rebuild
306    }
307}
308
309# ----------------------------------------------------------------------
310# USAGE: get ?-objects?
311# USAGE: get ?-image 3dview|legend?
312#
313# Clients use this to query the list of objects being plotted, in
314# order from bottom to top of this result.  The optional "-image"
315# flag can also request the internal images being shown.
316# ----------------------------------------------------------------------
317itcl::body Rappture::HeightmapViewer::get { args } {
318    if {[llength $args] == 0} {
319        set args "-objects"
320    }
321
322    set op [lindex $args 0]
323    switch -- $op {
324      -objects {
325        # put the dataobj list in order according to -raise options
326        set dlist $_dlist
327        foreach obj $dlist {
328            if { [info exists _obj2ovride($obj-raise)] &&
329                 $_obj2ovride($obj-raise)} {
330                set i [lsearch -exact $dlist $obj]
331                if {$i >= 0} {
332                    set dlist [lreplace $dlist $i $i]
333                    lappend dlist $obj
334                }
335            }
336        }
337        return $dlist
338      }
339      -image {
340        if {[llength $args] != 2} {
341            error "wrong # args: should be \"get -image 3dview|legend\""
342        }
343        switch -- [lindex $args end] {
344            3dview {
345                return $_image(plot)
346            }
347            legend {
348                return $_image(legend)
349            }
350            default {
351                error "bad image name \"[lindex $args end]\": should be 3dview or legend"
352            }
353        }
354      }
355      default {
356        error "bad option \"$op\": should be -objects or -image"
357      }
358    }
359}
360
361# ----------------------------------------------------------------------
362# USAGE: delete ?<dataobj1> <dataobj2> ...?
363#
364# Clients use this to delete a dataobj from the plot.  If no dataobjs
365# are specified, then all dataobjs are deleted.
366# ----------------------------------------------------------------------
367itcl::body Rappture::HeightmapViewer::delete { args } {
368    if {[llength $args] == 0} {
369        set args $_dlist
370    }
371
372    # delete all specified dataobjs
373    set changed 0
374    foreach dataobj $args {
375        set pos [lsearch -exact $_dlist $dataobj]
376        if {$pos >= 0} {
377            set _dlist [lreplace $_dlist $pos $pos]
378            foreach key [array names _obj2ovride $dataobj-*] {
379                unset _obj2ovride($key)
380            }
381            set changed 1
382        }
383    }
384
385    # if anything changed, then rebuild the plot
386    if {$changed} {
387        $_dispatcher event -idle !rebuild
388    }
389}
390
391# ----------------------------------------------------------------------
392# USAGE: scale ?<data1> <data2> ...?
393#
394# Sets the default limits for the overall plot according to the
395# limits of the data for all of the given <data> objects.  This
396# accounts for all objects--even those not showing on the screen.
397# Because of this, the limits are appropriate for all objects as
398# the user scans through data in the ResultSet viewer.
399# ----------------------------------------------------------------------
400itcl::body Rappture::HeightmapViewer::scale { args } {
401    foreach val {xmin xmax ymin ymax zmin zmax vmin vmax} {
402        set _limits($val) ""
403    }
404    foreach obj $args {
405        foreach axis {x y z v} {
406            foreach {min max} [$obj limits $axis] break
407            if {"" != $min && "" != $max} {
408                if {"" == $_limits(${axis}min)} {
409                    set _limits(${axis}min) $min
410                    set _limits(${axis}max) $max
411                } else {
412                    if {$min < $_limits(${axis}min)} {
413                        set _limits(${axis}min) $min
414                    }
415                    if {$max > $_limits(${axis}max)} {
416                        set _limits(${axis}max) $max
417                    }
418                }
419                set _limits(${axis}range) [expr {$max - $min}]
420            }
421        }
422    }
423}
424
425# ----------------------------------------------------------------------
426# USAGE: download coming
427# USAGE: download controls <downloadCommand>
428# USAGE: download now
429#
430# Clients use this method to create a downloadable representation
431# of the plot.  Returns a list of the form {ext string}, where
432# "ext" is the file extension (indicating the type of data) and
433# "string" is the data itself.
434# ----------------------------------------------------------------------
435itcl::body Rappture::HeightmapViewer::download {option args} {
436    switch $option {
437        coming {
438            if {[catch {
439                blt::winop snap $itk_component(plotarea) $_image(download)
440            }]} {
441                $_image(download) configure -width 1 -height 1
442                $_image(download) put #000000
443            }
444        }
445        controls {
446            # no controls for this download yet
447            return ""
448        }
449        now {
450            # Get the image data (as base64) and decode it back to binary.
451            # This is better than writing to temporary files.  When we switch
452            # to the BLT picture image it won't be necessary to decode the
453            # image data.
454            set bytes [$_image(download) data -format "jpeg -quality 100"]
455            set bytes [Rappture::encoding::decode -as b64 $bytes]
456            return [list .jpg $bytes]
457        }
458        default {
459            error "bad option \"$option\": should be coming, controls, now"
460        }
461    }
462}
463
464#
465# isconnected --
466#
467#       Indicates if we are currently connected to the visualization server.
468#
469itcl::body Rappture::HeightmapViewer::isconnected {} {
470    return [VisViewer::IsConnected]
471}
472
473# ----------------------------------------------------------------------
474# USAGE: Connect ?<host:port>,<host:port>...?
475#
476# Clients use this method to establish a connection to a new
477# server, or to reestablish a connection to the previous server.
478# Any existing connection is automatically closed.
479# ----------------------------------------------------------------------
480itcl::body Rappture::HeightmapViewer::Connect {} {
481    Disconnect
482    set _hosts [GetServerList "nanovis"]
483    if { "" == $_hosts } {
484        return 0
485    }
486    set result [VisViewer::Connect $_hosts]
487    return $result
488}
489
490# ----------------------------------------------------------------------
491# USAGE: Disconnect
492#
493# Clients use this method to disconnect from the current rendering
494# server.
495# ----------------------------------------------------------------------
496itcl::body Rappture::HeightmapViewer::Disconnect {} {
497    VisViewer::Disconnect
498
499    set _outbuf ""
500    # disconnected -- no more data sitting on server
501    catch {unset _obj2id}
502    array unset _id2obj
503    set _obj2id(count) 0
504    set _id2obj(cound) 0
505    set _sendobjs ""
506}
507
508#
509# SendCmd
510#
511#       Send commands off to the rendering server.  If we're currently
512#       sending data objects to the server, buffer the commands to be
513#       sent later.
514#
515itcl::body Rappture::HeightmapViewer::SendCmd {string} {
516    if { $_buffering } {
517        append _outbuf $string "\n"
518    } else {
519        foreach line [split $string \n] {
520            SendEcho >>line $line
521        }
522        SendBytes "$string\n"
523    }
524}
525
526# ----------------------------------------------------------------------
527# USAGE: SendDataObjs
528#
529# Used internally to send a series of volume objects off to the
530# server.  Sends each object, a little at a time, with updates in
531# between so the interface doesn't lock up.
532# ----------------------------------------------------------------------
533itcl::body Rappture::HeightmapViewer::SendDataObjs {} {
534    blt::busy hold $itk_component(hull); update idletasks
535
536    # Reset the overall limits
537    if { $_sendobjs != "" } {
538        set _limits(vmin) ""
539        set _limits(vmax) ""
540    }
541    foreach dataobj $_sendobjs {
542        foreach comp [$dataobj components] {
543            set data [$dataobj blob $comp]
544
545            foreach { vmin vmax }  [$dataobj limits v] break
546            if { $_limits(vmin) == "" || $vmin < $_limits(vmin) } {
547                set _limits(vmin) $vmin
548            }
549            if { $_limits(vmax) == "" || $vmax > $_limits(vmax) } {
550                set _limits(vmax) $vmax
551            }
552
553            # tell the engine to expect some data
554            set nbytes [string length $data]
555            if { ![SendBytes "heightmap data follows $nbytes\n"] } {
556                return
557
558            }
559            if { ![SendBytes $data] } {
560                return
561            }
562            set id $_obj2id(count)
563            incr _obj2id(count)
564            set _id2obj($id) [list $dataobj $comp]
565            set _obj2id($dataobj-$comp) $id
566            set _receiveIds($id) 1
567
568            #
569            # Determine the transfer function needed for this volume
570            # and make sure that it's defined on the server.
571            #
572            foreach {sname cmap wmap} [GetTransfuncData $dataobj $comp] break
573            SendCmd [list "transfunc" "define" $sname $cmap $wmap]
574            set _obj2style($dataobj-$comp) $sname
575        }
576    }
577    set _sendobjs ""
578    blt::busy release $itk_component(hull)
579
580    # Turn on buffering of commands to the server.  We don't want to
581    # be preempted by a server disconnect/reconnect (which automatically
582    # generates a new call to Rebuild).   
583    set _buffering 1
584
585    # activate the proper volume
586    set first [lindex [get] 0]
587    if {"" != $first} {
588        set axis [$first hints updir]
589        if {"" != $axis} {
590            SendCmd "up $axis"
591        }
592        set location [$first hints camera]
593        if { $location != "" } {
594            array set _view $location
595        }
596    }
597
598    foreach key [array names _obj2id *-*] {
599        set state [string match $first-* $key]
600        SendCmd "heightmap data visible $state $_obj2id($key)"
601        if {[info exists _obj2style($key)]} {
602            SendCmd "heightmap transfunc $_obj2style($key) $_obj2id($key)"
603        }
604    }
605
606    # Actually write the commands to the server socket.  If it fails, we don't
607    # care.  We're finished here.
608    SendBytes $_outbuf;                 
609    set _buffering 0;                   # Turn off buffering.
610    set _outbuf "";                     # Clear the buffer.             
611    $_dispatcher event -idle !legend
612}
613
614# ----------------------------------------------------------------------
615# USAGE: ReceiveImage -bytes <size>
616#
617# Invoked automatically whenever the "image" command comes in from
618# the rendering server.  Indicates that binary image data with the
619# specified <size> will follow.
620# ----------------------------------------------------------------------
621itcl::body Rappture::HeightmapViewer::ReceiveImage { args } {
622    if {![IsConnected]} {
623        return
624    }
625    array set info {
626        -type image
627    }
628    array set info $args
629    set bytes [ReceiveBytes $info(-bytes)]
630    ReceiveEcho <<line "<read $info(-bytes) bytes"
631    if { $info(-type) == "image" } {
632        $_image(plot) configure -data $bytes
633        ReceiveEcho <<line "<read for [image width $_image(plot)]x[image height $_image(plot)] image>"
634    } elseif { $info(type) == "print" } {
635        set tag $this-print-$info(-token)
636        set _hardcopy($tag) $bytes
637    }
638}
639
640# ----------------------------------------------------------------------
641# USAGE: ReceiveLegend <tf> <vmin> <vmax> <size>
642#
643# Invoked automatically whenever the "legend" command comes in from
644# the rendering server.  Indicates that binary image data with the
645# specified <size> will follow.
646# ----------------------------------------------------------------------
647itcl::body Rappture::HeightmapViewer::ReceiveLegend {tf vmin vmax size} {
648    if { [IsConnected] } {
649        set bytes [ReceiveBytes $size]
650        ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
651        if 1 {
652        set src [image create photo -data $bytes]
653        blt::winop image rotate $src $_image(legend) 90
654        set dst $_image(legend)
655        } else {
656        $_image(legend) configure -data $bytes
657        }
658        set c $itk_component(legend)
659        set w [winfo width $c]
660        set h [winfo height $c]
661        set lineht [expr [font metrics $itk_option(-font) -linespace] + 4]
662        if {"" == [$c find withtag transfunc]} {
663            $c create image 0 [expr $lineht] -anchor ne \
664                 -image $_image(legend) -tags transfunc
665            $c create text 10 [expr {$h-8}] -anchor se \
666                 -fill $itk_option(-plotforeground) -tags vmin
667            $c create text [expr {$w-10}] [expr {$h-8}] -anchor ne \
668                 -fill $itk_option(-plotforeground) -tags vmax
669        }
670        $c coords transfunc [expr $w - 5] [expr $lineht]
671        $c itemconfigure vmin -text $vmin
672        $c itemconfigure vmax -text $vmax
673        $c coords vmax [expr $w - 5] 2
674        $c coords vmin [expr $w - 5] [expr $h - 2]
675    }
676}
677
678# ----------------------------------------------------------------------
679# USAGE: Rebuild
680#
681# Called automatically whenever something changes that affects the
682# data in the widget.  Clears any existing data and rebuilds the
683# widget to display new data.
684# ----------------------------------------------------------------------
685itcl::body Rappture::HeightmapViewer::Rebuild {} {
686    # in the midst of sending data? then bail out
687    if {[llength $_sendobjs] > 0} {
688        return
689    }
690    # Turn on buffering of commands to the server.  We don't want to
691    # be preempted by a server disconnect/reconnect (which automatically
692    # generates a new call to Rebuild).   
693    set _buffering 1
694
695    # Find any new data that needs to be sent to the server.  Queue this up on
696    # the _sendobjs list, and send it out a little at a time.  Do this first,
697    # before we rebuild the rest.
698    foreach dataobj [get] {
699        set comp [lindex [$dataobj components] 0]
700        if {![info exists _obj2id($dataobj-$comp)]} {
701            set i [lsearch -exact $_sendobjs $dataobj]
702            if {$i < 0} {
703                lappend _sendobjs $dataobj
704            }
705        }
706    }
707    if {[llength $_sendobjs] > 0} {
708        # Send off new data objects
709        $_dispatcher event -idle !send_dataobjs
710    } else {
711        # Nothing to send -- activate the proper volume
712        set first [lindex [get] 0]
713        if {"" != $first} {
714            set axis [$first hints updir]
715            if {"" != $axis} {
716                SendCmd "up $axis"
717            }
718        }
719        foreach key [array names _obj2id *-*] {
720            set state [string match $first-* $key]
721            SendCmd "heightmap data visible $state $_obj2id($key)"
722            if {[info exists _obj2style($key)]} {
723                SendCmd "heightmap transfunc $_obj2style($key) $_obj2id($key)"
724            }
725        }
726        $_dispatcher event -idle !legend
727    }
728
729    # Reset the screen size. 
730    set w [winfo width $itk_component(3dview)]
731    set h [winfo height $itk_component(3dview)]
732    Resize $w $h
733
734    # Reset the camera and other view parameters
735    set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
736    SendCmd "camera angle $xyz"
737    PanCamera
738    SendCmd "camera zoom $_view(zoom)"
739
740     if {"" == $itk_option(-plotoutline)} {
741         SendCmd "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
742     }
743    set _settings($this-theta) $_view(theta)
744    set _settings($this-phi) $_view(phi)
745    set _settings($this-psi) $_view(psi)
746    set _settings($this-pan-x) $_view(pan-x)
747    set _settings($this-pan-y) $_view(pan-y)
748    set _settings($this-zoom) $_view(zoom)
749
750    FixSettings wireframe
751    FixSettings grid
752    FixSettings axes
753    FixSettings contourlines
754
755    # Actually write the commands to the server socket.  If it fails, we don't
756    # care.  We're finished here.
757    SendBytes $_outbuf;                 
758    set _buffering 0;                   # Turn off buffering.
759    set _outbuf "";                     # Clear the buffer.             
760}
761
762# ----------------------------------------------------------------------
763# USAGE: Zoom in
764# USAGE: Zoom out
765# USAGE: Zoom reset
766#
767# Called automatically when the user clicks on one of the zoom
768# controls for this widget.  Changes the zoom for the current view.
769# ----------------------------------------------------------------------
770itcl::body Rappture::HeightmapViewer::Zoom {option} {
771    switch -- $option {
772        "in" {
773            set _view(zoom) [expr {$_view(zoom)*1.25}]
774            set _settings($this-zoom) $_view(zoom)
775        }
776        "out" {
777            set _view(zoom) [expr {$_view(zoom)*0.8}]
778            set _settings($this-zoom) $_view(zoom)
779        }
780        "reset" {
781            array set _view {
782                theta   45
783                phi     45
784                psi     0
785                zoom    1.0
786                pan-x   0
787                pan-y   0
788            }
789            set first [lindex [get] 0]
790            if { $first != "" } {
791                set location [$first hints camera]
792                if { $location != "" } {
793                    array set _view $location
794                }
795            }
796            set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
797            SendCmd "camera angle $xyz"
798            PanCamera
799            set _settings($this-theta) $_view(theta)
800            set _settings($this-phi) $_view(phi)
801            set _settings($this-psi) $_view(psi)
802            set _settings($this-pan-x) $_view(pan-x)
803            set _settings($this-pan-y) $_view(pan-y)
804            set _settings($this-zoom) $_view(zoom)
805        }
806    }
807    SendCmd "camera zoom $_view(zoom)"
808}
809
810# ----------------------------------------------------------------------
811# USAGE: $this Pan click x y
812#        $this Pan drag x y
813#        $this Pan release x y
814#
815# Called automatically when the user clicks on one of the zoom
816# controls for this widget.  Changes the zoom for the current view.
817# ----------------------------------------------------------------------
818itcl::body Rappture::HeightmapViewer::Pan {option x y} {
819    # Experimental stuff
820    set w [winfo width $itk_component(3dview)]
821    set h [winfo height $itk_component(3dview)]
822    if { $option == "set" } {
823        set x [expr ($x / double($w)) * $_limits(xrange)]
824        set y [expr ($y / double($h)) * $_limits(yrange)]
825        set _view(pan-x) [expr $_view(pan-x) + $x]
826        set _view(pan-y) [expr $_view(pan-y) + $y]
827        PanCamera
828        set _settings($this-pan-x) $_view(pan-x)
829        set _settings($this-pan-y) $_view(pan-y)
830        return
831    }
832    if { $option == "click" } {
833        set _click(x) $x
834        set _click(y) $y
835        $itk_component(3dview) configure -cursor hand1
836    }
837    if { $option == "drag" || $option == "release" } {
838        set dx [expr (($_click(x) - $x)/double($w)) * $_limits(xrange)]
839        set dy [expr (($_click(y) - $y)/double($h)) * $_limits(yrange)]
840        set _click(x) $x
841        set _click(y) $y
842        set _view(pan-x) [expr $_view(pan-x) - $dx]
843        set _view(pan-y) [expr $_view(pan-y) - $dy]
844        PanCamera
845        set _settings($this-pan-x) $_view(pan-x)
846        set _settings($this-pan-y) $_view(pan-y)
847    }
848    if { $option == "release" } {
849        $itk_component(3dview) configure -cursor ""
850    }
851}
852
853itcl::body Rappture::HeightmapViewer::PanCamera {} {
854    set x [expr ($_view(pan-x)) / $_limits(xrange)]
855    set y [expr ($_view(pan-y)) / $_limits(yrange)]
856    SendCmd "camera pan $x $y"
857}
858
859# ----------------------------------------------------------------------
860# USAGE: Rotate click <x> <y>
861# USAGE: Rotate drag <x> <y>
862# USAGE: Rotate release <x> <y>
863#
864# Called automatically when the user clicks/drags/releases in the
865# plot area.  Moves the plot according to the user's actions.
866# ----------------------------------------------------------------------
867itcl::body Rappture::HeightmapViewer::Rotate {option x y} {
868    switch -- $option {
869        click {
870            $itk_component(3dview) configure -cursor fleur
871            array set _click [subst {
872                x       $x
873                y       $y
874                theta   $_view(theta)
875                phi     $_view(phi)
876            }]
877        }
878        drag {
879            if {[array size _click] == 0} {
880                Rotate click $x $y
881            } else {
882                set w [winfo width $itk_component(3dview)]
883                set h [winfo height $itk_component(3dview)]
884                if {$w <= 0 || $h <= 0} {
885                    return
886                }
887
888                if {[catch {
889                    # this fails sometimes for no apparent reason
890                    set dx [expr {double($x-$_click(x))/$w}]
891                    set dy [expr {double($y-$_click(y))/$h}]
892                }] != 0 } {
893                    return
894                }
895
896                #
897                # Rotate the camera in 3D
898                #
899                if {$_view(psi) > 90 || $_view(psi) < -90} {
900                    # when psi is flipped around, theta moves backwards
901                    set dy [expr {-$dy}]
902                }
903                set theta [expr {$_view(theta) - $dy*180}]
904                while {$theta < 0} { set theta [expr {$theta+180}] }
905                while {$theta > 180} { set theta [expr {$theta-180}] }
906
907                if {abs($theta) >= 30 && abs($theta) <= 160} {
908                    set phi [expr {$_view(phi) - $dx*360}]
909                    while {$phi < 0} { set phi [expr {$phi+360}] }
910                    while {$phi > 360} { set phi [expr {$phi-360}] }
911                    set psi $_view(psi)
912                } else {
913                    set phi $_view(phi)
914                    set psi [expr {$_view(psi) - $dx*360}]
915                    while {$psi < -180} { set psi [expr {$psi+360}] }
916                    while {$psi > 180} { set psi [expr {$psi-360}] }
917                }
918
919                set _view(theta)        $theta
920                set _view(phi)          $phi
921                set _view(psi)          $psi
922                set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
923                set _settings($this-theta) $_view(theta)
924                set _settings($this-phi) $_view(phi)
925                set _settings($this-psi) $_view(psi)
926                SendCmd "camera angle $xyz"
927                set _click(x) $x
928                set _click(y) $y
929            }
930        }
931        release {
932            Rotate drag $x $y
933            $itk_component(3dview) configure -cursor ""
934            catch {unset _click}
935        }
936        default {
937            error "bad option \"$option\": should be click, drag, release"
938        }
939    }
940}
941
942# ----------------------------------------------------------------------
943# USAGE: State <component>
944#
945# Used internally to determine the state of a toggle button.
946# The <component> is the itk component name of the button.
947# Returns on/off for the state of the button.
948# ----------------------------------------------------------------------
949itcl::body Rappture::HeightmapViewer::State {comp} {
950    if {[$itk_component($comp) cget -relief] == "sunken"} {
951        return "on"
952    }
953    return "off"
954}
955
956# ----------------------------------------------------------------------
957# USAGE: FixSettings <what> ?<value>?
958#
959# Used internally to update rendering settings whenever parameters
960# change in the popup settings panel.  Sends the new settings off
961# to the back end.
962# ----------------------------------------------------------------------
963itcl::body Rappture::HeightmapViewer::FixSettings { what {value ""} } {
964    switch -- $what {
965        "legend" {
966            if { $_settings($this-legend) } {
967                pack $itk_component(legend) -side left -fill y
968            } else {
969                pack forget $itk_component(legend)
970            }
971            set lineht [expr [font metrics $itk_option(-font) -linespace] + 4]
972            set w [expr {[winfo height $itk_component(legend)] - 2*$lineht}]
973            set h [expr {[winfo width $itk_component(legend)] - 16}]
974            set imap ""
975            set dataobj [lindex [get] 0]
976            if {"" != $dataobj} {
977                set comp [lindex [$dataobj components] 0]
978                if {[info exists _obj2id($dataobj-$comp)]} {
979                    set imap $_obj2id($dataobj-$comp)
980                }
981            }
982            if {$w > 0 && $h > 0 && "" != $imap} {
983                SendCmd "heightmap legend $imap $w $h"
984            } else {
985                $itk_component(legend) delete all
986            }
987        }
988        "grid" {
989            if { [IsConnected] } {
990                SendCmd "grid visible $_settings($this-grid)"
991            }
992        }
993        "axes" {
994            if { [IsConnected] } {
995                SendCmd "axis visible $_settings($this-axes)"
996            }
997        }
998        "wireframe" {
999            if { [IsConnected] } {
1000                SendCmd "heightmap polygon $_settings($this-wireframe)"
1001            }
1002        }
1003        "contourlines" {
1004            if {[IsConnected]} {
1005                set dataobj [lindex [get] 0]
1006                if {"" != $dataobj} {
1007                    set comp [lindex [$dataobj components] 0]
1008                    if {[info exists _obj2id($dataobj-$comp)]} {
1009                        set i $_obj2id($dataobj-$comp)
1010                        set bool $_settings($this-contourlines)
1011                        SendCmd "heightmap linecontour visible $bool $i"
1012                    }
1013                }
1014            }
1015        }
1016        default {
1017            error "don't know how to fix $what: should be grid, axes, contourlines, or legend"
1018        }
1019    }
1020}
1021
1022# ----------------------------------------------------------------------
1023# USAGE: GetTransfuncData <dataobj> <comp>
1024#
1025# Used internally to compute the colormap and alpha map used to define
1026# a transfer function for the specified component in a data object.
1027# Returns: name {v r g b ...} {v w ...}
1028# ----------------------------------------------------------------------
1029itcl::body Rappture::HeightmapViewer::GetTransfuncData {dataobj comp} {
1030    array set style {
1031        -color rainbow
1032        -levels 6
1033        -opacity 0.5
1034    }
1035    array set style [lindex [$dataobj components -style $comp] 0]
1036    set sname "$style(-color):$style(-levels):$style(-opacity)"
1037
1038    if {$style(-color) == "rainbow"} {
1039        set style(-color) "white:yellow:green:cyan:blue:magenta"
1040    }
1041    set clist [split $style(-color) :]
1042    set color white
1043    set cmap "0.0 [Color2RGB $color] "
1044    set range [expr $_limits(vmax) - $_limits(vmin)]
1045    for {set i 0} {$i < [llength $clist]} {incr i} {
1046        set xval [expr {double($i+1)/([llength $clist]+1)}]
1047        set color [lindex $clist $i]
1048        append cmap "$xval [Color2RGB $color] "
1049    }
1050    append cmap "1.0 [Color2RGB $color] "
1051
1052    set opacity $style(-opacity)
1053    set levels $style(-levels)
1054    set wmap {}
1055    if {[string is int $levels]} {
1056        lappend wmap 0.0 0.0
1057        set delta [expr {0.125/($levels+1)}]
1058        for {set i 1} {$i <= $levels} {incr i} {
1059            # add spikes in the middle
1060            set xval [expr {double($i)/($levels+1)}]
1061            lappend wmap [expr {$xval-$delta-0.01}] 0.0
1062            lappend wmap [expr {$xval-$delta}] $opacity
1063            lappend wmap [expr {$xval+$delta}] $opacity
1064            lappend wmap [expr {$xval+$delta+0.01}] 0.0
1065        }
1066        lappend wmap 1.0 0.0
1067    } else {
1068        lappend wmap 0.0 0.0
1069        set delta 0.05
1070        foreach xval [split $levels ,] {
1071            lappend wmap [expr {$xval-$delta}] 0.0
1072            lappend $xval $opacity
1073            lappend [expr {$xval+$delta}] 0.0
1074        }
1075        lappend wmap 1.0 0.0
1076    }
1077    return [list $sname $cmap $wmap]
1078}
1079
1080# ----------------------------------------------------------------------
1081# CONFIGURATION OPTION: -plotbackground
1082# ----------------------------------------------------------------------
1083itcl::configbody Rappture::HeightmapViewer::plotbackground {
1084    foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break
1085    #fix this!
1086    #SendCmd "color background $r $g $b"
1087}
1088
1089# ----------------------------------------------------------------------
1090# CONFIGURATION OPTION: -plotforeground
1091# ----------------------------------------------------------------------
1092itcl::configbody Rappture::HeightmapViewer::plotforeground {
1093    foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break
1094    #fix this!
1095    #SendCmd "color background $r $g $b"
1096}
1097
1098# ----------------------------------------------------------------------
1099# CONFIGURATION OPTION: -plotoutline
1100# ----------------------------------------------------------------------
1101itcl::configbody Rappture::HeightmapViewer::plotoutline {
1102    if {[IsConnected]} {
1103        SendCmd "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
1104    }
1105}
1106
1107
1108
1109#  camera --
1110#
1111itcl::body Rappture::HeightmapViewer::camera {option args} {
1112    switch -- $option {
1113        "show" {
1114            puts [array get _view]
1115        }
1116        "set" {
1117            set who [lindex $args 0]
1118            set x $_settings($this-$who)
1119            set code [catch { string is double $x } result]
1120            if { $code != 0 || !$result } {
1121                set _settings($this-$who) $_view($who)
1122                return
1123            }
1124            switch -- $who {
1125                "pan-x" - "pan-y" {
1126                    set _view($who) $_settings($this-$who)
1127                    PanCamera
1128                }
1129                "phi" - "theta" - "psi" {
1130                    set _view($who) $_settings($this-$who)
1131                    set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
1132                    SendCmd "camera angle $xyz"
1133                }
1134                "zoom" {
1135                    set _view($who) $_settings($this-$who)
1136                    SendCmd "camera zoom $_view(zoom)"
1137                }
1138            }
1139        }
1140    }
1141}
1142
1143itcl::body Rappture::HeightmapViewer::BuildViewTab {} {
1144    set fg [option get $itk_component(hull) font Font]
1145
1146    set inner [$itk_component(main) insert end \
1147        -title "View Settings" \
1148        -icon [Rappture::icon wrench]]
1149    $inner configure -borderwidth 4
1150
1151    foreach { key value } {
1152        grid            1
1153        axes            0
1154        contourlines    1
1155        wireframe       fill
1156        legend          1
1157    } {
1158        set _settings($this-$key) $value
1159    }
1160
1161    checkbutton $inner.grid \
1162        -text "grid" \
1163        -variable [itcl::scope _settings($this-grid)] \
1164        -command [itcl::code $this FixSettings grid] \
1165        -font "Arial 9"
1166    checkbutton $inner.axes \
1167        -text "axes" \
1168        -variable ::Rappture::HeightmapViewer::_settings($this-axes) \
1169        -command [itcl::code $this FixSettings axes] \
1170        -font "Arial 9"
1171    checkbutton $inner.contourlines \
1172        -text "contour lines" \
1173        -variable ::Rappture::HeightmapViewer::_settings($this-contourlines) \
1174        -command [itcl::code $this FixSettings contourlines]\
1175        -font "Arial 9"
1176    checkbutton $inner.wireframe \
1177        -text "wireframe" \
1178        -onvalue "wireframe" -offvalue "fill" \
1179        -variable ::Rappture::HeightmapViewer::_settings($this-wireframe) \
1180        -command [itcl::code $this FixSettings wireframe]\
1181        -font "Arial 9"
1182    checkbutton $inner.legend \
1183        -text "legend" \
1184        -variable ::Rappture::HeightmapViewer::_settings($this-legend) \
1185        -command [itcl::code $this FixSettings legend]\
1186        -font "Arial 9"
1187
1188    blt::table $inner \
1189        1,1 $inner.grid -anchor w  \
1190        2,1 $inner.axes -anchor w \
1191        3,1 $inner.contourlines -anchor w \
1192        4,1 $inner.wireframe -anchor w \
1193        5,1 $inner.legend -anchor w
1194
1195    blt::table configure $inner c2 -resize expand
1196    blt::table configure $inner c1 -resize none
1197    for {set n 0} {$n <= 5} {incr n} {
1198        blt::table configure $inner r$n -resize none
1199    }
1200    blt::table configure $inner r$n -resize expand
1201}
1202
1203itcl::body Rappture::HeightmapViewer::BuildCameraTab {} {
1204    set fg [option get $itk_component(hull) font Font]
1205
1206    set inner [$itk_component(main) insert end \
1207        -title "Camera Settings" \
1208        -icon [Rappture::icon camera]]
1209    $inner configure -borderwidth 4
1210
1211    set labels { phi theta psi pan-x pan-y zoom }
1212    set row 1
1213    foreach tag $labels {
1214        label $inner.${tag}label -text $tag -font "Arial 9"
1215        entry $inner.${tag} -font "Arial 9" -bg white -width 10 \
1216            -textvariable [itcl::scope _settings($this-$tag)]
1217        bind $inner.${tag} <KeyPress-Return> \
1218            [itcl::code $this camera set ${tag}]
1219        blt::table $inner \
1220            $row,1 $inner.${tag}label -anchor e \
1221            $row,2 $inner.${tag} -anchor w
1222        blt::table configure $inner r$row -resize none
1223        incr row
1224    }
1225    blt::table configure $inner c1 c2 -resize none
1226    blt::table configure $inner c3 -resize expand
1227    blt::table configure $inner r$row -resize expand
1228}
1229
1230itcl::body Rappture::HeightmapViewer::Resize { w h } {
1231    SendCmd "screen $w $h"
1232}
Note: See TracBrowser for help on using the repository browser.