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

Last change on this file since 1228 was 1228, checked in by gah, 14 years ago

Fixes for parallel makes

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