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

Last change on this file since 462 was 462, checked in by mmc, 15 years ago

Fixed nanovis to take a series of server names as a comma-separated
list, and to try them one after another to make a connection. That
way, if one server is down, you can still reach the rest of the farm.

Added a customized bug handler that looks a little less frightening
than the standard Tcl dialog. Someday, this should log all errors
to a web service, but for now, it just encourages the user to do so.

File size: 51.1 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}
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    }
444    foreach {opt val} $settings {
445        if {![info exists params($opt)]} {
446            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
447        }
448        set params($opt) $val
449    }
450    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
451        # can't handle -autocolors yet
452        set params(-color) black
453    }
454
455    set pos [lsearch -exact $dataobj $_dlist]
456    if {$pos < 0} {
457        lappend _dlist $dataobj
458        set _obj2ovride($dataobj-color) $params(-color)
459        set _obj2ovride($dataobj-width) $params(-width)
460        set _obj2ovride($dataobj-raise) $params(-raise)
461
462        after cancel [itcl::code $this _rebuild]
463        after idle [itcl::code $this _rebuild]
464    }
465}
466
467# ----------------------------------------------------------------------
468# USAGE: get
469#
470# Clients use this to query the list of objects being plotted, in
471# order from bottom to top of this result.
472# ----------------------------------------------------------------------
473itcl::body Rappture::NanovisViewer::get {} {
474    # put the dataobj list in order according to -raise options
475    set dlist $_dlist
476    foreach obj $dlist {
477        if {[info exists _obj2ovride($obj-raise)] && $_obj2ovride($obj-raise)} {
478            set i [lsearch -exact $dlist $obj]
479            if {$i >= 0} {
480                set dlist [lreplace $dlist $i $i]
481                lappend dlist $obj
482            }
483        }
484    }
485    return $dlist
486}
487
488# ----------------------------------------------------------------------
489# USAGE: delete ?<dataobj1> <dataobj2> ...?
490#
491# Clients use this to delete a dataobj from the plot.  If no dataobjs
492# are specified, then all dataobjs are deleted.
493# ----------------------------------------------------------------------
494itcl::body Rappture::NanovisViewer::delete {args} {
495    if {[llength $args] == 0} {
496        set args $_dlist
497    }
498
499    # delete all specified dataobjs
500    set changed 0
501    foreach dataobj $args {
502        set pos [lsearch -exact $_dlist $dataobj]
503        if {$pos >= 0} {
504            set _dlist [lreplace $_dlist $pos $pos]
505            foreach key [array names _obj2ovride $dataobj-*] {
506                unset _obj2ovride($key)
507            }
508            set changed 1
509        }
510    }
511
512    # if anything changed, then rebuild the plot
513    if {$changed} {
514        after cancel [itcl::code $this _rebuild]
515        after idle [itcl::code $this _rebuild]
516    }
517}
518
519# ----------------------------------------------------------------------
520# USAGE: scale ?<data1> <data2> ...?
521#
522# Sets the default limits for the overall plot according to the
523# limits of the data for all of the given <data> objects.  This
524# accounts for all objects--even those not showing on the screen.
525# Because of this, the limits are appropriate for all objects as
526# the user scans through data in the ResultSet viewer.
527# ----------------------------------------------------------------------
528itcl::body Rappture::NanovisViewer::scale {args} {
529    foreach val {xmin xmax ymin ymax zmin zmax vmin vmax} {
530        set _limits($val) ""
531    }
532    foreach obj $args {
533        foreach axis {x y z v} {
534            foreach {min max} [$obj limits $axis] break
535            if {"" != $min && "" != $max} {
536                if {"" == $_limits(${axis}min)} {
537                    set _limits(${axis}min) $min
538                    set _limits(${axis}max) $max
539                } else {
540                    if {$min < $_limits(${axis}min)} {
541                        set _limits(${axis}min) $min
542                    }
543                    if {$max > $_limits(${axis}max)} {
544                        set _limits(${axis}max) $max
545                    }
546                }
547            }
548        }
549    }
550}
551
552# ----------------------------------------------------------------------
553# USAGE: download coming
554# USAGE: download now
555#
556# Clients use this method to create a downloadable representation
557# of the plot.  Returns a list of the form {ext string}, where
558# "ext" is the file extension (indicating the type of data) and
559# "string" is the data itself.
560# ----------------------------------------------------------------------
561itcl::body Rappture::NanovisViewer::download {option} {
562    switch $option {
563        coming {
564            if {[catch {blt::winop snap $itk_component(area) $_image(download)}]} {
565                $_image(download) configure -width 1 -height 1
566                $_image(download) put #000000
567            }
568        }
569        now {
570            #
571            # Hack alert!  Need data in binary format,
572            # so we'll save to a file and read it back.
573            #
574            set tmpfile /tmp/image[pid].jpg
575            $_image(download) write $tmpfile -format jpeg
576            set fid [open $tmpfile r]
577            fconfigure $fid -encoding binary -translation binary
578            set bytes [read $fid]
579            close $fid
580            file delete -force $tmpfile
581
582            return [list .jpg $bytes]
583        }
584        default {
585            error "bad option \"$option\": should be coming, now"
586        }
587    }
588}
589
590# ----------------------------------------------------------------------
591# USAGE: connect ?<host:port>,<host:port>...?
592#
593# Clients use this method to establish a connection to a new
594# server, or to reestablish a connection to the previous server.
595# Any existing connection is automatically closed.
596# ----------------------------------------------------------------------
597itcl::body Rappture::NanovisViewer::connect {{hostlist ""}} {
598    disconnect
599
600    if {"" != $hostlist} { set _nvhosts $hostlist }
601
602    if {"" == $_nvhosts} {
603        return 0
604    }
605
606    blt::busy hold $itk_component(hull); update idletasks
607
608    # HACK ALERT! punt on this for now
609    set memorySize 10000
610
611    #
612    # Connect to the nanovis server.  Send the server some estimate
613    # of the size of our job.  If it's too busy, that server may
614    # forward us to another.
615    #
616    set try [split $_nvhosts ,]
617    foreach {hostname port} [split [lindex $try 0] :] break
618    set try [lrange $try 1 end]
619
620    while {1} {
621        if {[catch {socket $hostname $port} sid]} {
622            if {[llength $try] == 0} {
623                return 0
624            }
625            foreach {hostname port} [split [lindex $try 0] :] break
626            set try [lrange $try 1 end]
627            continue
628        }
629        fconfigure $sid -translation binary -encoding binary
630
631        # send memory requirement to the load balancer
632        puts -nonewline $sid [binary format i $memorySize]
633        flush $sid
634
635        # read back a reconnection order
636        set data [read $sid 4]
637        if {[binary scan $data cccc b1 b2 b3 b4] != 4} {
638            error "couldn't read redirection request"
639        }
640        set addr [format "%u.%u.%u.%u" \
641            [expr {$b1 & 0xff}] \
642            [expr {$b2 & 0xff}] \
643            [expr {$b3 & 0xff}] \
644            [expr {$b4 & 0xff}]]
645
646        if {[string equal $addr "0.0.0.0"]} {
647            fconfigure $sid -buffering line
648            fileevent $sid readable [itcl::code $this _receive]
649            set _sid $sid
650            return 1
651        }
652        set hostname $addr
653    }
654    blt::busy release $itk_component(hull)
655
656    return 0
657}
658
659# ----------------------------------------------------------------------
660# USAGE: disconnect
661#
662# Clients use this method to disconnect from the current rendering
663# server.
664# ----------------------------------------------------------------------
665itcl::body Rappture::NanovisViewer::disconnect {} {
666    if {"" != $_sid} {
667        catch {close $_sid}
668        set _sid ""
669    }
670
671    set _buffer(in) ""
672    set _buffer(out) ""
673
674    # disconnected -- no more data sitting on server
675    catch {unset _obj2id}
676    set _obj2id(count) 0
677    set _sendobjs ""
678}
679
680# ----------------------------------------------------------------------
681# USAGE: isconnected
682#
683# Clients use this method to see if we are currently connected to
684# a server.
685# ----------------------------------------------------------------------
686itcl::body Rappture::NanovisViewer::isconnected {} {
687    return [expr {"" != $_sid}]
688}
689
690# ----------------------------------------------------------------------
691# USAGE: _send <arg> <arg> ...
692#
693# Used internally to send commands off to the rendering server.
694# ----------------------------------------------------------------------
695itcl::body Rappture::NanovisViewer::_send {args} {
696    if {"" == $_sid} {
697        $_dispatcher cancel !serverDown
698        set x [expr {[winfo rootx $itk_component(area)]+10}]
699        set y [expr {[winfo rooty $itk_component(area)]+10}]
700        Rappture::Tooltip::cue @$x,$y "Connecting..."
701
702        if {[catch {connect} ok] == 0 && $ok} {
703            set w [winfo width $itk_component(3dview)]
704            set h [winfo height $itk_component(3dview)]
705            puts $_sid "screen $w $h"
706            set _view(theta) 45
707            set _view(phi) 45
708            set _view(psi) 0
709            set _view(zoom) 1.0
710            after idle [itcl::code $this _rebuild]
711            Rappture::Tooltip::cue hide
712            return
713        }
714        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."
715        return
716    }
717    if {"" != $_sid} {
718        # if we're transmitting objects, then buffer this command
719        if {[llength $_sendobjs] > 0} {
720            append _buffer(out) $args "\n"
721        } else {
722            puts $_sid $args
723        }
724    }
725}
726
727# ----------------------------------------------------------------------
728# USAGE: _send_dataobjs
729#
730# Used internally to send a series of volume objects off to the
731# server.  Sends each object, a little at a time, with updates in
732# between so the interface doesn't lock up.
733# ----------------------------------------------------------------------
734itcl::body Rappture::NanovisViewer::_send_dataobjs {} {
735    blt::busy hold $itk_component(hull); update idletasks
736
737    foreach dataobj $_sendobjs {
738        foreach comp [$dataobj components] {
739            # send the data as one huge base64-encoded mess -- yuck!
740            set data [$dataobj values $comp]
741
742            # tell the engine to expect some data
743            set cmdstr "volume data follows [string length $data]"
744            if {[catch {puts $_sid $cmdstr} err]} {
745                disconnect
746                $_dispatcher event -after 750 !serverDown
747                return
748            }
749
750            while {[string length $data] > 0} {
751                update
752
753                set chunk [string range $data 0 8095]
754                set data [string range $data 8096 end]
755
756                if {[catch {puts -nonewline $_sid $chunk} err]} {
757                    disconnect
758                    $_dispatcher event -after 750 !serverDown
759                    return
760                }
761                catch {flush $_sid}
762            }
763            puts $_sid ""
764
765            set _obj2id($dataobj-$comp) $_obj2id(count)
766            incr _obj2id(count)
767
768            #
769            # Determine the transfer function needed for this volume
770            # and make sure that it's defined on the server.
771            #
772            foreach {sname cmap wmap} [_getTransfuncData $dataobj $comp] break
773
774            set cmdstr [list transfunc define $sname $cmap $wmap]
775            if {[catch {puts $_sid $cmdstr} err]} {
776                disconnect
777                $_dispatcher event -after 750 !serverDown
778                return
779            }
780
781            set _obj2style($dataobj-$comp) $sname
782        }
783    }
784    set _sendobjs ""
785    blt::busy release $itk_component(hull)
786
787    # activate the proper volume
788    set first [lindex [get] 0]
789
790    set axis [$first hints updir]
791    if {"" != $axis} {
792        _send up $axis
793    }
794
795    foreach key [array names _obj2id *-*] {
796        set state [string match $first-* $key]
797        _send volume state $state $_obj2id($key)
798        if {[info exists _obj2style($key)]} {
799            _send volume shading transfunc $_obj2style($key) $_obj2id($key)
800        }
801    }
802
803    # sync the state of slicers
804    foreach axis {x y z} {
805        eval _send cutplane state [_state ${axis}slice] \
806            $axis [_currentVolumeIds]
807    }
808    eval _send volume data state [_state volume] [_currentVolumeIds]
809
810    # if there are any commands in the buffer, send them now that we're done
811    if {[catch {puts $_sid $_buffer(out)} err]} {
812        disconnect
813        $_dispatcher event -after 750 !serverDown
814    }
815    set _buffer(out) ""
816
817    $_dispatcher event -idle !legend
818}
819
820# ----------------------------------------------------------------------
821# USAGE: _receive
822#
823# Invoked automatically whenever a command is received from the
824# rendering server.  Reads the incoming command and executes it in
825# a safe interpreter to handle the action.
826# ----------------------------------------------------------------------
827itcl::body Rappture::NanovisViewer::_receive {} {
828    if {"" != $_sid} {
829        if {[gets $_sid line] < 0} {
830            disconnect
831            $_dispatcher event -after 750 !serverDown
832        } elseif {[string equal [string range $line 0 2] "nv>"]} {
833            append _buffer(in) [string range $line 3 end]
834            if {[info complete $_buffer(in)]} {
835                set request $_buffer(in)
836                set _buffer(in) ""
837                $_parser eval $request
838            }
839        } else {
840            # this shows errors coming back from the engine
841            ##puts $line
842        }
843    }
844}
845
846# ----------------------------------------------------------------------
847# USAGE: _receive_image -bytes <size>
848#
849# Invoked automatically whenever the "image" command comes in from
850# the rendering server.  Indicates that binary image data with the
851# specified <size> will follow.
852# ----------------------------------------------------------------------
853itcl::body Rappture::NanovisViewer::_receive_image {option size} {
854    if {"" != $_sid} {
855        set bytes [read $_sid $size]
856        $_image(plot) configure -data $bytes
857    }
858}
859
860# ----------------------------------------------------------------------
861# USAGE: _receive_legend <volume> <vmin> <vmax> <size>
862#
863# Invoked automatically whenever the "legend" command comes in from
864# the rendering server.  Indicates that binary image data with the
865# specified <size> will follow.
866# ----------------------------------------------------------------------
867itcl::body Rappture::NanovisViewer::_receive_legend {ivol vmin vmax size} {
868    if {"" != $_sid} {
869        set bytes [read $_sid $size]
870        $_image(legend) configure -data $bytes
871
872        set c $itk_component(legend)
873        set w [winfo width $c]
874        set h [winfo height $c]
875        if {"" == [$c find withtag transfunc]} {
876            $c create image 10 10 -anchor nw \
877                 -image $_image(legend) -tags transfunc
878
879            $c bind transfunc <ButtonPress-1> \
880                 [itcl::code $this _probe start %x %y]
881            $c bind transfunc <B1-Motion> \
882                 [itcl::code $this _probe update %x %y]
883            $c bind transfunc <ButtonRelease-1> \
884                 [itcl::code $this _probe end %x %y]
885
886            $c create text 10 [expr {$h-8}] -anchor sw \
887                 -fill $itk_option(-plotforeground) -tags vmin
888            $c create text [expr {$w-10}] [expr {$h-8}] -anchor se \
889                 -fill $itk_option(-plotforeground) -tags vmax
890        }
891
892        $c itemconfigure vmin -text $vmin
893        $c coords vmin 10 [expr {$h-8}]
894
895        $c itemconfigure vmax -text $vmax
896        $c coords vmax [expr {$w-10}] [expr {$h-8}]
897    }
898}
899
900# ----------------------------------------------------------------------
901# USAGE: _rebuild
902#
903# Called automatically whenever something changes that affects the
904# data in the widget.  Clears any existing data and rebuilds the
905# widget to display new data.
906# ----------------------------------------------------------------------
907itcl::body Rappture::NanovisViewer::_rebuild {} {
908    # in the midst of sending data? then bail out
909    if {[llength $_sendobjs] > 0} {
910        return
911    }
912
913    #
914    # Find any new data that needs to be sent to the server.
915    # Queue this up on the _sendobjs list, and send it out
916    # a little at a time.  Do this first, before we rebuild
917    # the rest.
918    #
919    foreach dataobj [get] {
920        set comp [lindex [$dataobj components] 0]
921        if {![info exists _obj2id($dataobj-$comp)]} {
922            set i [lsearch -exact $_sendobjs $dataobj]
923            if {$i < 0} {
924                lappend _sendobjs $dataobj
925            }
926        }
927    }
928    if {[llength $_sendobjs] > 0} {
929        # send off new data objects
930        after idle [itcl::code $this _send_dataobjs]
931    } else {
932        # nothing to send -- activate the proper volume
933        set first [lindex [get] 0]
934
935        set axis [$first hints updir]
936        if {"" != $axis} {
937            _send up $axis
938        }
939        foreach key [array names _obj2id *-*] {
940            set state [string match $first-* $key]
941            _send volume state $state $_obj2id($key)
942            if {[info exists _obj2style($key)]} {
943                _send volume shading transfunc $_obj2style($key) $_obj2id($key)
944            }
945        }
946
947        # sync the state of slicers
948        foreach axis {x y z} {
949            eval _send cutplane state [_state ${axis}slice] \
950                $axis [_currentVolumeIds]
951        }
952        eval _send volume data state [_state volume] [_currentVolumeIds]
953        $_dispatcher event -idle !legend
954    }
955
956    #
957    # Reset the camera and other view parameters
958    #
959    eval _send camera angle [_euler2xyz $_view(theta) $_view(phi) $_view(psi)]
960    _send camera zoom $_view(zoom)
961    #_fixSettings light
962    #_fixSettings transp
963
964    if {"" == $itk_option(-plotoutline)} {
965        _send volume outline state off
966    } else {
967        _send volume outline state on
968        _send volume outline color [_color2rgb $itk_option(-plotoutline)]
969    }
970    _send volume axis label x ""
971    _send volume axis label y ""
972    _send volume axis label z ""
973}
974
975# ----------------------------------------------------------------------
976# USAGE: _currentVolumeIds
977#
978# Returns a list of volume server IDs for the current volume being
979# displayed.  This is normally a single ID, but it might be a list
980# of IDs if the current data object has multiple components.
981# ----------------------------------------------------------------------
982itcl::body Rappture::NanovisViewer::_currentVolumeIds {} {
983    set rlist ""
984
985    set first [lindex [get] 0]
986    foreach key [array names _obj2id *-*] {
987        if {[string match $first-* $key]} {
988            lappend rlist $_obj2id($key)
989        }
990    }
991    return $rlist
992}
993
994# ----------------------------------------------------------------------
995# USAGE: _zoom in
996# USAGE: _zoom out
997# USAGE: _zoom reset
998#
999# Called automatically when the user clicks on one of the zoom
1000# controls for this widget.  Changes the zoom for the current view.
1001# ----------------------------------------------------------------------
1002itcl::body Rappture::NanovisViewer::_zoom {option} {
1003    switch -- $option {
1004        in {
1005            set _view(zoom) [expr {$_view(zoom)*1.25}]
1006            _send camera zoom $_view(zoom)
1007        }
1008        out {
1009            set _view(zoom) [expr {$_view(zoom)*0.8}]
1010            _send camera zoom $_view(zoom)
1011        }
1012        reset {
1013            set _view(theta) 45
1014            set _view(phi) 45
1015            set _view(psi) 0
1016            set _view(zoom) 1.0
1017            eval _send camera angle [_euler2xyz $_view(theta) $_view(phi) $_view(psi)]
1018            _send camera zoom $_view(zoom)
1019        }
1020    }
1021}
1022
1023# ----------------------------------------------------------------------
1024# USAGE: _move click <x> <y>
1025# USAGE: _move drag <x> <y>
1026# USAGE: _move release <x> <y>
1027#
1028# Called automatically when the user clicks/drags/releases in the
1029# plot area.  Moves the plot according to the user's actions.
1030# ----------------------------------------------------------------------
1031itcl::body Rappture::NanovisViewer::_move {option x y} {
1032    switch -- $option {
1033        click {
1034            $itk_component(3dview) configure -cursor fleur
1035            set _click(x) $x
1036            set _click(y) $y
1037            set _click(theta) $_view(theta)
1038            set _click(phi) $_view(phi)
1039        }
1040        drag {
1041            if {[array size _click] == 0} {
1042                _move click $x $y
1043            } else {
1044                set w [winfo width $itk_component(3dview)]
1045                set h [winfo height $itk_component(3dview)]
1046                if {$w <= 0 || $h <= 0} {
1047                    return
1048                }
1049
1050                if {[catch {
1051                    # this fails sometimes for no apparent reason
1052                    set dx [expr {double($x-$_click(x))/$w}]
1053                    set dy [expr {double($y-$_click(y))/$h}]
1054                }]} {
1055                    return
1056                }
1057
1058                #
1059                # Rotate the camera in 3D
1060                #
1061                if {$_view(psi) > 90 || $_view(psi) < -90} {
1062                    # when psi is flipped around, theta moves backwards
1063                    set dy [expr {-$dy}]
1064                }
1065                set theta [expr {$_view(theta) - $dy*180}]
1066                while {$theta < 0} { set theta [expr {$theta+180}] }
1067                while {$theta > 180} { set theta [expr {$theta-180}] }
1068
1069                if {abs($theta) >= 30 && abs($theta) <= 160} {
1070                    set phi [expr {$_view(phi) - $dx*360}]
1071                    while {$phi < 0} { set phi [expr {$phi+360}] }
1072                    while {$phi > 360} { set phi [expr {$phi-360}] }
1073                    set psi $_view(psi)
1074                } else {
1075                    set phi $_view(phi)
1076                    set psi [expr {$_view(psi) - $dx*360}]
1077                    while {$psi < -180} { set psi [expr {$psi+360}] }
1078                    while {$psi > 180} { set psi [expr {$psi-360}] }
1079                }
1080
1081                set _view(theta) $theta
1082                set _view(phi) $phi
1083                set _view(psi) $psi
1084                eval _send camera angle [_euler2xyz $_view(theta) $_view(phi) $_view(psi)]
1085
1086                set _click(x) $x
1087                set _click(y) $y
1088            }
1089        }
1090        release {
1091            _move drag $x $y
1092            $itk_component(3dview) configure -cursor ""
1093            catch {unset _click}
1094        }
1095        default {
1096            error "bad option \"$option\": should be click, drag, release"
1097        }
1098    }
1099}
1100
1101# ----------------------------------------------------------------------
1102# USAGE: _slice axis x|y|z ?on|off|toggle?
1103# USAGE: _slice move x|y|z <newval>
1104# USAGE: _slice volume ?on|off|toggle?
1105#
1106# Called automatically when the user drags the slider to move the
1107# cut plane that slices 3D data.  Gets the current value from the
1108# slider and moves the cut plane to the appropriate point in the
1109# data set.
1110# ----------------------------------------------------------------------
1111itcl::body Rappture::NanovisViewer::_slice {option args} {
1112    switch -- $option {
1113        axis {
1114            if {[llength $args] < 1 || [llength $args] > 2} {
1115                error "wrong # args: should be \"_slice axis x|y|z ?on|off|toggle?\""
1116            }
1117            set axis [lindex $args 0]
1118            set op [lindex $args 1]
1119            if {$op == ""} { set op "on" }
1120
1121            set current [_state ${axis}slice]
1122            if {$op == "toggle"} {
1123                if {$current == "on"} { set op "off" } else { set op "on" }
1124            }
1125
1126            if {$op} {
1127                $itk_component(${axis}slicer) configure -state normal
1128                eval _send cutplane state on $axis [_currentVolumeIds]
1129                $itk_component(${axis}slice) configure -relief sunken
1130            } else {
1131                $itk_component(${axis}slicer) configure -state disabled
1132                eval _send cutplane state off $axis [_currentVolumeIds]
1133                $itk_component(${axis}slice) configure -relief raised
1134            }
1135        }
1136        move {
1137            if {[llength $args] != 2} {
1138                error "wrong # args: should be \"_slice move x|y|z newval\""
1139            }
1140            set axis [lindex $args 0]
1141            set newval [lindex $args 1]
1142
1143            set newpos [expr {0.01*$newval}]
1144#            set newval [expr {0.01*($newval-50)
1145#                *($_limits(${axis}max)-$_limits(${axis}min))
1146#                  + 0.5*($_limits(${axis}max)+$_limits(${axis}min))}]
1147
1148            # show the current value in the readout
1149#puts "readout: $axis = $newval"
1150
1151            eval _send cutplane position $newpos $axis [_currentVolumeIds]
1152        }
1153        volume {
1154            if {[llength $args] > 1} {
1155                error "wrong # args: should be \"_slice volume ?on|off|toggle?\""
1156            }
1157            set op [lindex $args 0]
1158            if {$op == ""} { set op "on" }
1159
1160            set current [_state volume]
1161            if {$op == "toggle"} {
1162                if {$current == "on"} { set op "off" } else { set op "on" }
1163            }
1164
1165            if {$op} {
1166                eval _send volume data state on [_currentVolumeIds]
1167                $itk_component(volume) configure -relief sunken
1168            } else {
1169                eval _send volume data state off [_currentVolumeIds]
1170                $itk_component(volume) configure -relief raised
1171            }
1172        }
1173        default {
1174            error "bad option \"$option\": should be axis, move, or volume"
1175        }
1176    }
1177}
1178
1179# ----------------------------------------------------------------------
1180# USAGE: _slicertip <axis>
1181#
1182# Used internally to generate a tooltip for the x/y/z slicer controls.
1183# Returns a message that includes the current slicer value.
1184# ----------------------------------------------------------------------
1185itcl::body Rappture::NanovisViewer::_slicertip {axis} {
1186    set val [$itk_component(${axis}slicer) get]
1187#    set val [expr {0.01*($val-50)
1188#        *($_limits(${axis}max)-$_limits(${axis}min))
1189#          + 0.5*($_limits(${axis}max)+$_limits(${axis}min))}]
1190    return "Move the [string toupper $axis] cut plane.\nCurrently:  $axis = $val%"
1191}
1192
1193# ----------------------------------------------------------------------
1194# USAGE: _probe start <x> <y>
1195# USAGE: _probe update <x> <y>
1196# USAGE: _probe end <x> <y>
1197#
1198# Used internally to handle the various probe operations, when the
1199# user clicks and drags on the legend area.  The probe changes the
1200# transfer function to highlight the area being selected in the
1201# legend.
1202# ----------------------------------------------------------------------
1203itcl::body Rappture::NanovisViewer::_probe {option args} {
1204    set c $itk_component(legend)
1205    set w [winfo width $c]
1206    set h [winfo height $c]
1207    set y0 10
1208    set y1 [expr {$y0+[image height $_image(legend)]-1}]
1209
1210    set dataobj [lindex [get] 0]
1211    set comp [lindex [$dataobj components] 0]
1212    if {![info exists _obj2style($dataobj-$comp)]} {
1213        return
1214    }
1215
1216    switch -- $option {
1217        start {
1218            # create the probe marker on the legend
1219            $c create rect 0 0 5 $h -width 3 \
1220                -outline black -fill "" -tags markerbg
1221            $c create rect 0 0 5 $h -width 1 \
1222                -outline white -fill "" -tags marker
1223
1224            # define a new transfer function
1225            _send transfunc define probe {0 0 0 0 1 0 0 0} {0 0 1 0}
1226            _send volume shading transfunc probe $_obj2id($dataobj-$comp)
1227
1228            # now, probe this point
1229            eval _probe update $args
1230        }
1231        update {
1232            set x [lindex $args 0]
1233            if {$x < 10} {set x 10}
1234            if {$x > $w-10} {set x [expr {$w-10}]}
1235            foreach tag {markerbg marker} {
1236                $c coords $tag [expr {$x-2}] [expr {$y0-2}] \
1237                    [expr {$x+2}] [expr {$y1+2}]
1238            }
1239
1240            # value of the probe point, in the range 0-1
1241            set val [expr {double($x-10)/($w-20)}]
1242            set dl [expr {($val > 0.1) ? 0.1 : $val}]
1243            set dr [expr {($val < 0.9) ? 0.1 : 1-$val}]
1244
1245            # compute a transfer function for the probe value
1246            foreach {sname cmap wmap} [_getTransfuncData $dataobj $comp] break
1247            set wmap "0.0 0.0 [expr {$val-$dl}] 0.0 $val 1.0 [expr {$val+$dr}] 0.0 1.0 0.0"
1248            _send transfunc define probe $cmap $wmap
1249        }
1250        end {
1251            $c delete marker markerbg
1252
1253            # put the volume back to its old transfer function
1254            _send volume shading transfunc $_obj2style($dataobj-$comp) $_obj2id($dataobj-$comp)
1255        }
1256        default {
1257            error "bad option \"$option\": should be start, update, end"
1258        }
1259    }
1260}
1261
1262# ----------------------------------------------------------------------
1263# USAGE: _state <component>
1264#
1265# Used internally to determine the state of a toggle button.
1266# The <component> is the itk component name of the button.
1267# Returns on/off for the state of the button.
1268# ----------------------------------------------------------------------
1269itcl::body Rappture::NanovisViewer::_state {comp} {
1270    if {[$itk_component($comp) cget -relief] == "sunken"} {
1271        return "on"
1272    }
1273    return "off"
1274}
1275
1276# ----------------------------------------------------------------------
1277# USAGE: _fixSettings <what> ?<value>?
1278#
1279# Used internally to update rendering settings whenever parameters
1280# change in the popup settings panel.  Sends the new settings off
1281# to the back end.
1282# ----------------------------------------------------------------------
1283itcl::body Rappture::NanovisViewer::_fixSettings {what {value ""}} {
1284    set inner [$itk_component(controls).panel component inner]
1285    switch -- $what {
1286        light {
1287            if {[isconnected]} {
1288                set val [$inner.scales.light get]
1289                set sval [expr {0.1*$val}]
1290                _send volume shading diffuse $sval
1291
1292                set sval [expr {sqrt($val+1.0)}]
1293                _send volume shading specular $sval
1294            }
1295        }
1296        transp {
1297            if {[isconnected]} {
1298                set val [$inner.scales.transp get]
1299                set sval [expr {0.2*$val+1}]
1300                _send volume shading opacity $sval
1301            }
1302        }
1303        default {
1304            error "don't know how to fix $what"
1305        }
1306    }
1307}
1308
1309# ----------------------------------------------------------------------
1310# USAGE: _fixLegend
1311#
1312# Used internally to update the legend area whenever it changes size
1313# or when the field changes.  Asks the server to send a new legend
1314# for the current field.
1315# ----------------------------------------------------------------------
1316itcl::body Rappture::NanovisViewer::_fixLegend {} {
1317    set lineht [font metrics $itk_option(-font) -linespace]
1318    set w [expr {[winfo width $itk_component(legend)]-20}]
1319    set h [expr {[winfo height $itk_component(legend)]-20-$lineht}]
1320    set ivol ""
1321
1322    set dataobj [lindex [get] 0]
1323    set comp [lindex [$dataobj components] 0]
1324    if {[info exists _obj2id($dataobj-$comp)]} {
1325        set ivol $_obj2id($dataobj-$comp)
1326    }
1327
1328    if {$w > 0 && $h > 0 && "" != $ivol} {
1329        _send legend $ivol $w $h
1330    } else {
1331        $itk_component(legend) delete all
1332    }
1333}
1334
1335# ----------------------------------------------------------------------
1336# USAGE: _serverDown
1337#
1338# Used internally to let the user know when the connection to the
1339# visualization server has been lost.  Puts up a tip encouraging the
1340# user to press any control to reconnect.
1341# ----------------------------------------------------------------------
1342itcl::body Rappture::NanovisViewer::_serverDown {} {
1343    set x [expr {[winfo rootx $itk_component(area)]+10}]
1344    set y [expr {[winfo rooty $itk_component(area)]+10}]
1345    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."
1346}
1347
1348# ----------------------------------------------------------------------
1349# USAGE: _getTransfuncData <dataobj> <comp>
1350#
1351# Used internally to compute the colormap and alpha map used to define
1352# a transfer function for the specified component in a data object.
1353# Returns: name {v r g b ...} {v w ...}
1354# ----------------------------------------------------------------------
1355itcl::body Rappture::NanovisViewer::_getTransfuncData {dataobj comp} {
1356    array set style {
1357        -color rainbow
1358        -levels 6
1359        -opacity 0.5
1360    }
1361    array set style [lindex [$dataobj components -style $comp] 0]
1362    set sname "$style(-color):$style(-levels):$style(-opacity)"
1363
1364    if {$style(-color) == "rainbow"} {
1365        set style(-color) "white:yellow:green:cyan:blue:magenta"
1366    }
1367    set clist [split $style(-color) :]
1368    set cmap "0.0 [_color2rgb white] "
1369    for {set i 0} {$i < [llength $clist]} {incr i} {
1370        set xval [expr {double($i+1)/([llength $clist]+1)}]
1371        set color [lindex $clist $i]
1372        append cmap "$xval [_color2rgb $color] "
1373    }
1374    append cmap "1.0 [_color2rgb $color]"
1375
1376    set max $style(-opacity)
1377    set levels $style(-levels)
1378    set wmap "0.0 0.0 "
1379    set delta [expr {0.125/($levels+1)}]
1380    for {set i 1} {$i <= $levels} {incr i} {
1381        # add spikes in the middle
1382        set xval [expr {double($i)/($levels+1)}]
1383        append wmap "[expr {$xval-$delta-0.01}] 0.0  [expr {$xval-$delta}] $max [expr {$xval+$delta}] $max  [expr {$xval+$delta+0.01}] 0.0 "
1384    }
1385    append wmap "1.0 0.0 "
1386
1387    return [list $sname $cmap $wmap]
1388}
1389
1390# ----------------------------------------------------------------------
1391# USAGE: _color2rgb <color>
1392#
1393# Used internally to convert a color name to a set of {r g b} values
1394# needed for the engine.  Each r/g/b component is scaled in the
1395# range 0-1.
1396# ----------------------------------------------------------------------
1397itcl::body Rappture::NanovisViewer::_color2rgb {color} {
1398    foreach {r g b} [winfo rgb $itk_component(hull) $color] break
1399    set r [expr {$r/65535.0}]
1400    set g [expr {$g/65535.0}]
1401    set b [expr {$b/65535.0}]
1402    return [list $r $g $b]
1403}
1404
1405# ----------------------------------------------------------------------
1406# USAGE: _euler2xyz <theta> <phi> <psi>
1407#
1408# Used internally to convert euler angles for the camera placement
1409# the to angles of rotation about the x/y/z axes, used by the engine.
1410# Returns a list:  {xangle, yangle, zangle}.
1411# ----------------------------------------------------------------------
1412itcl::body Rappture::NanovisViewer::_euler2xyz {theta phi psi} {
1413    set xangle [expr {$theta-90.0}]
1414    set yangle [expr {180-$phi}]
1415    set zangle $psi
1416    return [list $xangle $yangle $zangle]
1417}
1418
1419# ----------------------------------------------------------------------
1420# CONFIGURATION OPTION: -plotbackground
1421# ----------------------------------------------------------------------
1422itcl::configbody Rappture::NanovisViewer::plotbackground {
1423    foreach {r g b} [_color2rgb $itk_option(-plotbackground)] break
1424    #fix this!
1425    #_send color background $r $g $b
1426}
1427
1428# ----------------------------------------------------------------------
1429# CONFIGURATION OPTION: -plotforeground
1430# ----------------------------------------------------------------------
1431itcl::configbody Rappture::NanovisViewer::plotforeground {
1432    foreach {r g b} [_color2rgb $itk_option(-plotforeground)] break
1433    #fix this!
1434    #_send color background $r $g $b
1435}
1436
1437# ----------------------------------------------------------------------
1438# CONFIGURATION OPTION: -plotoutline
1439# ----------------------------------------------------------------------
1440itcl::configbody Rappture::NanovisViewer::plotoutline {
1441    if {[isconnected]} {
1442        if {"" == $itk_option(-plotoutline)} {
1443            _send volume outline state off
1444        } else {
1445            _send volume outline state on
1446            _send volume outline color [_color2rgb $itk_option(-plotoutline)]
1447        }
1448    }
1449}
Note: See TracBrowser for help on using the repository browser.