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

Last change on this file since 1277 was 1277, checked in by gah, 16 years ago

scripts/xyresult.tcl:

Changed buttons to use new icons (reset and wrench for legend).

scripts/nanovisviewer.tcl:

Changed buttons to use new icons (reset, zoom-in, and zoom-out).

scripts/visviewer.tcl:

Added drawer (pandedwindow) to base class so derived classes
could use it if so desired.

scripts/scroller.tcl:

Added scrollwheel binds for vertical scrolling.

scripts/images/atom-label.gif, scripts/images/reset-view.gif,
scripts/images/wrench.gif, scripts/images/zoom-in.gif,
scripts/images/zoom-out.gif, scripts/images/rock-view.gif:

Added new icons.

scripts/molvisviewer.tcl:

Added projection button to change between orthoscopic and perspective
projects.
Changed settings button into icon.
Moved settings menu into settings drawer.
Added scale to adjust atom scale.
Fixed representation method to not call rebuild when setting
"ballnstick", "lines", or "spheres" representations.
Requires new pymolproxy.

(gah@…)
File size: 64.7 KB
Line 
1#!/usr/bin/wish
2# ----------------------------------------------------------------------
3
4
5#  COMPONENT: nanovisviewer - 3D volume rendering
6#
7#  This widget performs volume rendering on 3D scalar/vector datasets.
8#  It connects to the Nanovis server running on a rendering farm,
9#  transmits data, and displays the results.
10# ======================================================================
11#  AUTHOR:  Michael McLennan, Purdue University
12#  Copyright (c) 2004-2005  Purdue Research Foundation
13#
14#  See the file "license.terms" for information on usage and
15#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
16# ======================================================================
17package require Itk
18package require BLT
19package require Img
20
21option add *NanovisViewer.width 4i widgetDefault
22option add *NanovisViewer*cursor crosshair widgetDefault
23option add *NanovisViewer.height 4i widgetDefault
24option add *NanovisViewer.foreground black widgetDefault
25option add *NanovisViewer.controlBackground gray widgetDefault
26option add *NanovisViewer.controlDarkBackground #999999 widgetDefault
27option add *NanovisViewer.plotBackground black widgetDefault
28option add *NanovisViewer.plotForeground white widgetDefault
29option add *NanovisViewer.plotOutline gray widgetDefault
30option add *NanovisViewer.font \
31    -*-helvetica-medium-r-normal-*-12-* widgetDefault
32
33# must use this name -- plugs into Rappture::resources::load
34proc NanovisViewer_init_resources {} {
35    Rappture::resources::register \
36        nanovis_server Rappture::NanovisViewer::SetServerList
37}
38
39itcl::class Rappture::NanovisViewer {
40    inherit Rappture::VisViewer
41
42    itk_option define -plotforeground plotForeground Foreground ""
43    itk_option define -plotbackground plotBackground Background ""
44    itk_option define -plotoutline plotOutline PlotOutline ""
45
46    constructor { hostlist args } {
47        Rappture::VisViewer::constructor $hostlist
48    } {
49        # defined below
50    }
51    destructor {
52        # defined below
53    }
54    public proc SetServerList { namelist } {
55        Rappture::VisViewer::SetServerList "nanovis" $namelist
56    }
57    public method add {dataobj {settings ""}}
58    public method get {args}
59    public method delete {args}
60    public method scale {args}
61    public method GetLimits { tf }
62    public method download {option args}
63    public method parameters {title args} {
64        # do nothing
65    }
66    public method isconnected {}
67    public method UpdateTransferFunctions {}
68    public method RemoveDuplicateIsoMarker { m x }
69    public method OverIsoMarker { m x }
70
71    protected method Connect {}
72    protected method Disconnect {}
73
74    protected method _send {string}
75    protected method _SendDataObjs {}
76    protected method _SendTransferFunctions {}
77
78    protected method _ReceiveImage {option size}
79    protected method _ReceiveLegend { ivol vmin vmax size }
80    protected method _ReceiveData { args }
81    protected method _ReceivePrint { option size }
82
83    protected method _rebuild {}
84    protected method _currentVolumeIds {{what -all}}
85    protected method _zoom {option}
86    protected method _pan {option x y}
87    protected method _rotate {option x y}
88    protected method _slice {option args}
89    protected method _slicertip {axis}
90    protected method _probe {option args}
91    protected method _marker {index option args}
92
93    protected method _state {comp}
94    protected method _fixSettings {what {value ""}}
95    protected method _fixLegend {}
96
97    # The following methods are only used by this class.
98    private method _NameTransferFunction { ivol }
99    private method _ComputeTransferFunction { tf }
100    private method _AddIsoMarker { x y }
101    private method _ParseMarkersOption { tf ivol markers }
102    private method _ParseLevelsOption { tf ivol levels }
103
104    private variable outbuf_       ;# buffer for outgoing commands
105
106    private variable _dlist ""     ;# list of data objects
107    private variable _all_data_objs
108    private variable _dims ""      ;# dimensionality of data objects
109    private variable _id2style     ;# maps id => style settings
110    private variable _obj2ovride   ;# maps dataobj => style override
111    private variable _obj2id       ;# maps dataobj => volume ID in server
112    private variable _id2obj       ;# maps dataobj => volume ID in server
113    private variable _sendobjs ""  ;# list of data objs to send to server
114    private variable _receiveids   ;# list of data objs to send to server
115    private variable _obj2styles   ;# maps id => style settings
116    private variable _style2ids    ;# maps id => style settings
117
118    private variable click_        ;# info used for _rotate operations
119    private variable limits_       ;# autoscale min/max for all axes
120    private variable view_         ;# view params for 3D view
121    private variable isomarkers_    ;# array of isosurface level values 0..1
122    private common   settings_
123    private variable activeTf_ ""  ;# The currently active transfer function.
124    # This
125    # indicates which isomarkers and transfer
126    # function to use when changing markers,
127    # opacity, or thickness.
128    #common _downloadPopup          ;# download options from popup
129}
130
131itk::usual NanovisViewer {
132    keep -background -foreground -cursor -font
133    keep -plotbackground -plotforeground
134}
135
136# ----------------------------------------------------------------------
137# CONSTRUCTOR
138# ----------------------------------------------------------------------
139itcl::body Rappture::NanovisViewer::constructor {hostlist args} {
140
141    # Draw legend event
142    $_dispatcher register !legend
143    $_dispatcher dispatch $this !legend "[itcl::code $this _fixLegend]; list"
144    # Send dataobjs event
145    $_dispatcher register !send_dataobjs
146    $_dispatcher dispatch $this !send_dataobjs \
147        "[itcl::code $this _SendDataObjs]; list"
148    # Send transfer functions event
149    $_dispatcher register !send_transfunc
150    $_dispatcher dispatch $this !send_transfunc \
151        "[itcl::code $this _SendTransferFunctions]; list"
152    # Rebuild event
153    $_dispatcher register !rebuild
154    $_dispatcher dispatch $this !rebuild "[itcl::code $this _rebuild]; list"
155
156    set outbuf_ ""
157
158    #
159    # Populate parser with commands handle incoming requests
160    #
161    $_parser alias image [itcl::code $this _ReceiveImage]
162    $_parser alias legend [itcl::code $this _ReceiveLegend]
163    $_parser alias data [itcl::code $this _ReceiveData]
164    #$_parser alias print [itcl::code $this _ReceivePrint]
165
166    # Initialize the view to some default parameters.
167    array set view_ {
168        theta   45
169        phi     45
170        psi     0
171        zoom    1.0
172        dx      0
173        dy      0
174    }
175    set _obj2id(count) 0
176    set _id2obj(count) 0
177    set limits_(vmin) 0.0
178    set limits_(vmax) 1.0
179
180    itk_component add zoom {
181        frame $itk_component(controls).zoom
182    } {
183        usual
184        rename -background -controlbackground controlBackground Background
185    }
186    pack $itk_component(zoom) -side top
187
188    itk_component add reset {
189        button $itk_component(zoom).reset \
190            -borderwidth 1 -padx 1 -pady 1 \
191            -image [Rappture::icon reset-view] \
192            -command [itcl::code $this _zoom reset]
193    } {
194        usual
195        ignore -borderwidth
196        rename -highlightbackground -controlbackground controlBackground Background
197    }
198    pack $itk_component(reset) -side left -padx {4 1} -pady 4
199    Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
200
201    itk_component add zoomin {
202        button $itk_component(zoom).zin \
203            -borderwidth 1 -padx 1 -pady 1 \
204            -image [Rappture::icon zoom-in] \
205            -command [itcl::code $this _zoom in]
206    } {
207        usual
208        ignore -borderwidth
209        rename -highlightbackground -controlbackground controlBackground Background
210    }
211    pack $itk_component(zoomin) -side left -padx 1 -pady 4
212    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
213
214    itk_component add zoomout {
215        button $itk_component(zoom).zout \
216            -borderwidth 1 -padx 1 -pady 1 \
217            -image [Rappture::icon zoom-out] \
218            -command [itcl::code $this _zoom out]
219    } {
220        usual
221        ignore -borderwidth
222        rename -highlightbackground -controlbackground controlBackground Background
223    }
224    pack $itk_component(zoomout) -side left -padx {1 4} -pady 4
225    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
226
227    #
228    # Create slicer controls...
229    #
230    itk_component add slicers {
231        frame $itk_component(controls).slicers
232    } {
233        usual
234        rename -background -controlbackground controlBackground Background
235    }
236    pack $itk_component(slicers) -side bottom -padx 4 -pady 4
237    grid rowconfigure $itk_component(slicers) 1 -weight 1
238    #
239    # X-value slicer...
240    #
241    itk_component add xslice {
242        label $itk_component(slicers).xslice \
243            -borderwidth 1 -relief raised -padx 1 -pady 1 \
244            -bitmap [Rappture::icon x]
245    } {
246        usual
247        ignore -borderwidth
248        rename -highlightbackground -controlbackground controlBackground Background
249    }
250    bind $itk_component(xslice) <ButtonPress> \
251        [itcl::code $this _slice axis x toggle]
252    Rappture::Tooltip::for $itk_component(xslice) \
253        "Toggle the X cut plane on/off"
254    grid $itk_component(xslice) -row 1 -column 0 -sticky ew -padx 1
255
256    itk_component add xslicer {
257        ::scale $itk_component(slicers).xval -from 100 -to 0 \
258            -width 10 -orient vertical -showvalue off \
259            -borderwidth 1 -highlightthickness 0 \
260            -command [itcl::code $this _slice move x]
261    } {
262        usual
263        ignore -borderwidth
264        ignore -highlightthickness
265        rename -highlightbackground -controlbackground controlBackground Background
266        rename -troughcolor -controldarkbackground controlDarkBackground Background
267    }
268    $itk_component(xslicer) set 50
269    $itk_component(xslicer) configure -state disabled
270    grid $itk_component(xslicer) -row 2 -column 0 -padx 1
271    Rappture::Tooltip::for $itk_component(xslicer) \
272        "@[itcl::code $this _slicertip x]"
273
274    #
275    # Y-value slicer...
276    #
277    itk_component add yslice {
278        label $itk_component(slicers).yslice \
279            -borderwidth 1 -relief raised -padx 1 -pady 1 \
280            -bitmap [Rappture::icon y]
281    } {
282        usual
283        ignore -borderwidth
284        rename -highlightbackground -controlbackground controlBackground Background
285    }
286    bind $itk_component(yslice) <ButtonPress> \
287        [itcl::code $this _slice axis y toggle]
288    Rappture::Tooltip::for $itk_component(yslice) \
289        "Toggle the Y cut plane on/off"
290    grid $itk_component(yslice) -row 1 -column 1 -sticky ew -padx 1
291
292    itk_component add yslicer {
293        ::scale $itk_component(slicers).yval -from 100 -to 0 \
294            -width 10 -orient vertical -showvalue off \
295            -borderwidth 1 -highlightthickness 0 \
296            -command [itcl::code $this _slice move y]
297    } {
298        usual
299        ignore -borderwidth
300        ignore -highlightthickness
301        rename -highlightbackground -controlbackground controlBackground Background
302        rename -troughcolor -controldarkbackground controlDarkBackground Background
303    }
304    $itk_component(yslicer) set 50
305    $itk_component(yslicer) configure -state disabled
306    grid $itk_component(yslicer) -row 2 -column 1 -padx 1
307    Rappture::Tooltip::for $itk_component(yslicer) \
308        "@[itcl::code $this _slicertip y]"
309
310    #
311    # Z-value slicer...
312    #
313    itk_component add zslice {
314        label $itk_component(slicers).zslice \
315            -borderwidth 1 -relief raised -padx 1 -pady 1 \
316            -bitmap [Rappture::icon z]
317    } {
318        usual
319        ignore -borderwidth
320        rename -highlightbackground -controlbackground controlBackground Background
321    }
322    grid $itk_component(zslice) -row 1 -column 2 -sticky ew -padx 1
323    bind $itk_component(zslice) <ButtonPress> \
324        [itcl::code $this _slice axis z toggle]
325    Rappture::Tooltip::for $itk_component(zslice) \
326        "Toggle the Z cut plane on/off"
327
328    itk_component add zslicer {
329        ::scale $itk_component(slicers).zval -from 100 -to 0 \
330            -width 10 -orient vertical -showvalue off \
331            -borderwidth 1 -highlightthickness 0 \
332            -command [itcl::code $this _slice move z]
333    } {
334        usual
335        ignore -borderwidth
336        ignore -highlightthickness
337        rename -highlightbackground -controlbackground controlBackground Background
338        rename -troughcolor -controldarkbackground controlDarkBackground Background
339    }
340    $itk_component(zslicer) set 50
341    $itk_component(zslicer) configure -state disabled
342    grid $itk_component(zslicer) -row 2 -column 2 -padx 1
343    Rappture::Tooltip::for $itk_component(zslicer) \
344        "@[itcl::code $this _slicertip z]"
345
346    #
347    # Volume toggle...
348    #
349    itk_component add volume {
350        label $itk_component(slicers).volume \
351            -borderwidth 1 -relief sunken -padx 1 -pady 1 \
352            -text "Volume"
353    } {
354        usual
355        ignore -borderwidth
356        rename -highlightbackground -controlbackground controlBackground Background
357    }
358    bind $itk_component(volume) <ButtonPress> \
359        [itcl::code $this _slice volume toggle]
360    Rappture::Tooltip::for $itk_component(volume) \
361        "Toggle the volume cloud on/off"
362    grid $itk_component(volume) -row 0 -column 0 -columnspan 3 \
363        -sticky ew -padx 1 -pady 3
364
365    #
366    # Settings panel...
367    #
368    itk_component add settings {
369        button $itk_component(controls).settings -text "Settings..." \
370            -borderwidth 1 -relief flat -overrelief raised \
371            -padx 2 -pady 1 \
372            -command [list $itk_component(controls).panel activate $itk_component(controls).settings left]
373    } {
374        usual
375        ignore -borderwidth
376        rename -background -controlbackground controlBackground Background
377        rename -highlightbackground -controlbackground controlBackground Background
378    }
379    pack $itk_component(settings) -side top -pady 8
380
381    Rappture::Balloon $itk_component(controls).panel -title "Settings"
382    set inner [$itk_component(controls).panel component inner]
383    frame $inner.scales
384    pack $inner.scales -side top -fill x
385    grid columnconfigure $inner.scales 1 -weight 1
386    set fg [option get $itk_component(hull) font Font]
387
388    label $inner.scales.diml -text "Dim" -font $fg
389    grid $inner.scales.diml -row 0 -column 0 -sticky e
390    ::scale $inner.scales.light -from 0 -to 100 -orient horizontal \
391        -showvalue off -command [itcl::code $this _fixSettings light]
392    grid $inner.scales.light -row 0 -column 1 -sticky ew
393    label $inner.scales.brightl -text "Bright" -font $fg
394    grid $inner.scales.brightl -row 0 -column 2 -sticky w
395    $inner.scales.light set 40
396
397    label $inner.scales.fogl -text "Fog" -font $fg
398    grid $inner.scales.fogl -row 1 -column 0 -sticky e
399    ::scale $inner.scales.transp -from 0 -to 100 -orient horizontal \
400        -showvalue off -command [itcl::code $this _fixSettings transp]
401    grid $inner.scales.transp -row 1 -column 1 -sticky ew
402    label $inner.scales.plasticl -text "Plastic" -font $fg
403    grid $inner.scales.plasticl -row 1 -column 2 -sticky w
404    $inner.scales.transp set 50
405
406    label $inner.scales.zerol -text "Clear" -font $fg
407    grid $inner.scales.zerol -row 2 -column 0 -sticky e
408    ::scale $inner.scales.opacity -from 0 -to 100 -orient horizontal \
409        -showvalue off -command [itcl::code $this _fixSettings opacity]
410    grid $inner.scales.opacity -row 2 -column 1 -sticky ew
411    label $inner.scales.onel -text "Opaque" -font $fg
412    grid $inner.scales.onel -row 2 -column 2 -sticky w
413    $inner.scales.opacity set 100
414
415    label $inner.scales.thinl -text "Thin" -font $fg
416    grid $inner.scales.thinl -row 3 -column 0 -sticky e
417    ::scale $inner.scales.thickness -from 0 -to 1000 -orient horizontal \
418        -showvalue off -command [itcl::code $this _fixSettings thickness]
419    grid $inner.scales.thickness -row 3 -column 1 -sticky ew
420    label $inner.scales.thickl -text "Thick" -font $fg
421    grid $inner.scales.thickl -row 3 -column 2 -sticky w
422    $inner.scales.thickness set 350
423
424    set ::Rappture::NanovisViewer::settings_($this-isosurface) 0
425    ::checkbutton $inner.scales.isosurface \
426        -text "Isosurface shading" \
427        -variable ::Rappture::NanovisViewer::settings_($this-isosurface) \
428        -command [itcl::code $this _fixSettings isosurface]
429    grid $inner.scales.isosurface -row 4 -column 0 -columnspan 2 -sticky w
430
431    set ::Rappture::NanovisViewer::settings_($this-axes) 1
432    ::checkbutton $inner.scales.axes \
433        -text "Axes" \
434        -variable ::Rappture::NanovisViewer::settings_($this-axes) \
435        -command [itcl::code $this _fixSettings axes]
436    grid $inner.scales.axes -row 5 -column 0 -columnspan 2 -sticky w
437
438    set ::Rappture::NanovisViewer::settings_($this-grid) 0
439    ::checkbutton $inner.scales.grid \
440        -text "Grid" \
441        -variable ::Rappture::NanovisViewer::settings_($this-grid) \
442        -command [itcl::code $this _fixSettings grid]
443    grid $inner.scales.grid -row 6 -column 0 -columnspan 2 -sticky w
444
445    set ::Rappture::NanovisViewer::settings_($this-outline) 1
446    ::checkbutton $inner.scales.outline \
447        -text "Outline" \
448        -variable ::Rappture::NanovisViewer::settings_($this-outline) \
449        -command [itcl::code $this _fixSettings outline]
450    grid $inner.scales.outline -row 7 -column 0 -columnspan 2 -sticky w
451
452    # Legend
453
454    set _image(legend) [image create photo]
455    itk_component add legend {
456        canvas $itk_component(area).legend -height 50 -highlightthickness 0
457    } {
458        usual
459        ignore -highlightthickness
460        rename -background -plotbackground plotBackground Background
461    }
462    pack $itk_component(legend) -side bottom -fill x
463    bind $itk_component(legend) <Configure> \
464        [list $_dispatcher event -idle !legend]
465
466    # Bindings for rotation via mouse
467    bind $itk_component(3dview) <ButtonPress-1> \
468        [itcl::code $this _rotate click %x %y]
469    bind $itk_component(3dview) <B1-Motion> \
470        [itcl::code $this _rotate drag %x %y]
471    bind $itk_component(3dview) <ButtonRelease-1> \
472        [itcl::code $this _rotate release %x %y]
473    bind $itk_component(3dview) <Configure> \
474        [itcl::code $this _send "screen %w %h"]
475
476    # Bindings for panning via mouse
477    bind $itk_component(3dview) <ButtonPress-2> \
478        [itcl::code $this _pan click %x %y]
479    bind $itk_component(3dview) <B2-Motion> \
480        [itcl::code $this _pan drag %x %y]
481    bind $itk_component(3dview) <ButtonRelease-2> \
482        [itcl::code $this _pan release %x %y]
483
484    # Bindings for panning via keyboard
485    bind $itk_component(3dview) <KeyPress-Left> \
486        [itcl::code $this _pan set -10 0]
487    bind $itk_component(3dview) <KeyPress-Right> \
488        [itcl::code $this _pan set 10 0]
489    bind $itk_component(3dview) <KeyPress-Up> \
490        [itcl::code $this _pan set 0 -10]
491    bind $itk_component(3dview) <KeyPress-Down> \
492        [itcl::code $this _pan set 0 10]
493    bind $itk_component(3dview) <Shift-KeyPress-Left> \
494        [itcl::code $this _pan set -2 0]
495    bind $itk_component(3dview) <Shift-KeyPress-Right> \
496        [itcl::code $this _pan set 2 0]
497    bind $itk_component(3dview) <Shift-KeyPress-Up> \
498        [itcl::code $this _pan set 0 -2]
499    bind $itk_component(3dview) <Shift-KeyPress-Down> \
500        [itcl::code $this _pan set 0 2]
501
502    # Bindings for zoom via keyboard
503    bind $itk_component(3dview) <KeyPress-Prior> \
504        [itcl::code $this _zoom out]
505    bind $itk_component(3dview) <KeyPress-Next> \
506        [itcl::code $this _zoom in]
507
508    bind $itk_component(3dview) <Enter> "focus $itk_component(3dview)"
509
510    if {[string equal "x11" [tk windowingsystem]]} {
511        # Bindings for zoom via mouse
512        bind $itk_component(3dview) <4> [itcl::code $this _zoom out]
513        bind $itk_component(3dview) <5> [itcl::code $this _zoom in]
514    }
515
516    set _image(download) [image create photo]
517
518    eval itk_initialize $args
519
520    Connect
521}
522
523# ----------------------------------------------------------------------
524# DESTRUCTOR
525# ----------------------------------------------------------------------
526itcl::body Rappture::NanovisViewer::destructor {} {
527    set _sendobjs ""  ;# stop any send in progress
528    $_dispatcher cancel !rebuild
529    $_dispatcher cancel !send_dataobjs
530    $_dispatcher cancel !send_transfunc
531    image delete $_image(plot)
532    image delete $_image(legend)
533    image delete $_image(download)
534    array unset settings_ $this-*
535}
536
537# ----------------------------------------------------------------------
538# USAGE: add <dataobj> ?<settings>?
539#
540# Clients use this to add a data object to the plot.  The optional
541# <settings> are used to configure the plot.  Allowed settings are
542# -color, -brightness, -width, -linestyle, and -raise.
543# ----------------------------------------------------------------------
544itcl::body Rappture::NanovisViewer::add {dataobj {settings ""}} {
545    array set params {
546        -color auto
547        -width 1
548        -linestyle solid
549        -brightness 0
550        -raise 0
551        -description ""
552        -param ""
553    }
554    foreach {opt val} $settings {
555        if {![info exists params($opt)]} {
556            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
557        }
558        set params($opt) $val
559    }
560    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
561        # can't handle -autocolors yet
562        set params(-color) black
563    }
564
565    set pos [lsearch -exact $dataobj $_dlist]
566    if {$pos < 0} {
567        lappend _dlist $dataobj
568        set _all_data_objs($dataobj) 1
569        set _obj2ovride($dataobj-color) $params(-color)
570        set _obj2ovride($dataobj-width) $params(-width)
571        set _obj2ovride($dataobj-raise) $params(-raise)
572        $_dispatcher event -idle !rebuild
573    }
574}
575
576# ----------------------------------------------------------------------
577# USAGE: get ?-objects?
578# USAGE: get ?-image 3dview|legend?
579#
580# Clients use this to query the list of objects being plotted, in
581# order from bottom to top of this result.  The optional "-image"
582# flag can also request the internal images being shown.
583# ----------------------------------------------------------------------
584itcl::body Rappture::NanovisViewer::get {args} {
585    if {[llength $args] == 0} {
586        set args "-objects"
587    }
588
589    set op [lindex $args 0]
590    switch -- $op {
591      -objects {
592        # put the dataobj list in order according to -raise options
593        set dlist $_dlist
594        foreach obj $dlist {
595            if {[info exists _obj2ovride($obj-raise)] && $_obj2ovride($obj-raise)} {
596                set i [lsearch -exact $dlist $obj]
597                if {$i >= 0} {
598                    set dlist [lreplace $dlist $i $i]
599                    lappend dlist $obj
600                }
601            }
602        }
603        return $dlist
604      }
605      -image {
606        if {[llength $args] != 2} {
607            error "wrong # args: should be \"get -image 3dview|legend\""
608        }
609        switch -- [lindex $args end] {
610            3dview {
611                return $_image(plot)
612            }
613            legend {
614                return $_image(legend)
615            }
616            default {
617                error "bad image name \"[lindex $args end]\": should be 3dview or legend"
618            }
619        }
620      }
621      default {
622        error "bad option \"$op\": should be -objects or -image"
623      }
624    }
625}
626
627# ----------------------------------------------------------------------
628# USAGE: delete ?<dataobj1> <dataobj2> ...?
629#
630#       Clients use this to delete a dataobj from the plot.  If no dataobjs
631#       are specified, then all dataobjs are deleted.  No data objects are
632#       deleted.  They are only removed from the display list.
633#
634# ----------------------------------------------------------------------
635itcl::body Rappture::NanovisViewer::delete {args} {
636    if {[llength $args] == 0} {
637        set args $_dlist
638    }
639    # Delete all specified dataobjs
640    set changed 0
641    foreach dataobj $args {
642        set pos [lsearch -exact $_dlist $dataobj]
643        if { $pos >= 0 } {
644            set _dlist [lreplace $_dlist $pos $pos]
645            foreach key [array names _obj2ovride $dataobj-*] {
646                unset _obj2ovride($key)
647            }
648            set changed 1
649        }
650    }
651    # If anything changed, then rebuild the plot
652    if {$changed} {
653        $_dispatcher event -idle !rebuild
654    }
655}
656
657# ----------------------------------------------------------------------
658# USAGE: scale ?<data1> <data2> ...?
659#
660# Sets the default limits for the overall plot according to the
661# limits of the data for all of the given <data> objects.  This
662# accounts for all objects--even those not showing on the screen.
663# Because of this, the limits are appropriate for all objects as
664# the user scans through data in the ResultSet viewer.
665# ----------------------------------------------------------------------
666itcl::body Rappture::NanovisViewer::scale {args} {
667    foreach val {xmin xmax ymin ymax zmin zmax vmin vmax} {
668        set limits_($val) ""
669    }
670    foreach obj $args {
671        foreach axis {x y z v} {
672
673            foreach { min max } [$obj limits $axis] break
674
675            if {"" != $min && "" != $max} {
676                if {"" == $limits_(${axis}min)} {
677                    set limits_(${axis}min) $min
678                    set limits_(${axis}max) $max
679                } else {
680                    if {$min < $limits_(${axis}min)} {
681                        set limits_(${axis}min) $min
682                    }
683                    if {$max > $limits_(${axis}max)} {
684                        set limits_(${axis}max) $max
685                    }
686                }
687            }
688        }
689    }
690}
691
692# ----------------------------------------------------------------------
693# USAGE: download coming
694# USAGE: download controls <downloadCommand>
695# USAGE: download now
696#
697# Clients use this method to create a downloadable representation
698# of the plot.  Returns a list of the form {ext string}, where
699# "ext" is the file extension (indicating the type of data) and
700# "string" is the data itself.
701# ----------------------------------------------------------------------
702itcl::body Rappture::NanovisViewer::download {option args} {
703    switch $option {
704        coming {
705            if {[catch {blt::winop snap $itk_component(area) $_image(download)}]} {
706                $_image(download) configure -width 1 -height 1
707                $_image(download) put #000000
708            }
709        }
710        controls {
711            # no controls for this download yet
712            return ""
713        }
714        now {
715            # Doing an image base64 encode/decode has to be better than
716            # writing the image to a file and reading it back in.
717            set data [$_image(plot) data -format jpeg]
718            set data [Rappture::encoding::decode -as b64 $data]
719            return [list .jpg $data]
720        }
721        default {
722            error "bad option \"$option\": should be coming, controls, now"
723        }
724    }
725}
726
727# ----------------------------------------------------------------------
728# USAGE: Connect ?<host:port>,<host:port>...?
729#
730# Clients use this method to establish a connection to a new
731# server, or to reestablish a connection to the previous server.
732# Any existing connection is automatically closed.
733# ----------------------------------------------------------------------
734itcl::body Rappture::NanovisViewer::Connect {} {
735    set _hosts [GetServerList "nanovis"]
736    if { "" == $_hosts } {
737        return 0
738    }
739    set result [VisViewer::Connect $_hosts]
740    if { $result } {
741        set w [winfo width $itk_component(3dview)]
742        set h [winfo height $itk_component(3dview)]
743        _send "screen $w $h"
744    }
745    return $result
746}
747
748#
749# isconnected --
750#
751#       Indicates if we are currently connected to the visualization server.
752#
753itcl::body Rappture::NanovisViewer::isconnected {} {
754    return [VisViewer::IsConnected]
755}
756
757#
758# Disconnect --
759#
760#       Clients use this method to disconnect from the current rendering
761#       server.
762#
763itcl::body Rappture::NanovisViewer::Disconnect {} {
764    VisViewer::Disconnect
765
766    # disconnected -- no more data sitting on server
767    set outbuf_ ""
768    catch {unset _obj2id}
769    array unset _id2obj
770    set _obj2id(count) 0
771    set _id2obj(count) 0
772    set _sendobjs ""
773}
774
775#
776# _send
777#
778#       Send commands off to the rendering server.  If we're currently
779#       sending data objects to the server, buffer the commands to be
780#       sent later.
781#
782itcl::body Rappture::NanovisViewer::_send {string} {
783    if {[llength $_sendobjs] > 0} {
784        append outbuf_ $string "\n"
785    } else {
786        foreach line [split $string \n] {
787            SendEcho >>line $line
788        }
789        SendBytes $string
790    }
791}
792
793# ----------------------------------------------------------------------
794# USAGE: _SendDataObjs
795#
796# Used internally to send a series of volume objects off to the
797# server.  Sends each object, a little at a time, with updates in
798# between so the interface doesn't lock up.
799# ----------------------------------------------------------------------
800itcl::body Rappture::NanovisViewer::_SendDataObjs {} {
801    blt::busy hold $itk_component(hull); update idletasks
802    foreach dataobj $_sendobjs {
803        foreach comp [$dataobj components] {
804            # send the data as one huge base64-encoded mess -- yuck!
805            set data [$dataobj values $comp]
806            set nbytes [string length $data]
807            if { ![SendBytes "volume data follows $nbytes"] } {
808                return
809            }
810            if { ![SendBytes $data] } {
811                return
812            }
813            set ivol $_obj2id(count)
814            incr _obj2id(count)
815
816            set _id2obj($ivol) [list $dataobj $comp]
817            set _obj2id($dataobj-$comp) $ivol
818            _NameTransferFunction $ivol
819            set _receiveids($ivol) 1
820        }
821    }
822    set _sendobjs ""
823    blt::busy release $itk_component(hull)
824
825    # activate the proper volume
826    set first [lindex [get] 0]
827    if {"" != $first} {
828        set axis [$first hints updir]
829        if {"" != $axis} {
830            _send "up $axis"
831        }
832        # The active transfer function is by default the first component of
833        # the first data object.  This assumes that the data is always
834        # successfully transferred.
835        set comp [lindex [$first components] 0]
836        set activeTf_ $_id2style($_obj2id($first-$comp))
837    }
838    foreach key [array names _obj2id *-*] {
839        set state [string match $first-* $key]
840        set ivol $_obj2id($key)
841        _send "volume state $state $ivol"
842    }
843
844    # sync the state of slicers
845    set vols [_currentVolumeIds -cutplanes]
846    foreach axis {x y z} {
847        _send "cutplane state [_state ${axis}slice] $axis $vols"
848        set pos [expr {0.01*[$itk_component(${axis}slicer) get]}]
849        _send "cutplane position $pos $axis $vols"
850    }
851    _send "volume data state [_state volume] $vols"
852
853    if 0 {
854    # Add this when we fix grid for volumes
855    _send "volume axis label x \"\""
856    _send "volume axis label y \"\""
857    _send "volume axis label z \"\""
858    _send "grid axisname x X eV"
859    _send "grid axisname y Y eV"
860    _send "grid axisname z Z eV"
861    }
862    # if there are any commands in the buffer, send them now that we're done
863    SendBytes $outbuf_
864    set outbuf_ ""
865}
866
867# ----------------------------------------------------------------------
868# USAGE: _SendTransferFunctions
869# ----------------------------------------------------------------------
870itcl::body Rappture::NanovisViewer::_SendTransferFunctions {} {
871    if { $activeTf_ == "" } {
872        return
873    }
874    set tf $activeTf_
875    set first [lindex [get] 0]
876
877    # Insure that the global opacity and thickness settings (in the slider
878    # settings widgets) are used for the active transfer-function.  Update the
879    # values in the settings_ varible.
880    set inner [$itk_component(controls).panel component inner]
881    set value [$inner.scales.opacity get]
882    set opacity [expr { double($value) * 0.01 }]
883    set settings_($this-$tf-opacity) $opacity
884    set value [$inner.scales.thickness get]
885    # Scale values between 0.00001 and 0.01000
886    set thickness [expr {double($value) * 0.0001}]
887    set settings_($this-$tf-thickness) $thickness
888
889    if { ![info exists $_obj2styles($first)] } {
890        foreach tf $_obj2styles($first) {
891            _ComputeTransferFunction $tf
892        }
893        _fixLegend
894    }
895}
896
897# ----------------------------------------------------------------------
898# USAGE: _ReceiveImage -bytes <size>
899#
900# Invoked automatically whenever the "image" command comes in from
901# the rendering server.  Indicates that binary image data with the
902# specified <size> will follow.
903# ----------------------------------------------------------------------
904set counter 0
905itcl::body Rappture::NanovisViewer::_ReceiveImage {option size} {
906    if { [isconnected] } {
907        global counter
908        incr counter
909        set bytes [ReceiveBytes $size]
910        $_image(plot) configure -data $bytes
911        ReceiveEcho <<line "<read $size bytes for [image width $_image(plot)]x[image height $_image(plot)] image>"
912    }
913}
914
915#
916# _ReceiveLegend --
917#
918#       The procedure is the response from the render server to each "legend"
919#       command.  The server sends back a "legend" command invoked our
920#       the slave interpreter.  The purpose is to collect data of the image
921#       representing the legend in the canvas.  In addition, the isomarkers
922#       of the active transfer function are displayed.
923#
924#       I don't know is this is the right place to display the isomarkers.
925#       I don't know all the different paths used to draw the plot. There's
926#       "_rebuild", "add", etc.
927#
928itcl::body Rappture::NanovisViewer::_ReceiveLegend { tf vmin vmax size } {
929    if { ![isconnected] } {
930        return
931    }
932    set bytes [ReceiveBytes $size]
933    $_image(legend) configure -data $bytes
934    ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
935
936    set c $itk_component(legend)
937    set w [winfo width $c]
938    set h [winfo height $c]
939    #foreach { dataobj comp } $_id2obj($ivol) break
940    set lx 10
941    set ly [expr {$h - 1}]
942    if {"" == [$c find withtag transfunc]} {
943        $c create image 10 10 -anchor nw \
944            -image $_image(legend) -tags transfunc
945        $c create text $lx $ly -anchor sw \
946            -fill $itk_option(-plotforeground) -tags "limits vmin"
947        $c create text [expr {$w-$lx}] $ly -anchor se \
948            -fill $itk_option(-plotforeground) -tags "limits vmax"
949        $c lower transfunc
950        $c bind transfunc <ButtonRelease-1> \
951            [itcl::code $this _AddIsoMarker %x %y]
952    }
953    # Display the markers used by the active transfer function.
954    #set tf $activeTf_
955
956    array set limits [GetLimits $tf]
957    $c itemconfigure vmin -text [format %.2g $limits(min)]
958    $c coords vmin $lx $ly
959
960    $c itemconfigure vmax -text [format %.2g $limits(max)]
961    $c coords vmax [expr {$w-$lx}] $ly
962
963    if { [info exists isomarkers_($tf)] } {
964        foreach m $isomarkers_($tf) {
965            $m Show
966        }
967    }
968}
969
970#
971# _ReceiveData --
972#
973#       The procedure is the response from the render server to each "data
974#       follows" command.  The server sends back a "data" command invoked our
975#       the slave interpreter.  The purpose is to collect the min/max of the
976#       volume sent to the render server.  Since the client (nanovisviewer)
977#       doesn't parse 3D data formats, we rely on the server (nanovis) to
978#       tell us what the limits are.  Once we've received the limits to all
979#       the data we've sent (tracked by _receiveids) we can then determine
980#       what the transfer functions are for these volumes.
981#
982#
983#       Note: There is a considerable tradeoff in having the server report
984#             back what the data limits are.  It means that much of the code
985#             having to do with transfer-functions has to wait for the data
986#             to come back, since the isomarkers are calculated based upon
987#             the data limits.  The client code is much messier because of
988#             this.  The alternative is to parse any of the 3D formats on the
989#             client side.
990#
991itcl::body Rappture::NanovisViewer::_ReceiveData { args } {
992    if { ![isconnected] } {
993        return
994    }
995    # Arguments from server are name value pairs. Stuff them in an array.
996    array set info $args
997
998    set ivol $info(id);         # Id of volume created by server.
999
1000    set limits_($ivol-min) $info(min);  # Minimum value of the volume.
1001    set limits_($ivol-max) $info(max);  # Maximum value of the volume.
1002    set limits_(vmin)      $info(vmin); # Overall minimum value.
1003    set limits_(vmax)      $info(vmax); # Overall maximum value.
1004
1005    unset _receiveids($ivol)
1006    if { [array size _receiveids] == 0 } {
1007        UpdateTransferFunctions
1008    }
1009}
1010
1011# ----------------------------------------------------------------------
1012# USAGE: _ReceivePrint -bytes <size>
1013#
1014# Invoked automatically whenever the "image" command comes in from
1015# the rendering server.  Indicates that binary image data with the
1016# specified <size> will follow.
1017# ----------------------------------------------------------------------
1018itcl::body Rappture::NanovisViewer::_ReceivePrint {option size} {
1019    if { [isconnected] } {
1020        set bytes [ReceiveBytes $size]
1021        set f [open /tmp/junk "w"]
1022        puts $f $bytes
1023        close $f
1024        $_image(download) configure -data $bytes
1025        update
1026        puts stderr "<read $size bytes for [image width $_image(download)]x[image height $_image(download)] image>"
1027    }
1028}
1029
1030# ----------------------------------------------------------------------
1031# USAGE: _rebuild
1032#
1033# Called automatically whenever something changes that affects the
1034# data in the widget.  Clears any existing data and rebuilds the
1035# widget to display new data.
1036# ----------------------------------------------------------------------
1037itcl::body Rappture::NanovisViewer::_rebuild {} {
1038    # Hide all the isomarkers. Can't remove them. Have to remember the
1039    # settings since the user may have created/deleted/moved markers.
1040
1041    foreach tf [array names isomarkers_] {
1042        foreach m $isomarkers_($tf) {
1043            $m Hide
1044        }
1045    }
1046
1047    # in the midst of sending data? then bail out
1048    if {[llength $_sendobjs] > 0} {
1049        return
1050    }
1051
1052    # Find any new data that needs to be sent to the server.  Queue this up on
1053    # the _sendobjs list, and send it out a little at a time.  Do this first,
1054    # before we rebuild the rest.
1055    foreach dataobj [get] {
1056        set comp [lindex [$dataobj components] 0]
1057        if {![info exists _obj2id($dataobj-$comp)]} {
1058            set i [lsearch -exact $_sendobjs $dataobj]
1059            if {$i < 0} {
1060                lappend _sendobjs $dataobj
1061            }
1062        }
1063    }
1064    set w [winfo width $itk_component(3dview)]
1065    set h [winfo height $itk_component(3dview)]
1066    _send "screen $w $h"
1067
1068    #
1069    # Reset the camera and other view parameters
1070    #
1071    set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
1072    _send "camera angle $xyz"
1073    _send "camera zoom $view_(zoom)"
1074
1075    _fixSettings light
1076    _fixSettings transp
1077    _fixSettings isosurface
1078    _fixSettings grid
1079    _fixSettings axes
1080    _fixSettings outline
1081
1082    if {[llength $_sendobjs] > 0} {
1083        # send off new data objects
1084        $_dispatcher event -idle !send_dataobjs
1085        return
1086    }
1087
1088    # nothing to send -- activate the proper ivol
1089    set first [lindex [get] 0]
1090    if {"" != $first} {
1091        set axis [$first hints updir]
1092        if {"" != $axis} {
1093            _send "up $axis"
1094        }
1095        foreach key [array names _obj2id *-*] {
1096            set state [string match $first-* $key]
1097            _send "volume state $state $_obj2id($key)"
1098        }
1099        #
1100        # The _obj2id and _id2style arrays may or may not have the right
1101        # information.  It's possible for the server to know about volumes
1102        # that the client has assumed it's deleted.  We could add checks.
1103        # But this problem needs to be fixed not bandaided.
1104        set comp [lindex [$first components] 0]
1105        set ivol $_obj2id($first-$comp)
1106
1107        foreach comp [$first components] {
1108            foreach ivol $_obj2id($first-$comp) {
1109            _NameTransferFunction $ivol
1110            }
1111        }
1112    }
1113
1114    # sync the state of slicers
1115    set vols [_currentVolumeIds -cutplanes]
1116    foreach axis {x y z} {
1117        _send "cutplane state [_state ${axis}slice] $axis $vols"
1118        set pos [expr {0.01*[$itk_component(${axis}slicer) get]}]
1119        _send "cutplane position $pos $axis $vols"
1120    }
1121    _send "volume data state [_state volume] $vols"
1122    $_dispatcher event -idle !legend
1123}
1124
1125# ----------------------------------------------------------------------
1126# USAGE: _currentVolumeIds ?-cutplanes?
1127#
1128# Returns a list of volume server IDs for the current volume being
1129# displayed.  This is normally a single ID, but it might be a list
1130# of IDs if the current data object has multiple components.
1131# ----------------------------------------------------------------------
1132itcl::body Rappture::NanovisViewer::_currentVolumeIds {{what -all}} {
1133    set rlist ""
1134
1135    set first [lindex [get] 0]
1136    foreach key [array names _obj2id *-*] {
1137        if {[string match $first-* $key]} {
1138            array set style {
1139                -cutplanes 1
1140            }
1141            foreach {dataobj comp} [split $key -] break
1142            array set style [lindex [$dataobj components -style $comp] 0]
1143
1144            if {$what != "-cutplanes" || $style(-cutplanes)} {
1145                lappend rlist $_obj2id($key)
1146            }
1147        }
1148    }
1149    return $rlist
1150}
1151
1152# ----------------------------------------------------------------------
1153# USAGE: _zoom in
1154# USAGE: _zoom out
1155# USAGE: _zoom reset
1156#
1157# Called automatically when the user clicks on one of the zoom
1158# controls for this widget.  Changes the zoom for the current view.
1159# ----------------------------------------------------------------------
1160itcl::body Rappture::NanovisViewer::_zoom {option} {
1161    switch -- $option {
1162        "in" {
1163            set view_(zoom) [expr {$view_(zoom)* 1.25}]
1164        }
1165        "out" {
1166            set view_(zoom) [expr {$view_(zoom)* 0.8}]
1167        }
1168        "reset" {
1169            array set view_ {
1170                theta 45
1171                phi 45
1172                psi 0
1173                zoom 1.0
1174                dx 0
1175                dy 0
1176            }
1177            set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
1178            _send "camera angle $xyz"
1179            _send "camera pan $view_(dx) $view_(dy)"
1180        }
1181    }
1182    _send "camera zoom $view_(zoom)"
1183}
1184
1185# ----------------------------------------------------------------------
1186# USAGE: _rotate click <x> <y>
1187# USAGE: _rotate drag <x> <y>
1188# USAGE: _rotate release <x> <y>
1189#
1190# Called automatically when the user clicks/drags/releases in the
1191# plot area.  Moves the plot according to the user's actions.
1192# ----------------------------------------------------------------------
1193itcl::body Rappture::NanovisViewer::_rotate {option x y} {
1194    switch -- $option {
1195        click {
1196            $itk_component(3dview) configure -cursor fleur
1197            set click_(x) $x
1198            set click_(y) $y
1199            set click_(theta) $view_(theta)
1200            set click_(phi) $view_(phi)
1201        }
1202        drag {
1203            if {[array size click_] == 0} {
1204                _rotate click $x $y
1205            } else {
1206                set w [winfo width $itk_component(3dview)]
1207                set h [winfo height $itk_component(3dview)]
1208                if {$w <= 0 || $h <= 0} {
1209                    return
1210                }
1211
1212                if {[catch {
1213                    # this fails sometimes for no apparent reason
1214                    set dx [expr {double($x-$click_(x))/$w}]
1215                    set dy [expr {double($y-$click_(y))/$h}]
1216                }]} {
1217                    return
1218                }
1219
1220                #
1221                # Rotate the camera in 3D
1222                #
1223                if {$view_(psi) > 90 || $view_(psi) < -90} {
1224                    # when psi is flipped around, theta moves backwards
1225                    set dy [expr {-$dy}]
1226                }
1227                set theta [expr {$view_(theta) - $dy*180}]
1228                while {$theta < 0} { set theta [expr {$theta+180}] }
1229                while {$theta > 180} { set theta [expr {$theta-180}] }
1230
1231                if {abs($theta) >= 30 && abs($theta) <= 160} {
1232                    set phi [expr {$view_(phi) - $dx*360}]
1233                    while {$phi < 0} { set phi [expr {$phi+360}] }
1234                    while {$phi > 360} { set phi [expr {$phi-360}] }
1235                    set psi $view_(psi)
1236                } else {
1237                    set phi $view_(phi)
1238                    set psi [expr {$view_(psi) - $dx*360}]
1239                    while {$psi < -180} { set psi [expr {$psi+360}] }
1240                    while {$psi > 180} { set psi [expr {$psi-360}] }
1241                }
1242
1243                array set view_ [subst {
1244                    theta $theta
1245                    phi $phi
1246                    psi $psi
1247                }]
1248                set xyz [Euler2XYZ $theta $phi $psi]
1249                _send "camera angle $xyz"
1250                set click_(x) $x
1251                set click_(y) $y
1252            }
1253        }
1254        release {
1255            _rotate drag $x $y
1256            $itk_component(3dview) configure -cursor ""
1257            catch {unset click_}
1258        }
1259        default {
1260            error "bad option \"$option\": should be click, drag, release"
1261        }
1262    }
1263}
1264
1265# ----------------------------------------------------------------------
1266# USAGE: $this _pan click x y
1267#        $this _pan drag x y
1268#        $this _pan release x y
1269#
1270# Called automatically when the user clicks on one of the zoom
1271# controls for this widget.  Changes the zoom for the current view.
1272# ----------------------------------------------------------------------
1273itcl::body Rappture::NanovisViewer::_pan {option x y} {
1274    # Experimental stuff
1275    set w [winfo width $itk_component(3dview)]
1276    set h [winfo height $itk_component(3dview)]
1277    if { $option == "set" } {
1278        set x [expr $x / double($w)]
1279        set y [expr $y / double($h)]
1280        set view_(dx) [expr $view_(dx) + $x]
1281        set view_(dy) [expr $view_(dy) + $y]
1282        _send "camera pan $view_(dx) $view_(dy)"
1283        return
1284    }
1285    if { $option == "click" } {
1286        set click_(x) $x
1287        set click_(y) $y
1288        $itk_component(3dview) configure -cursor hand1
1289    }
1290    if { $option == "drag" || $option == "release" } {
1291        set dx [expr ($click_(x) - $x)/double($w)]
1292        set dy [expr ($click_(y) - $y)/double($h)]
1293        set click_(x) $x
1294        set click_(y) $y
1295        set view_(dx) [expr $view_(dx) - $dx]
1296        set view_(dy) [expr $view_(dy) - $dy]
1297        _send "camera pan $view_(dx) $view_(dy)"
1298    }
1299    if { $option == "release" } {
1300        $itk_component(3dview) configure -cursor ""
1301    }
1302}
1303
1304# ----------------------------------------------------------------------
1305# USAGE: _slice axis x|y|z ?on|off|toggle?
1306# USAGE: _slice move x|y|z <newval>
1307# USAGE: _slice volume ?on|off|toggle?
1308#
1309# Called automatically when the user drags the slider to move the
1310# cut plane that slices 3D data.  Gets the current value from the
1311# slider and moves the cut plane to the appropriate point in the
1312# data set.
1313# ----------------------------------------------------------------------
1314itcl::body Rappture::NanovisViewer::_slice {option args} {
1315    switch -- $option {
1316        axis {
1317            if {[llength $args] < 1 || [llength $args] > 2} {
1318                error "wrong # args: should be \"_slice axis x|y|z ?on|off|toggle?\""
1319            }
1320            set axis [lindex $args 0]
1321            set op [lindex $args 1]
1322            if {$op == ""} { set op "on" }
1323
1324            set current [_state ${axis}slice]
1325            if {$op == "toggle"} {
1326                if {$current == "on"} { set op "off" } else { set op "on" }
1327            }
1328            if {$op} {
1329                $itk_component(${axis}slicer) configure -state normal
1330                _send "cutplane state 1 $axis [_currentVolumeIds -cutplanes]"
1331                $itk_component(${axis}slice) configure -relief sunken
1332            } else {
1333                $itk_component(${axis}slicer) configure -state disabled
1334                _send "cutplane state 0 $axis [_currentVolumeIds -cutplanes]"
1335                $itk_component(${axis}slice) configure -relief raised
1336            }
1337        }
1338        move {
1339            if {[llength $args] != 2} {
1340                error "wrong # args: should be \"_slice move x|y|z newval\""
1341            }
1342            set axis [lindex $args 0]
1343            set newval [lindex $args 1]
1344
1345            set newpos [expr {0.01*$newval}]
1346#            set newval [expr {0.01*($newval-50)
1347#                *($limits_(${axis}max)-$limits_(${axis}min))
1348#                  + 0.5*($limits_(${axis}max)+$limits_(${axis}min))}]
1349
1350            # show the current value in the readout
1351            #puts "readout: $axis = $newval"
1352
1353            set ids [_currentVolumeIds -cutplanes]
1354            _send "cutplane position $newpos $axis $ids"
1355        }
1356        volume {
1357            if {[llength $args] > 1} {
1358                error "wrong # args: should be \"_slice volume ?on|off|toggle?\""
1359            }
1360            set op [lindex $args 0]
1361            if {$op == ""} { set op "on" }
1362
1363            set current [_state volume]
1364            if {$op == "toggle"} {
1365                if {$current == "on"} { set op "off" } else { set op "on" }
1366            }
1367
1368            if {$op} {
1369                _send "volume data state on [_currentVolumeIds]"
1370                $itk_component(volume) configure -relief sunken
1371            } else {
1372                _send "volume data state off [_currentVolumeIds]"
1373                $itk_component(volume) configure -relief raised
1374            }
1375        }
1376        default {
1377            error "bad option \"$option\": should be axis, move, or volume"
1378        }
1379    }
1380}
1381
1382# ----------------------------------------------------------------------
1383# USAGE: _slicertip <axis>
1384#
1385# Used internally to generate a tooltip for the x/y/z slicer controls.
1386# Returns a message that includes the current slicer value.
1387# ----------------------------------------------------------------------
1388itcl::body Rappture::NanovisViewer::_slicertip {axis} {
1389    set val [$itk_component(${axis}slicer) get]
1390#    set val [expr {0.01*($val-50)
1391#        *($limits_(${axis}max)-$limits_(${axis}min))
1392#          + 0.5*($limits_(${axis}max)+$limits_(${axis}min))}]
1393    return "Move the [string toupper $axis] cut plane.\nCurrently:  $axis = $val%"
1394}
1395
1396# ----------------------------------------------------------------------
1397# USAGE: _state <component>
1398#
1399# Used internally to determine the state of a toggle button.
1400# The <component> is the itk component name of the button.
1401# Returns on/off for the state of the button.
1402# ----------------------------------------------------------------------
1403itcl::body Rappture::NanovisViewer::_state {comp} {
1404    if {[$itk_component($comp) cget -relief] == "sunken"} {
1405        return "on"
1406    }
1407    return "off"
1408}
1409
1410# ----------------------------------------------------------------------
1411# USAGE: _fixSettings <what> ?<value>?
1412#
1413# Used internally to update rendering settings whenever parameters
1414# change in the popup settings panel.  Sends the new settings off
1415# to the back end.
1416# ----------------------------------------------------------------------
1417itcl::body Rappture::NanovisViewer::_fixSettings {what {value ""}} {
1418    set inner [$itk_component(controls).panel component inner]
1419    switch -- $what {
1420        light {
1421            if {[isconnected]} {
1422                set val [$inner.scales.light get]
1423                set sval [expr {0.1*$val}]
1424                _send "volume shading diffuse $sval"
1425
1426                set sval [expr {sqrt($val+1.0)}]
1427                _send "volume shading specular $sval"
1428            }
1429        }
1430        transp {
1431            if {[isconnected]} {
1432                set val [$inner.scales.transp get]
1433                set sval [expr {0.2*$val+1}]
1434                _send "volume shading opacity $sval"
1435            }
1436        }
1437        opacity {
1438            if {[isconnected] && $activeTf_ != "" } {
1439                set val [$inner.scales.opacity get]
1440                set sval [expr { 0.01 * double($val) }]
1441                set tf $activeTf_
1442                set settings_($this-$tf-opacity) $sval
1443                UpdateTransferFunctions
1444            }
1445        }
1446
1447        thickness {
1448            if {[isconnected] && $activeTf_ != "" } {
1449                set val [$inner.scales.thickness get]
1450                # Scale values between 0.00001 and 0.01000
1451                set sval [expr {0.0001*double($val)}]
1452                set tf $activeTf_
1453                set settings_($this-$tf-thickness) $sval
1454                UpdateTransferFunctions
1455            }
1456        }
1457        "outline" {
1458            if {[isconnected]} {
1459                _send "volume outline state $settings_($this-outline)"
1460            }
1461        }
1462        "isosurface" {
1463            if {[isconnected]} {
1464                _send "volume shading isosurface $settings_($this-isosurface)"
1465            }
1466        }
1467        "grid" {
1468            if { [isconnected] } {
1469                _send "grid visible $settings_($this-grid)"
1470            }
1471        }
1472        "axes" {
1473            if { [isconnected] } {
1474                _send "axis visible $settings_($this-axes)"
1475            }
1476        }
1477        default {
1478            error "don't know how to fix $what"
1479        }
1480    }
1481}
1482
1483# ----------------------------------------------------------------------
1484# USAGE: _fixLegend
1485#
1486# Used internally to update the legend area whenever it changes size
1487# or when the field changes.  Asks the server to send a new legend
1488# for the current field.
1489# ----------------------------------------------------------------------
1490itcl::body Rappture::NanovisViewer::_fixLegend {} {
1491    set lineht [font metrics $itk_option(-font) -linespace]
1492    set w [expr {[winfo width $itk_component(legend)]-20}]
1493    set h [expr {[winfo height $itk_component(legend)]-20-$lineht}]
1494    if {$w > 0 && $h > 0 && "" != $activeTf_} {
1495        _send "legend $activeTf_ $w $h"
1496    } else {
1497    # Can't do this as this will remove the items associated with the
1498    # isomarkers.
1499
1500    #$itk_component(legend) delete all
1501    }
1502}
1503
1504#
1505# _NameTransferFunction --
1506#
1507#       Creates a transfer function name based on the <style> settings in the
1508#       library run.xml file. This placeholder will be used later to create
1509#       and send the actual transfer function once the data info has been sent
1510#       to us by the render server. [We won't know the volume limits until the
1511#       server parses the 3D data and sends back the limits via _ReceiveData.]
1512#
1513#       FIXME: The current way we generate transfer-function names completely
1514#              ignores the -markers option.  The problem is that we are forced
1515#              to compute the name from an increasing complex set of values:
1516#              color, levels, marker, opacity.  I think we're stuck doing it
1517#              now.
1518#
1519itcl::body Rappture::NanovisViewer::_NameTransferFunction { ivol } {
1520    array set style {
1521        -color rainbow
1522        -levels 6
1523        -opacity 1.0
1524    }
1525    foreach {dataobj comp} $_id2obj($ivol) break
1526    array set style [lindex [$dataobj components -style $comp] 0]
1527    set tf "$style(-color):$style(-levels):$style(-opacity)"
1528
1529    set _id2style($ivol) $tf
1530    lappend _obj2styles($dataobj) $tf
1531    lappend _style2ids($tf) $ivol
1532}
1533
1534#
1535# _ComputeTransferFunction --
1536#
1537#   Computes and sends the transfer function to the render server.  It's
1538#   assumed that the volume data limits are known and that the global
1539#   transfer-functions slider values have be setup.  Both parts are
1540#   needed to compute the relative value (location) of the marker, and
1541#   the alpha map of the transfer function.
1542#
1543itcl::body Rappture::NanovisViewer::_ComputeTransferFunction { tf } {
1544    array set style {
1545        -color rainbow
1546        -levels 6
1547        -opacity 1.0
1548    }
1549    set dataobj ""; set comp ""
1550    foreach ivol $_style2ids($tf) {
1551        if { [info exists _id2obj($ivol)] } {
1552            foreach {dataobj comp} $_id2obj($ivol) break
1553            break
1554        }
1555    }
1556    if { $dataobj == "" } {
1557        return 0
1558    }
1559    array set style [lindex [$dataobj components -style $comp] 0]
1560
1561
1562    # We have to parse the style attributes for a volume using this
1563    # transfer-function *once*.  This sets up the initial isomarkers for the
1564    # transfer function.  The user may add/delete markers, so we have to
1565    # maintain a list of markers for each transfer-function.  We use the one
1566    # of the volumes (the first in the list) using the transfer-function as a
1567    # reference.
1568    #
1569    # FIXME: The current way we generate transfer-function names completely
1570    #        ignores the -markers option.  The problem is that we are forced
1571    #        to compute the name from an increasing complex set of values:
1572    #        color, levels, marker, opacity.  I think the cow's out of the
1573    #        barn on this one.
1574
1575    if { ![info exists isomarkers_($tf)] } {
1576        # Have to defer creation of isomarkers until we have data limits
1577        if { [info exists style(-markers)] } {
1578            _ParseMarkersOption $tf $ivol $style(-markers)
1579        } else {
1580            _ParseLevelsOption $tf $ivol $style(-levels)
1581        }
1582    }
1583    if {$style(-color) == "rainbow"} {
1584        set style(-color) "white:yellow:green:cyan:blue:magenta"
1585    }
1586    set clist [split $style(-color) :]
1587    set cmap "0.0 [Color2RGB white] "
1588    for {set i 0} {$i < [llength $clist]} {incr i} {
1589        set x [expr {double($i+1)/([llength $clist]+1)}]
1590        set color [lindex $clist $i]
1591        append cmap "$x [Color2RGB $color] "
1592    }
1593    append cmap "1.0 [Color2RGB $color]"
1594
1595    set tag $this-$tf
1596    if { ![info exists settings_($tag-opacity)] } {
1597        set settings_($tag-opacity) $style(-opacity)
1598    }
1599    set max $settings_($tag-opacity)
1600
1601    set isovalues {}
1602    foreach m $isomarkers_($tf) {
1603        lappend isovalues [$m GetRelativeValue]
1604    }
1605    # Sort the isovalues
1606    set isovalues [lsort -real $isovalues]
1607
1608    if { ![info exists settings_($tag-thickness)]} {
1609        set settings_($tag-thickness) 0.05
1610    }
1611    set delta $settings_($tag-thickness)
1612
1613    set first [lindex $isovalues 0]
1614    set last [lindex $isovalues end]
1615    set wmap ""
1616    if { $first == "" || $first != 0.0 } {
1617        lappend wmap 0.0 0.0
1618    }
1619    foreach x $isovalues {
1620        set x1 [expr {$x-$delta-0.00001}]
1621        set x2 [expr {$x-$delta}]
1622        set x3 [expr {$x+$delta}]
1623        set x4 [expr {$x+$delta+0.00001}]
1624        if { $x1 < 0.0 } {
1625            set x1 0.0
1626        } elseif { $x1 > 1.0 } {
1627            set x1 1.0
1628        }
1629        if { $x2 < 0.0 } {
1630            set x2 0.0
1631        } elseif { $x2 > 1.0 } {
1632            set x2 1.0
1633        }
1634        if { $x3 < 0.0 } {
1635            set x3 0.0
1636        } elseif { $x3 > 1.0 } {
1637            set x3 1.0
1638        }
1639        if { $x4 < 0.0 } {
1640            set x4 0.0
1641        } elseif { $x4 > 1.0 } {
1642            set x4 1.0
1643        }
1644        # add spikes in the middle
1645        lappend wmap $x1 0.0
1646        lappend wmap $x2 $max
1647        lappend wmap $x3 $max
1648        lappend wmap $x4 0.0
1649    }
1650    if { $last == "" || $last != 1.0 } {
1651        lappend wmap 1.0 0.0
1652    }
1653    SendBytes "transfunc define $tf { $cmap } { $wmap }\n"
1654    return [SendBytes "volume shading transfunc $tf $_style2ids($tf)\n"]
1655}
1656
1657# ----------------------------------------------------------------------
1658# CONFIGURATION OPTION: -plotbackground
1659# ----------------------------------------------------------------------
1660itcl::configbody Rappture::NanovisViewer::plotbackground {
1661    if { [isconnected] } {
1662        foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break
1663        #fix this!
1664        #_send "color background $r $g $b"
1665    }
1666}
1667
1668# ----------------------------------------------------------------------
1669# CONFIGURATION OPTION: -plotforeground
1670# ----------------------------------------------------------------------
1671itcl::configbody Rappture::NanovisViewer::plotforeground {
1672    if { [isconnected] } {
1673        foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break
1674        #fix this!
1675        #_send "color background $r $g $b"
1676    }
1677}
1678
1679# ----------------------------------------------------------------------
1680# CONFIGURATION OPTION: -plotoutline
1681# ----------------------------------------------------------------------
1682itcl::configbody Rappture::NanovisViewer::plotoutline {
1683    # Must check if we are connected because this routine is called from the
1684    # class body when the -plotoutline itk_option is defined.  At that point
1685    # the NanovisViewer class constructor hasn't been called, so we can't
1686    # start sending commands to visualization server.
1687    if { [isconnected] } {
1688        if {"" == $itk_option(-plotoutline)} {
1689            _send "volume outline state off"
1690        } else {
1691            _send "volume outline state on"
1692            _send "volume outline color [Color2RGB $itk_option(-plotoutline)]"
1693        }
1694    }
1695}
1696
1697#
1698# The -levels option takes a single value that represents the number
1699# of evenly distributed markers based on the current data range. Each
1700# marker is a relative value from 0.0 to 1.0.
1701#
1702itcl::body Rappture::NanovisViewer::_ParseLevelsOption { tf ivol levels } {
1703    set c $itk_component(legend)
1704    regsub -all "," $levels " " levels
1705    if {[string is int $levels]} {
1706        for {set i 1} { $i <= $levels } {incr i} {
1707            set x [expr {double($i)/($levels+1)}]
1708            set m [IsoMarker \#auto $c $this $tf]
1709            $m SetRelativeValue $x
1710            lappend isomarkers_($tf) $m
1711        }
1712    } else {
1713        foreach x $levels {
1714            set m [IsoMarker \#auto $c $this $tf]
1715            $m SetRelativeValue $x
1716            lappend isomarkers_($tf) $m
1717        }
1718    }
1719}
1720
1721#
1722# The -markers option takes a list of zero or more values (the values
1723# may be separated either by spaces or commas) that have the following
1724# format:
1725#
1726#   N%  Percent of current total data range.  Converted to
1727#       to a relative value between 0.0 and 1.0.
1728#   N   Absolute value of marker.  If the marker is outside of
1729#       the current range, it will be displayed on the outer
1730#       edge of the legends, but it range it represents will
1731#       not be seen.
1732#
1733itcl::body Rappture::NanovisViewer::_ParseMarkersOption { tf ivol markers } {
1734    set c $itk_component(legend)
1735    regsub -all "," $markers " " markers
1736    foreach marker $markers {
1737        set n [scan $marker "%g%s" value suffix]
1738        if { $n == 2 && $suffix == "%" } {
1739            # ${n}% : Set relative value.
1740            set value [expr {$value * 0.01}]
1741            set m [IsoMarker \#auto $c $this $tf]
1742            $m SetRelativeValue $value
1743            lappend isomarkers_($tf) $m
1744        } else {
1745            # ${n} : Set absolute value.
1746            set m [IsoMarker \#auto $c $this $tf]
1747            $m SetAbsoluteValue $value
1748            lappend isomarkers_($tf) $m
1749        }
1750    }
1751}
1752
1753# ----------------------------------------------------------------------
1754# USAGE: _marker start <x> <y>
1755# USAGE: _marker update <x> <y>
1756# USAGE: _marker end <x> <y>
1757#
1758# Used internally to handle the various marker operations performed
1759# when the user clicks and drags on the legend area.  The marker changes the
1760# transfer function to highlight the area being selected in the
1761# legend.
1762# ----------------------------------------------------------------------
1763itcl::body Rappture::NanovisViewer::UpdateTransferFunctions {} {
1764    $_dispatcher event -idle !send_transfunc
1765}
1766
1767itcl::body Rappture::NanovisViewer::_AddIsoMarker { x y } {
1768    if { $activeTf_ == "" } {
1769        error "active transfer function isn't set"
1770    }
1771    set tf $activeTf_
1772    set c $itk_component(legend)
1773    set m [IsoMarker \#auto $c $this $tf]
1774    set w [winfo width $c]
1775    $m SetRelativeValue [expr {double($x-10)/($w-20)}]
1776    lappend isomarkers_($tf) $m
1777    UpdateTransferFunctions
1778    return 1
1779}
1780
1781itcl::body Rappture::NanovisViewer::RemoveDuplicateIsoMarker { marker x } {
1782    set tf [$marker GetTransferFunction]
1783    set bool 0
1784    if { [info exists isomarkers_($tf)] } {
1785        set list {}
1786        set marker [namespace tail $marker]
1787        foreach m $isomarkers_($tf) {
1788            set sx [$m GetScreenPosition]
1789            if { $m != $marker } {
1790                if { $x >= ($sx-3) && $x <= ($sx+3) } {
1791                    $marker SetRelativeValue [$m GetRelativeValue]
1792                    itcl::delete object $m
1793                    bell
1794                    set bool 1
1795                    continue
1796                }
1797            }
1798            lappend list $m
1799        }
1800        set isomarkers_($tf) $list
1801        UpdateTransferFunctions
1802    }
1803    return $bool
1804}
1805
1806itcl::body Rappture::NanovisViewer::OverIsoMarker { marker x } {
1807    set tf [$marker GetTransferFunction]
1808    if { [info exists isomarkers_($tf)] } {
1809        set marker [namespace tail $marker]
1810        foreach m $isomarkers_($tf) {
1811            set sx [$m GetScreenPosition]
1812            if { $m != $marker } {
1813                set bool [expr { $x >= ($sx-3) && $x <= ($sx+3) }]
1814                $m Activate $bool
1815            }
1816        }
1817    }
1818    return ""
1819}
1820
1821itcl::body Rappture::NanovisViewer::GetLimits { tf } {
1822    set limits_(min) ""
1823    set limits_(max) ""
1824    foreach ivol $_style2ids($tf) {
1825        if { ![info exists limits_($ivol-min)] } {
1826            error "can't find $ivol limits"
1827        }
1828        if { $limits_(min) == "" || $limits_(min) > $limits_($ivol-min) } {
1829            set limits_(min) $limits_($ivol-min)
1830        }
1831        if { $limits_(max) == "" || $limits_(max) < $limits_($ivol-max) } {
1832            set limits_(max) $limits_($ivol-max)
1833        }
1834    }
1835    return [array get limits_]
1836}
Note: See TracBrowser for help on using the repository browser.