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

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