source: trunk/gui/scripts/nanovisviewer.tcl @ 468

Last change on this file since 468 was 468, checked in by mmc, 18 years ago

Fixed bugs that showed up in the nanovis viewer when you switch between
two different fields or clear the existing result viewer.

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