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

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