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

Last change on this file since 893 was 839, checked in by gah, 17 years ago

changes for surface plots
File size: 48.3 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# ======================================================================
14package require Itk
15package require BLT
16package require Img
17
18option add *HeightmapViewer.width 4i widgetDefault
19option add *HeightmapViewer.height 4i widgetDefault
20option add *HeightmapViewer.foreground black widgetDefault
21option add *HeightmapViewer.controlBackground gray widgetDefault
22option add *HeightmapViewer.controlDarkBackground #999999 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
29itcl::class Rappture::HeightmapViewer {
30    inherit itk::Widget
31
32    itk_option define -plotforeground plotForeground Foreground ""
33    itk_option define -plotbackground plotBackground Background ""
34    itk_option define -plotoutline plotOutline PlotOutline ""
35    itk_option define -sendcommand sendCommand SendCommand ""
36    itk_option define -receivecommand receiveCommand ReceiveCommand ""
37
38    constructor {hostlist args} { # defined below }
39    destructor { # defined below }
40
41    public method add {dataobj {settings ""}}
42    public method get {args}
43    public method delete {args}
44    public method scale {args}
45    public method download {option args}
46    public method parameters {title args} { # do nothing }
47
48    public method connect {{hostlist ""}}
49    public method disconnect {}
50    public method isconnected {}
51
52    protected method _send {args}
53    protected method _send_text {string}
54    protected method _send_dataobjs {}
55    protected method _send_echo {channel {data ""}}
56    protected method _receive {}
57    protected method _receive_image {option size}
58    protected method _receive_legend {ivol vmin vmax size}
59    protected method _receive_echo {channel {data ""}}
60
61    protected method _rebuild {}
62    protected method _currentHeightMapIds {{what -all}}
63    protected method _zoom {option}
64    protected method _move {option x y}
65    protected method _probe {option args}
66
67    protected method _state {comp}
68    protected method _fixSettings {what {value ""}}
69    protected method _fixLegend {}
70    protected method _fixGrid {}
71    protected method _fixAxes {}
72    protected method _fixContourLines {}
73    protected method _serverDown {}
74    protected method _getTransfuncData {dataobj comp}
75    protected method _color2rgb {color}
76    protected method _euler2xyz {theta phi psi}
77
78    private variable _dispatcher "" ;# dispatcher for !events
79
80    private variable _nvhosts ""   ;# list of hosts for nanovis server
81    private variable _sid ""       ;# socket connection to nanovis server
82    private variable _parser ""    ;# interpreter for incoming commands
83    private variable _buffer       ;# buffer for incoming/outgoing commands
84    private variable _image        ;# image displayed in plotting area
85
86    private variable _dlist ""     ;# list of data objects
87    private variable _dims ""      ;# dimensionality of data objects
88    private variable _obj2style    ;# maps dataobj => style settings
89    private variable _obj2ovride   ;# maps dataobj => style override
90    private variable _obj2id       ;# maps dataobj => volume ID in server
91    private variable _sendobjs ""  ;# list of data objs to send to server
92
93    private variable _click        ;# info used for _move operations
94    private variable _limits       ;# autoscale min/max for all axes
95    private variable _view         ;# view params for 3D view
96
97    private common _showGrid       ;# Array indicates whether grid is on
98    private common _showAxes       ;# Array indicates whether axis is on
99}
100
101itk::usual HeightmapViewer {
102    keep -background -foreground -cursor -font
103    keep -plotbackground -plotforeground
104}
105
106# ----------------------------------------------------------------------
107# CONSTRUCTOR
108# ----------------------------------------------------------------------
109itcl::body Rappture::HeightmapViewer::constructor {hostlist args} {
110    Rappture::dispatcher _dispatcher
111    $_dispatcher register !legend
112    $_dispatcher dispatch $this !legend "[itcl::code $this _fixLegend]; list"
113    $_dispatcher register !serverDown
114    $_dispatcher dispatch $this !serverDown "[itcl::code $this _serverDown]; list"
115
116    set _buffer(in) ""
117    set _buffer(out) ""
118
119    #
120    # Create a parser to handle incoming requests
121    #
122    set _parser [interp create -safe]
123    foreach cmd [$_parser eval {info commands}] {
124        $_parser hide $cmd
125    }
126    $_parser alias image [itcl::code $this _receive_image]
127    $_parser alias legend [itcl::code $this _receive_legend]
128
129    #
130    # Set up the widgets in the main body
131    #
132    option add hull.width hull.height
133    pack propagate $itk_component(hull) no
134
135    set _view(theta) 45
136    set _view(phi) 45
137    set _view(psi) 0
138    set _view(zoom) 1
139    set _view(xfocus) 0
140    set _view(yfocus) 0
141    set _view(zfocus) 0
142    set _obj2id(count) 0
143
144    itk_component add controls {
145        frame $itk_interior.cntls
146    } {
147        usual
148        rename -background -controlbackground controlBackground Background
149    }
150    pack $itk_component(controls) -side right -fill y
151
152    itk_component add zoom {
153        frame $itk_component(controls).zoom
154    } {
155        usual
156        rename -background -controlbackground controlBackground Background
157    }
158    pack $itk_component(zoom) -side top
159
160    itk_component add reset {
161        button $itk_component(zoom).reset \
162            -borderwidth 1 -padx 1 -pady 1 \
163            -bitmap [Rappture::icon reset] \
164            -command [itcl::code $this _zoom reset]
165    } {
166        usual
167        ignore -borderwidth
168        rename -highlightbackground -controlbackground controlBackground Background
169    }
170    pack $itk_component(reset) -side left -padx {4 1} -pady 4
171    Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
172
173    itk_component add zoomin {
174        button $itk_component(zoom).zin \
175            -borderwidth 1 -padx 1 -pady 1 \
176            -bitmap [Rappture::icon zoomin] \
177            -command [itcl::code $this _zoom in]
178    } {
179        usual
180        ignore -borderwidth
181        rename -highlightbackground -controlbackground controlBackground Background
182    }
183    pack $itk_component(zoomin) -side left -padx 1 -pady 4
184    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
185
186    itk_component add zoomout {
187        button $itk_component(zoom).zout \
188            -borderwidth 1 -padx 1 -pady 1 \
189            -bitmap [Rappture::icon zoomout] \
190            -command [itcl::code $this _zoom out]
191    } {
192        usual
193        ignore -borderwidth
194        rename -highlightbackground -controlbackground controlBackground Background
195    }
196    pack $itk_component(zoomout) -side left -padx {1 4} -pady 4
197    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
198
199    #
200    # Settings panel...
201    #
202    itk_component add settings {
203        button $itk_component(controls).settings -text "Settings..." \
204            -borderwidth 1 -relief flat -overrelief raised \
205            -padx 2 -pady 1 \
206            -command [list $itk_component(controls).panel activate $itk_component(controls).settings left]
207    } {
208        usual
209        ignore -borderwidth
210        rename -background -controlbackground controlBackground Background
211        rename -highlightbackground -controlbackground controlBackground Background
212    }
213    pack $itk_component(settings) -side top -pady 8
214
215    Rappture::Balloon $itk_component(controls).panel -title "Settings"
216    set inner [$itk_component(controls).panel component inner]
217   
218    frame $inner.f
219    pack $inner.f -side top -fill x
220    grid columnconfigure $inner.f 1 -weight 1
221    set fg [option get $itk_component(hull) font Font]
222   
223    set ::Rappture::HeightmapViewer::_showGrid($this) 1
224    ::checkbutton $inner.f.grid \
225        -text "Show Grid" \
226        -variable ::Rappture::HeightmapViewer::_showGrid($this) \
227        -command [itcl::code $this _fixGrid]
228    grid $inner.f.grid -row 0 -column 0 -sticky w
229
230    set ::Rappture::HeightmapViewer::_showAxes($this) 1
231    ::checkbutton $inner.f.axes \
232        -text "Show Axes" \
233        -variable ::Rappture::HeightmapViewer::_showAxes($this) \
234        -command [itcl::code $this _fixAxes]
235    grid $inner.f.axes -row 1 -column 0 -sticky w
236
237    set ::Rappture::HeightmapViewer::_showContourLines($this) 1
238    ::checkbutton $inner.f.contour \
239        -text "Show Contour Lines" \
240        -variable ::Rappture::HeightmapViewer::_showContourLines($this) \
241        -command [itcl::code $this _fixContourLines]
242    grid $inner.f.contour -row 2 -column 0 -sticky w
243
244    #
245    # RENDERING AREA
246    #
247    itk_component add area {
248        frame $itk_interior.area
249    }
250    pack $itk_component(area) -expand yes -fill both
251
252    set _image(legend) [image create photo]
253    itk_component add legend {
254        canvas $itk_component(area).legend -height 50 -highlightthickness 0
255    } {
256        usual
257        ignore -highlightthickness
258        rename -background -plotbackground plotBackground Background
259    }
260    pack $itk_component(legend) -side bottom -fill x
261    bind $itk_component(legend) <Configure> \
262        [list $_dispatcher event -idle !legend]
263
264    set _image(plot) [image create photo]
265    itk_component add 3dview {
266        label $itk_component(area).vol -image $_image(plot) \
267            -highlightthickness 0
268    } {
269        usual
270        ignore -highlightthickness
271        rename -background -plotbackground plotBackground Background
272    }
273    pack $itk_component(3dview) -expand yes -fill both
274
275    # set up bindings for rotation
276    bind $itk_component(3dview) <ButtonPress> \
277        [itcl::code $this _move click %x %y]
278    bind $itk_component(3dview) <B1-Motion> \
279        [itcl::code $this _move drag %x %y]
280    bind $itk_component(3dview) <ButtonRelease> \
281        [itcl::code $this _move release %x %y]
282    bind $itk_component(3dview) <Configure> \
283        [itcl::code $this _send screen %w %h]
284
285    set _image(download) [image create photo]
286
287    eval itk_initialize $args
288
289    connect $hostlist
290}
291
292# ----------------------------------------------------------------------
293# DESTRUCTOR
294# ----------------------------------------------------------------------
295itcl::body Rappture::HeightmapViewer::destructor {} {
296    set _sendobjs ""  ;# stop any send in progress
297    after cancel [itcl::code $this _send_dataobjs]
298    after cancel [itcl::code $this _rebuild]
299    image delete $_image(plot)
300    image delete $_image(legend)
301    image delete $_image(download)
302    interp delete $_parser
303}
304
305# ----------------------------------------------------------------------
306# USAGE: add <dataobj> ?<settings>?
307#
308# Clients use this to add a data object to the plot.  The optional
309# <settings> are used to configure the plot.  Allowed settings are
310# -color, -brightness, -width, -linestyle, and -raise.
311# ----------------------------------------------------------------------
312itcl::body Rappture::HeightmapViewer::add {dataobj {settings ""}} {
313    array set params {
314        -color auto
315        -width 1
316        -linestyle solid
317        -brightness 0
318        -raise 0
319        -description ""
320        -param ""
321    }
322    foreach {opt val} $settings {
323        if {![info exists params($opt)]} {
324            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
325        }
326        set params($opt) $val
327    }
328    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
329        # can't handle -autocolors yet
330        set params(-color) black
331    }
332
333    set pos [lsearch -exact $dataobj $_dlist]
334    if {$pos < 0} {
335        lappend _dlist $dataobj
336        set _obj2ovride($dataobj-color) $params(-color)
337        set _obj2ovride($dataobj-width) $params(-width)
338        set _obj2ovride($dataobj-raise) $params(-raise)
339
340        after cancel [itcl::code $this _rebuild]
341        after idle [itcl::code $this _rebuild]
342    }
343}
344
345# ----------------------------------------------------------------------
346# USAGE: get ?-objects?
347# USAGE: get ?-image 3dview|legend?
348#
349# Clients use this to query the list of objects being plotted, in
350# order from bottom to top of this result.  The optional "-image"
351# flag can also request the internal images being shown.
352# ----------------------------------------------------------------------
353itcl::body Rappture::HeightmapViewer::get {args} {
354    if {[llength $args] == 0} {
355        set args "-objects"
356    }
357
358    set op [lindex $args 0]
359    switch -- $op {
360      -objects {
361        # put the dataobj list in order according to -raise options
362        set dlist $_dlist
363        foreach obj $dlist {
364            if { [info exists _obj2ovride($obj-raise)] &&
365                 $_obj2ovride($obj-raise)} {
366                set i [lsearch -exact $dlist $obj]
367                if {$i >= 0} {
368                    set dlist [lreplace $dlist $i $i]
369                    lappend dlist $obj
370                }
371            }
372        }
373        return $dlist
374      }
375      -image {
376        if {[llength $args] != 2} {
377            error "wrong # args: should be \"get -image 3dview|legend\""
378        }
379        switch -- [lindex $args end] {
380            3dview {
381                return $_image(plot)
382            }
383            legend {
384                return $_image(legend)
385            }
386            default {
387                error "bad image name \"[lindex $args end]\": should be 3dview or legend"
388            }
389        }
390      }
391      default {
392        error "bad option \"$op\": should be -objects or -image"
393      }
394    }
395}
396
397# ----------------------------------------------------------------------
398# USAGE: delete ?<dataobj1> <dataobj2> ...?
399#
400# Clients use this to delete a dataobj from the plot.  If no dataobjs
401# are specified, then all dataobjs are deleted.
402# ----------------------------------------------------------------------
403itcl::body Rappture::HeightmapViewer::delete {args} {
404    if {[llength $args] == 0} {
405        set args $_dlist
406    }
407
408    # delete all specified dataobjs
409    set changed 0
410    foreach dataobj $args {
411        set pos [lsearch -exact $_dlist $dataobj]
412        if {$pos >= 0} {
413            set _dlist [lreplace $_dlist $pos $pos]
414            foreach key [array names _obj2ovride $dataobj-*] {
415                unset _obj2ovride($key)
416            }
417            set changed 1
418        }
419    }
420
421    # if anything changed, then rebuild the plot
422    if {$changed} {
423        after cancel [itcl::code $this _rebuild]
424        after idle [itcl::code $this _rebuild]
425    }
426}
427
428# ----------------------------------------------------------------------
429# USAGE: scale ?<data1> <data2> ...?
430#
431# Sets the default limits for the overall plot according to the
432# limits of the data for all of the given <data> objects.  This
433# accounts for all objects--even those not showing on the screen.
434# Because of this, the limits are appropriate for all objects as
435# the user scans through data in the ResultSet viewer.
436# ----------------------------------------------------------------------
437itcl::body Rappture::HeightmapViewer::scale {args} {
438    foreach val {xmin xmax ymin ymax zmin zmax vmin vmax} {
439        set _limits($val) ""
440    }
441    foreach obj $args {
442        foreach axis {x y z v} {
443            foreach {min max} [$obj limits $axis] break
444            if {"" != $min && "" != $max} {
445                if {"" == $_limits(${axis}min)} {
446                    set _limits(${axis}min) $min
447                    set _limits(${axis}max) $max
448                } else {
449                    if {$min < $_limits(${axis}min)} {
450                        set _limits(${axis}min) $min
451                    }
452                    if {$max > $_limits(${axis}max)} {
453                        set _limits(${axis}max) $max
454                    }
455                }
456            }
457        }
458    }
459}
460
461# ----------------------------------------------------------------------
462# USAGE: download coming
463# USAGE: download controls <downloadCommand>
464# USAGE: download now
465#
466# Clients use this method to create a downloadable representation
467# of the plot.  Returns a list of the form {ext string}, where
468# "ext" is the file extension (indicating the type of data) and
469# "string" is the data itself.
470# ----------------------------------------------------------------------
471itcl::body Rappture::HeightmapViewer::download {option args} {
472    switch $option {
473        coming {
474            if {[catch {
475                blt::winop snap $itk_component(area) $_image(download)
476            }]} {
477                $_image(download) configure -width 1 -height 1
478                $_image(download) put #000000
479            }
480        }
481        controls {
482            # no controls for this download yet
483            return ""
484        }
485        now {
486            #
487            # Hack alert!  Need data in binary format,
488            # so we'll save to a file and read it back.
489            #
490            set tmpfile /tmp/image[pid].jpg
491            $_image(download) write $tmpfile -format jpeg
492            set fid [open $tmpfile r]
493            fconfigure $fid -encoding binary -translation binary
494            set bytes [read $fid]
495            close $fid
496            file delete -force $tmpfile
497
498            return [list .jpg $bytes]
499        }
500        default {
501            error "bad option \"$option\": should be coming, controls, now"
502        }
503    }
504}
505
506# ----------------------------------------------------------------------
507# USAGE: connect ?<host:port>,<host:port>...?
508#
509# Clients use this method to establish a connection to a new
510# server, or to reestablish a connection to the previous server.
511# Any existing connection is automatically closed.
512# ----------------------------------------------------------------------
513itcl::body Rappture::HeightmapViewer::connect {{hostlist ""}} {
514    disconnect
515
516    if {"" != $hostlist} { set _nvhosts $hostlist }
517
518    if {"" == $_nvhosts} {
519        return 0
520    }
521
522    blt::busy hold $itk_component(hull); update idletasks
523
524    # HACK ALERT! punt on this for now
525    set memorySize 10000
526
527    #
528    # Connect to the nanovis server.  Send the server some estimate
529    # of the size of our job.  If it's too busy, that server may
530    # forward us to another.
531    #
532    set try [split $_nvhosts ,]
533    foreach {hostname port} [split [lindex $try 0] :] break
534    set try [lrange $try 1 end]
535
536    while {1} {
537        _send_echo <<line "connecting to $hostname:$port..."
538        if {[catch {socket $hostname $port} sid]} {
539            if {[llength $try] == 0} {
540                return 0
541            }
542            foreach {hostname port} [split [lindex $try 0] :] break
543            set try [lrange $try 1 end]
544            continue
545        }
546        fconfigure $sid -translation binary -encoding binary
547
548        # send memory requirement to the load balancer
549        puts -nonewline $sid [binary format I $memorySize]
550        flush $sid
551
552        # read back a reconnection order
553        set data [read $sid 4]
554        if {[binary scan $data cccc b1 b2 b3 b4] != 4} {
555            error "couldn't read redirection request"
556        }
557        set addr [format "%u.%u.%u.%u" \
558            [expr {$b1 & 0xff}] \
559            [expr {$b2 & 0xff}] \
560            [expr {$b3 & 0xff}] \
561            [expr {$b4 & 0xff}]]
562        _receive_echo <<line $addr
563
564        if {[string equal $addr "0.0.0.0"]} {
565            fconfigure $sid -buffering line
566            fileevent $sid readable [itcl::code $this _receive]
567            set _sid $sid
568            blt::busy release $itk_component(hull)
569            return 1
570        }
571        set hostname $addr
572    }
573    blt::busy release $itk_component(hull)
574
575    return 0
576}
577
578# ----------------------------------------------------------------------
579# USAGE: disconnect
580#
581# Clients use this method to disconnect from the current rendering
582# server.
583# ----------------------------------------------------------------------
584itcl::body Rappture::HeightmapViewer::disconnect {} {
585    if {"" != $_sid} {
586        catch {close $_sid}
587        set _sid ""
588    }
589
590    set _buffer(in) ""
591    set _buffer(out) ""
592
593    # disconnected -- no more data sitting on server
594    catch {unset _obj2id}
595    set _obj2id(count) 0
596    set _sendobjs ""
597}
598
599# ----------------------------------------------------------------------
600# USAGE: isconnected
601#
602# Clients use this method to see if we are currently connected to
603# a server.
604# ----------------------------------------------------------------------
605itcl::body Rappture::HeightmapViewer::isconnected {} {
606    return [expr {"" != $_sid}]
607}
608
609# ----------------------------------------------------------------------
610# USAGE: _send <arg> <arg> ...
611#
612# Used internally to send commands off to the rendering server.
613# This is a more convenient form of _send_text, which actually
614# does the sending.
615# ----------------------------------------------------------------------
616itcl::body Rappture::HeightmapViewer::_send {args} {
617    _send_text $args
618}
619
620# ----------------------------------------------------------------------
621# USAGE: _send_text <string>
622#
623# Used internally to send commands off to the rendering server.
624# ----------------------------------------------------------------------
625itcl::body Rappture::HeightmapViewer::_send_text {string} {
626    if {"" == $_sid} {
627        $_dispatcher cancel !serverDown
628        set x [expr {[winfo rootx $itk_component(area)]+10}]
629        set y [expr {[winfo rooty $itk_component(area)]+10}]
630        Rappture::Tooltip::cue @$x,$y "Connecting..."
631
632        if {[catch {connect} ok] == 0 && $ok} {
633            set w [winfo width $itk_component(3dview)]
634            set h [winfo height $itk_component(3dview)]
635
636            if {[catch {puts $_sid "screen $w $h"}]} {
637                disconnect
638                _receive_echo closed
639                $_dispatcher event -after 750 !serverDown
640            } else {
641                _send_echo >>line "screen $w $h"
642
643                set _view(theta) 45
644                set _view(phi) 45
645                set _view(psi) 0
646                set _view(zoom) 1.0
647                after idle [itcl::code $this _rebuild]
648                Rappture::Tooltip::cue hide
649            }
650            return
651        }
652        Rappture::Tooltip::cue @$x,$y "Can't connect to visualization server.  This may be a network problem.  Wait a few moments and try resetting the view."
653        return
654    }
655    if {"" != $_sid} {
656        # if we're transmitting objects, then buffer this command
657        if {[llength $_sendobjs] > 0} {
658            append _buffer(out) $string "\n"
659        } else {
660            if {[catch {puts $_sid $string}]} {
661                disconnect
662                _receive_echo closed
663                $_dispatcher event -after 750 !serverDown
664            } else {
665                foreach line [split $string \n] {
666                    _send_echo >>line $line
667                }
668            }
669        }
670    }
671}
672
673# ----------------------------------------------------------------------
674# USAGE: _send_dataobjs
675#
676# Used internally to send a series of volume objects off to the
677# server.  Sends each object, a little at a time, with updates in
678# between so the interface doesn't lock up.
679# ----------------------------------------------------------------------
680itcl::body Rappture::HeightmapViewer::_send_dataobjs {} {
681    blt::busy hold $itk_component(hull); update idletasks
682
683    foreach dataobj $_sendobjs {
684        foreach comp [$dataobj components] {
685            # send the data as one huge base64-encoded mess -- yuck!
686            set data [$dataobj blob $comp]
687
688            # tell the engine to expect some data
689            set length [string length $data]
690            set cmdstr "heightmap data follows $length"
691            _send_echo >>line $cmdstr
692            if {[catch {puts $_sid $cmdstr} err]} {
693                disconnect
694                $_dispatcher event -after 750 !serverDown
695                return
696            }
697
698            while {[string length $data] > 0} {
699                update
700
701                set chunk [string range $data 0 8095]
702                set data [string range $data 8096 end]
703
704                _send_echo >>line $chunk
705                if {[catch {puts -nonewline $_sid $chunk} err]} {
706                    disconnect
707                    $_dispatcher event -after 750 !serverDown
708                    return
709                }
710                catch {flush $_sid}
711            }
712            _send_echo >>line ""
713            puts $_sid ""
714
715            set _obj2id($dataobj-$comp) $_obj2id(count)
716            incr _obj2id(count)
717
718            #
719            # Determine the transfer function needed for this volume
720            # and make sure that it's defined on the server.
721            #
722            foreach {sname cmap wmap} [_getTransfuncData $dataobj $comp] break
723            set cmdstr [list "transfunc" "define" $sname $cmap $wmap]
724            _send_echo >>line $cmdstr
725            if {[catch {puts $_sid $cmdstr} err]} {
726                disconnect
727                $_dispatcher event -after 750 !serverDown
728                return
729            }
730
731            set _obj2style($dataobj-$comp) $sname
732        }
733    }
734    set _sendobjs ""
735    blt::busy release $itk_component(hull)
736
737    # 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
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
754
755    # if there are any commands in the buffer, send them now that we're done
756    _send_echo >>line $_buffer(out)
757    if {[catch {puts $_sid $_buffer(out)} err]} {
758        disconnect
759        $_dispatcher event -after 750 !serverDown
760    }
761    set _buffer(out) ""
762
763    $_dispatcher event -idle !legend
764}
765
766# ----------------------------------------------------------------------
767# USAGE: _send_echo <channel> ?<data>?
768#
769# Used internally to echo sent data to clients interested in
770# this widget.  If the -sendcommand option is set, then it is
771# invoked in the global scope with the <channel> and <data> values
772# as arguments.  Otherwise, this does nothing.
773# ----------------------------------------------------------------------
774itcl::body Rappture::HeightmapViewer::_send_echo {channel {data ""}} {
775    if {[string length $itk_option(-sendcommand)] > 0} {
776        uplevel #0 $itk_option(-sendcommand) [list $channel $data]
777    }
778}
779
780# ----------------------------------------------------------------------
781# USAGE: _receive
782#
783# Invoked automatically whenever a command is received from the
784# rendering server.  Reads the incoming command and executes it in
785# a safe interpreter to handle the action.
786# ----------------------------------------------------------------------
787itcl::body Rappture::HeightmapViewer::_receive {} {
788    if {"" != $_sid} {
789        if {[gets $_sid line] < 0} {
790            disconnect
791            _receive_echo closed
792            $_dispatcher event -after 750 !serverDown
793        } elseif {[string equal [string range $line 0 2] "nv>"]} {
794            _receive_echo <<line $line
795            append _buffer(in) [string range $line 3 end]
796            if {[info complete $_buffer(in)]} {
797                set request $_buffer(in)
798                set _buffer(in) ""
799                $_parser eval $request
800            }
801        } else {
802            # this shows errors coming back from the engine
803            _receive_echo <<error $line
804        }
805    }
806}
807
808# ----------------------------------------------------------------------
809# USAGE: _receive_image -bytes <size>
810#
811# Invoked automatically whenever the "image" command comes in from
812# the rendering server.  Indicates that binary image data with the
813# specified <size> will follow.
814# ----------------------------------------------------------------------
815itcl::body Rappture::HeightmapViewer::_receive_image {option size} {
816    if {"" != $_sid} {
817        set bytes [read $_sid $size]
818        $_image(plot) configure -data $bytes
819        _receive_echo <<line "<read $size bytes for [image width $_image(plot)]x[image height $_image(plot)] image>"
820    }
821}
822
823# ----------------------------------------------------------------------
824# USAGE: _receive_legend <volume> <vmin> <vmax> <size>
825#
826# Invoked automatically whenever the "legend" command comes in from
827# the rendering server.  Indicates that binary image data with the
828# specified <size> will follow.
829# ----------------------------------------------------------------------
830itcl::body Rappture::HeightmapViewer::_receive_legend {ivol vmin vmax size} {
831    if {"" != $_sid} {
832        set bytes [read $_sid $size]
833        $_image(legend) configure -data $bytes
834        _receive_echo <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
835
836        set c $itk_component(legend)
837        set w [winfo width $c]
838        set h [winfo height $c]
839        if {"" == [$c find withtag transfunc]} {
840            $c create image 10 10 -anchor nw \
841                 -image $_image(legend) -tags transfunc
842
843            $c bind transfunc <ButtonPress-1> \
844                 [itcl::code $this _probe start %x %y]
845            $c bind transfunc <B1-Motion> \
846                 [itcl::code $this _probe update %x %y]
847            $c bind transfunc <ButtonRelease-1> \
848                 [itcl::code $this _probe end %x %y]
849
850            $c create text 10 [expr {$h-8}] -anchor sw \
851                 -fill $itk_option(-plotforeground) -tags vmin
852            $c create text [expr {$w-10}] [expr {$h-8}] -anchor se \
853                 -fill $itk_option(-plotforeground) -tags vmax
854        }
855
856        $c itemconfigure vmin -text $vmin
857        $c coords vmin 10 [expr {$h-8}]
858
859        $c itemconfigure vmax -text $vmax
860        $c coords vmax [expr {$w-10}] [expr {$h-8}]
861    }
862}
863
864# ----------------------------------------------------------------------
865# USAGE: _receive_echo <channel> ?<data>?
866#
867# Used internally to echo received data to clients interested in
868# this widget.  If the -receivecommand option is set, then it is
869# invoked in the global scope with the <channel> and <data> values
870# as arguments.  Otherwise, this does nothing.
871# ----------------------------------------------------------------------
872itcl::body Rappture::HeightmapViewer::_receive_echo {channel {data ""}} {
873    if {[string length $itk_option(-receivecommand)] > 0} {
874        uplevel #0 $itk_option(-receivecommand) [list $channel $data]
875    }
876}
877
878# ----------------------------------------------------------------------
879# USAGE: _rebuild
880#
881# Called automatically whenever something changes that affects the
882# data in the widget.  Clears any existing data and rebuilds the
883# widget to display new data.
884# ----------------------------------------------------------------------
885itcl::body Rappture::HeightmapViewer::_rebuild {} {
886    # in the midst of sending data? then bail out
887    if {[llength $_sendobjs] > 0} {
888        return
889    }
890
891    #
892    # Find any new data that needs to be sent to the server.
893    # Queue this up on the _sendobjs list, and send it out
894    # a little at a time.  Do this first, before we rebuild
895    # the rest.
896    #
897    foreach dataobj [get] {
898        set comp [lindex [$dataobj components] 0]
899        if {![info exists _obj2id($dataobj-$comp)]} {
900            set i [lsearch -exact $_sendobjs $dataobj]
901            if {$i < 0} {
902                lappend _sendobjs $dataobj
903            }
904        }
905    }
906    if {[llength $_sendobjs] > 0} {
907        # send off new data objects
908        after idle [itcl::code $this _send_dataobjs]
909    } else {
910        # nothing to send -- activate the proper volume
911        set first [lindex [get] 0]
912        if {"" != $first} {
913            set axis [$first hints updir]
914            if {"" != $axis} {
915                _send up $axis
916            }
917        }
918        foreach key [array names _obj2id *-*] {
919            set state [string match $first-* $key]
920            _send "heightmap" "data" "visible" $state $_obj2id($key)
921            if {[info exists _obj2style($key)]} {
922                _send "heightmap" "transfunc" $_obj2style($key) $_obj2id($key)
923            }
924        }
925        $_dispatcher event -idle !legend
926    }
927
928    #
929    # Reset the camera and other view parameters
930    #
931    eval _send camera angle [_euler2xyz $_view(theta) $_view(phi) $_view(psi)]
932    _send camera zoom $_view(zoom)
933
934     if {"" == $itk_option(-plotoutline)} {
935         eval _send "grid"  "linecolor" [_color2rgb $itk_option(-plotoutline)]
936     }
937    _fixGrid
938    _fixAxes
939    _fixContourLines
940}
941
942# ----------------------------------------------------------------------
943# USAGE: _currentHeightMapIds ?-cutplanes?
944#
945# Returns a list of volume server IDs for the current volume being
946# displayed.  This is normally a single ID, but it might be a list
947# of IDs if the current data object has multiple components.
948# ----------------------------------------------------------------------
949itcl::body Rappture::HeightmapViewer::_currentHeightMapIds {{what -all}} {
950    set rlist ""
951
952    set first [lindex [get] 0]
953    foreach key [array names _obj2id *-*] {
954        if {[string match $first-* $key]} {
955            array set style {
956                -cutplanes 1
957            }
958            foreach {dataobj comp} [split $key -] break
959            array set style [lindex [$dataobj components -style $comp] 0]
960
961            if {$what != "-cutplanes" || $style(-cutplanes)} {
962                lappend rlist $_obj2id($key)
963            }
964        }
965    }
966    return $rlist
967}
968
969# ----------------------------------------------------------------------
970# USAGE: _zoom in
971# USAGE: _zoom out
972# USAGE: _zoom reset
973#
974# Called automatically when the user clicks on one of the zoom
975# controls for this widget.  Changes the zoom for the current view.
976# ----------------------------------------------------------------------
977itcl::body Rappture::HeightmapViewer::_zoom {option} {
978    switch -- $option {
979        in {
980            set _view(zoom) [expr {$_view(zoom)*1.25}]
981            _send camera zoom $_view(zoom)
982        }
983        out {
984            set _view(zoom) [expr {$_view(zoom)*0.8}]
985            _send camera zoom $_view(zoom)
986        }
987        reset {
988            set _view(theta) 45
989            set _view(phi) 45
990            set _view(psi) 0
991            set _view(zoom) 1.0
992            eval _send camera angle [_euler2xyz $_view(theta) $_view(phi) $_view(psi)]
993            _send camera zoom $_view(zoom)
994        }
995    }
996}
997
998# ----------------------------------------------------------------------
999# USAGE: _move click <x> <y>
1000# USAGE: _move drag <x> <y>
1001# USAGE: _move release <x> <y>
1002#
1003# Called automatically when the user clicks/drags/releases in the
1004# plot area.  Moves the plot according to the user's actions.
1005# ----------------------------------------------------------------------
1006itcl::body Rappture::HeightmapViewer::_move {option x y} {
1007    switch -- $option {
1008        click {
1009            $itk_component(3dview) configure -cursor fleur
1010            set _click(x) $x
1011            set _click(y) $y
1012            set _click(theta) $_view(theta)
1013            set _click(phi) $_view(phi)
1014        }
1015        drag {
1016            if {[array size _click] == 0} {
1017                _move click $x $y
1018            } else {
1019                set w [winfo width $itk_component(3dview)]
1020                set h [winfo height $itk_component(3dview)]
1021                if {$w <= 0 || $h <= 0} {
1022                    return
1023                }
1024
1025                if {[catch {
1026                    # this fails sometimes for no apparent reason
1027                    set dx [expr {double($x-$_click(x))/$w}]
1028                    set dy [expr {double($y-$_click(y))/$h}]
1029                }]} {
1030                    return
1031                }
1032
1033                #
1034                # Rotate the camera in 3D
1035                #
1036                if {$_view(psi) > 90 || $_view(psi) < -90} {
1037                    # when psi is flipped around, theta moves backwards
1038                    set dy [expr {-$dy}]
1039                }
1040                set theta [expr {$_view(theta) - $dy*180}]
1041                while {$theta < 0} { set theta [expr {$theta+180}] }
1042                while {$theta > 180} { set theta [expr {$theta-180}] }
1043
1044                if {abs($theta) >= 30 && abs($theta) <= 160} {
1045                    set phi [expr {$_view(phi) - $dx*360}]
1046                    while {$phi < 0} { set phi [expr {$phi+360}] }
1047                    while {$phi > 360} { set phi [expr {$phi-360}] }
1048                    set psi $_view(psi)
1049                } else {
1050                    set phi $_view(phi)
1051                    set psi [expr {$_view(psi) - $dx*360}]
1052                    while {$psi < -180} { set psi [expr {$psi+360}] }
1053                    while {$psi > 180} { set psi [expr {$psi-360}] }
1054                }
1055
1056                set _view(theta) $theta
1057                set _view(phi) $phi
1058                set _view(psi) $psi
1059                eval _send camera angle [_euler2xyz $_view(theta) $_view(phi) $_view(psi)]
1060
1061                set _click(x) $x
1062                set _click(y) $y
1063            }
1064        }
1065        release {
1066            _move drag $x $y
1067            $itk_component(3dview) configure -cursor ""
1068            catch {unset _click}
1069        }
1070        default {
1071            error "bad option \"$option\": should be click, drag, release"
1072        }
1073    }
1074}
1075
1076# ----------------------------------------------------------------------
1077# USAGE: _probe start <x> <y>
1078# USAGE: _probe update <x> <y>
1079# USAGE: _probe end <x> <y>
1080#
1081# Used internally to handle the various probe operations, when the
1082# user clicks and drags on the legend area.  The probe changes the
1083# transfer function to highlight the area being selected in the
1084# legend.
1085# ----------------------------------------------------------------------
1086itcl::body Rappture::HeightmapViewer::_probe {option args} {
1087    set c $itk_component(legend)
1088    set w [winfo width $c]
1089    set h [winfo height $c]
1090    set y0 10
1091    set y1 [expr {$y0+[image height $_image(legend)]-1}]
1092
1093    set dataobj [lindex [get] 0]
1094    if {"" == $dataobj} {
1095        return
1096    }
1097    set comp [lindex [$dataobj components] 0]
1098    if {![info exists _obj2style($dataobj-$comp)]} {
1099        return
1100    }
1101
1102    switch -- $option {
1103        start {
1104            # create the probe marker on the legend
1105            $c create rect 0 0 5 $h -width 3 \
1106                -outline black -fill "" -tags markerbg
1107            $c create rect 0 0 5 $h -width 1 \
1108                -outline white -fill "" -tags marker
1109
1110            # define a new transfer function
1111            _send "transfunc" "define" "probe" {0 0 0 0 1 0 0 0} {0 0 1 0}
1112            _send "heightmap" "transfunc" "probe" $_obj2id($dataobj-$comp)
1113
1114            # now, probe this point
1115            eval _probe update $args
1116        }
1117        update {
1118            set x [lindex $args 0]
1119            if {$x < 10} {set x 10}
1120            if {$x > $w-10} {set x [expr {$w-10}]}
1121            foreach tag {markerbg marker} {
1122                $c coords $tag [expr {$x-2}] [expr {$y0-2}] \
1123                    [expr {$x+2}] [expr {$y1+2}]
1124            }
1125
1126            # value of the probe point, in the range 0-1
1127            set val [expr {double($x-10)/($w-20)}]
1128            set dl [expr {($val > 0.1) ? 0.1 : $val}]
1129            set dr [expr {($val < 0.9) ? 0.1 : 1-$val}]
1130
1131            # compute a transfer function for the probe value
1132            foreach {sname cmap wmap} [_getTransfuncData $dataobj $comp] break
1133            set wmap "0.0 0.0 [expr {$val-$dl}] 0.0 $val 1.0 [expr {$val+$dr}] 0.0 1.0 0.0"
1134            _send transfunc define "probe" $cmap $wmap
1135        }
1136        end {
1137            $c delete marker markerbg
1138
1139            # put the volume back to its old transfer function
1140             _send "heightmap" "transfunc" $_obj2style($dataobj-$comp) \
1141                $_obj2id($dataobj-$comp)
1142        }
1143        default {
1144            error "bad option \"$option\": should be start, update, end"
1145        }
1146    }
1147}
1148
1149# ----------------------------------------------------------------------
1150# USAGE: _state <component>
1151#
1152# Used internally to determine the state of a toggle button.
1153# The <component> is the itk component name of the button.
1154# Returns on/off for the state of the button.
1155# ----------------------------------------------------------------------
1156itcl::body Rappture::HeightmapViewer::_state {comp} {
1157    if {[$itk_component($comp) cget -relief] == "sunken"} {
1158        return "on"
1159    }
1160    return "off"
1161}
1162
1163# ----------------------------------------------------------------------
1164# USAGE: _fixSettings <what> ?<value>?
1165#
1166# Used internally to update rendering settings whenever parameters
1167# change in the popup settings panel.  Sends the new settings off
1168# to the back end.
1169# ----------------------------------------------------------------------
1170itcl::body Rappture::HeightmapViewer::_fixSettings {what {value ""}} {
1171    set inner [$itk_component(controls).panel component inner]
1172    switch -- $what {
1173        light {
1174            if {[isconnected]} {
1175                set val [$inner.scales.light get]
1176                set sval [expr {0.1*$val}]
1177                _send volume shading diffuse $sval
1178
1179                set sval [expr {sqrt($val+1.0)}]
1180                _send volume shading specular $sval
1181            }
1182        }
1183        transp {
1184            if {[isconnected]} {
1185                set val [$inner.scales.transp get]
1186                set sval [expr {0.2*$val+1}]
1187                _send volume shading opacity $sval
1188            }
1189        }
1190        default {
1191            error "don't know how to fix $what"
1192        }
1193    }
1194}
1195
1196# ----------------------------------------------------------------------
1197# USAGE: _fixLegend
1198#
1199# Used internally to update the legend area whenever it changes size
1200# or when the field changes.  Asks the server to send a new legend
1201# for the current field.
1202# ----------------------------------------------------------------------
1203itcl::body Rappture::HeightmapViewer::_fixLegend {} {
1204    set lineht [font metrics $itk_option(-font) -linespace]
1205    set w [expr {[winfo width $itk_component(legend)]-20}]
1206    set h [expr {[winfo height $itk_component(legend)]-20-$lineht}]
1207    set imap ""
1208
1209    set dataobj [lindex [get] 0]
1210    if {"" != $dataobj} {
1211        set comp [lindex [$dataobj components] 0]
1212        if {[info exists _obj2id($dataobj-$comp)]} {
1213            set imap $_obj2id($dataobj-$comp)
1214        }
1215    }
1216    if {$w > 0 && $h > 0 && "" != $imap} {
1217        _send "heightmap" "legend" $imap $w $h
1218    } else {
1219        $itk_component(legend) delete all
1220    }
1221}
1222
1223# ----------------------------------------------------------------------
1224# USAGE: _fixGrid
1225#
1226# Used internally to update the legend area whenever it changes size
1227# or when the field changes.  Asks the server to send a new legend
1228# for the current field.
1229# ----------------------------------------------------------------------
1230itcl::body Rappture::HeightmapViewer::_fixGrid {} {
1231    if {[isconnected]} {
1232        _send "grid" "visible" $::Rappture::HeightmapViewer::_showGrid($this)
1233    }
1234}
1235
1236
1237# ----------------------------------------------------------------------
1238# USAGE: _fixAxes
1239# ----------------------------------------------------------------------
1240itcl::body Rappture::HeightmapViewer::_fixAxes {} {
1241    if {[isconnected]} {
1242        _send "axis" "visible" $::Rappture::HeightmapViewer::_showAxes($this)
1243    }
1244}
1245
1246
1247# ----------------------------------------------------------------------
1248# USAGE: _fixLineContour
1249# ----------------------------------------------------------------------
1250itcl::body Rappture::HeightmapViewer::_fixContourLines {} {
1251    if {[isconnected]} {
1252        set dataobj [lindex [get] 0]
1253        if {"" != $dataobj} {
1254            set comp [lindex [$dataobj components] 0]
1255            if {[info exists _obj2id($dataobj-$comp)]} {
1256                set i $_obj2id($dataobj-$comp)
1257                _send "heightmap" "linecontour" "visible" \
1258                    $::Rappture::HeightmapViewer::_showContourLines($this) $i
1259            }
1260        }
1261    }
1262}
1263
1264
1265# ----------------------------------------------------------------------
1266# USAGE: _serverDown
1267#
1268# Used internally to let the user know when the connection to the
1269# visualization server has been lost.  Puts up a tip encouraging the user to
1270# press any control to reconnect. 
1271#
1272# ----------------------------------------------------------------------
1273itcl::body Rappture::HeightmapViewer::_serverDown {} {
1274    set x [expr {[winfo rootx $itk_component(area)]+10}]
1275    set y [expr {[winfo rooty $itk_component(area)]+10}]
1276    Rappture::Tooltip::cue @$x,$y "Lost connection to visualization server.  This happens sometimes when there are too many users and the system runs out of memory.\n\nTo reconnect, reset the view or press any other control.  Your picture should come right back up."
1277}
1278
1279# ----------------------------------------------------------------------
1280# USAGE: _getTransfuncData <dataobj> <comp>
1281#
1282# Used internally to compute the colormap and alpha map used to define
1283# a transfer function for the specified component in a data object.
1284# Returns: name {v r g b ...} {v w ...}
1285# ----------------------------------------------------------------------
1286itcl::body Rappture::HeightmapViewer::_getTransfuncData {dataobj comp} {
1287    array set style {
1288        -color rainbow
1289        -levels 6
1290        -opacity 0.5
1291    }
1292    array set style [lindex [$dataobj components -style $comp] 0]
1293    set sname "$style(-color):$style(-levels):$style(-opacity)"
1294
1295    if {$style(-color) == "rainbow"} {
1296        set style(-color) "white:yellow:green:cyan:blue:magenta"
1297    }
1298    set clist [split $style(-color) :]
1299    set cmap "0.0 [_color2rgb white] "
1300    for {set i 0} {$i < [llength $clist]} {incr i} {
1301        set xval [expr {double($i+1)/([llength $clist]+1)}]
1302        set color [lindex $clist $i]
1303        append cmap "$xval [_color2rgb $color] "
1304    }
1305    append cmap "1.0 [_color2rgb $color]"
1306
1307    set max $style(-opacity)
1308    set levels $style(-levels)
1309    if {[string is int $levels]} {
1310        set wmap "0.0 0.0 "
1311        set delta [expr {0.125/($levels+1)}]
1312        for {set i 1} {$i <= $levels} {incr i} {
1313            # add spikes in the middle
1314            set xval [expr {double($i)/($levels+1)}]
1315            append wmap "[expr {$xval-$delta-0.01}] 0.0  [expr {$xval-$delta}] $max [expr {$xval+$delta}] $max  [expr {$xval+$delta+0.01}] 0.0 "
1316        }
1317        append wmap "1.0 0.0 "
1318    } else {
1319        set wmap "0.0 0.0 "
1320        set delta 0.05
1321        foreach xval [split $levels ,] {
1322            append wmap "[expr {$xval-$delta}] 0.0  $xval $max [expr {$xval+$delta}] 0.0 "
1323        }
1324        append wmap "1.0 0.0 "
1325    }
1326
1327    return [list $sname $cmap $wmap]
1328}
1329
1330# ----------------------------------------------------------------------
1331# USAGE: _color2rgb <color>
1332#
1333# Used internally to convert a color name to a set of {r g b} values
1334# needed for the engine.  Each r/g/b component is scaled in the
1335# range 0-1.
1336# ----------------------------------------------------------------------
1337itcl::body Rappture::HeightmapViewer::_color2rgb {color} {
1338    foreach {r g b} [winfo rgb $itk_component(hull) $color] break
1339    set r [expr {$r/65535.0}]
1340    set g [expr {$g/65535.0}]
1341    set b [expr {$b/65535.0}]
1342    return [list $r $g $b]
1343}
1344
1345# ----------------------------------------------------------------------
1346# USAGE: _euler2xyz <theta> <phi> <psi>
1347#
1348# Used internally to convert euler angles for the camera placement
1349# the to angles of rotation about the x/y/z axes, used by the engine.
1350# Returns a list:  {xangle, yangle, zangle}.
1351# ----------------------------------------------------------------------
1352itcl::body Rappture::HeightmapViewer::_euler2xyz {theta phi psi} {
1353    set xangle [expr {$theta-90.0}]
1354    set yangle [expr {180-$phi}]
1355    set zangle $psi
1356    return [list $xangle $yangle $zangle]
1357}
1358
1359# ----------------------------------------------------------------------
1360# CONFIGURATION OPTION: -plotbackground
1361# ----------------------------------------------------------------------
1362itcl::configbody Rappture::HeightmapViewer::plotbackground {
1363    foreach {r g b} [_color2rgb $itk_option(-plotbackground)] break
1364    #fix this!
1365    #_send color background $r $g $b
1366}
1367
1368# ----------------------------------------------------------------------
1369# CONFIGURATION OPTION: -plotforeground
1370# ----------------------------------------------------------------------
1371itcl::configbody Rappture::HeightmapViewer::plotforeground {
1372    foreach {r g b} [_color2rgb $itk_option(-plotforeground)] break
1373    #fix this!
1374    #_send color background $r $g $b
1375}
1376
1377# ----------------------------------------------------------------------
1378# CONFIGURATION OPTION: -plotoutline
1379# ----------------------------------------------------------------------
1380itcl::configbody Rappture::HeightmapViewer::plotoutline {
1381    if {[isconnected]} {
1382        eval _send "grid" "linecolor" [_color2rgb $itk_option(-plotoutline)]
1383    }
1384}
Note: See TracBrowser for help on using the repository browser.