source: branches/1.3/gui/scripts/molvisviewer.tcl @ 5734

Last change on this file since 5734 was 5734, checked in by ldelgass, 9 years ago

Merge r5725:5726,r5730 from trunk

File size: 73.7 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: molvisviewer - view a molecule in 3D
4#
5#  This widget brings up a 3D representation of a molecule
6#  It connects to the Molvis server running on a rendering farm,
7#  transmits data, and displays the results.
8# ======================================================================
9#  AUTHOR:  Michael McLennan, Purdue University
10#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
11#
12#  See the file "license.terms" for information on usage and
13#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14# ======================================================================
15package require Itk
16package require BLT
17package require Img
18
19option add *MolvisViewer.width 4i widgetDefault
20option add *MolvisViewer.height 4i widgetDefault
21option add *MolvisViewer.foreground black widgetDefault
22option add *MolvisViewer.font -*-helvetica-medium-r-normal-*-12-* widgetDefault
23
24# must use this name -- plugs into Rappture::resources::load
25proc MolvisViewer_init_resources {} {
26    Rappture::resources::register \
27        molvis_server Rappture::MolvisViewer::SetServerList
28}
29
30itcl::class Rappture::MolvisViewer {
31    inherit Rappture::VisViewer
32
33    itk_option define -device device Device ""
34
35    constructor { servers args } {
36        Rappture::VisViewer::constructor $servers
37    } {
38        # defined below
39    }
40    destructor {
41        # defined below
42    }
43    public proc SetServerList { namelist } {
44        Rappture::VisViewer::SetServerList "pymol" $namelist
45    }
46    public method Connect {}
47    public method Disconnect {}
48    public method ResetView {}
49    public method add {dataobj {options ""}}
50    public method delete {args}
51    public method download {option args}
52    public method get {}
53    public method isconnected {}
54    public method labels {option {model "all"}}
55    public method parameters {title args} {
56        # do nothing
57    }
58    public method snap { w h }
59
60    protected method Map {}
61    protected method Pan {option x y}
62    protected method Rebuild {}
63    protected method Rotate {option x y}
64    protected method Rotate.old {option x y}
65    protected method SendCmd { string }
66    protected method Unmap {}
67    protected method Vmouse {option b m x y}
68    protected method Zoom {option {factor 10}}
69
70    private method AddImageControls { frame widget }
71    private method BuildSettingsTab {}
72    private method CartoonTrace {option {model "all"}}
73    private method Cell {option}
74    private method ComputeParallelepipedVertices { dataobj }
75    private method DoResize {}
76    private method DoRotate {}
77    private method DoUpdate {}
78    private method EventuallyChangeSettings { args }
79    private method EventuallyResize { w h }
80    private method EventuallyRotate { a b c }
81    private method GetImage { widget }
82    private method Opacity {option}
83    private method OrthoProjection {option}
84    private method ReceiveImage { size cacheid frame rock }
85    private method Representation { {option ""} }
86    private method Rock {option}
87    private method SetWaitVariable { value } {
88        set _getimage $value
89    }
90    private method SphereScale {option {models "all"} }
91    private method StickRadius {option {models "all"} }
92    private method UpdateState { args }
93    private method WaitForResponse {} {
94        tkwait variable [itcl::scope _getimage]
95        return $_getimage
96    }
97    private method WaitIcon { option widget }
98
99    private variable _icon 0
100    private variable _getimage 0
101    private variable _mevent;           # info used for mouse event operations
102    private variable _rocker;           # info used for rock operations
103    private variable _dlist "";         # list of dataobj objects
104    private variable _dataobjs;         # data objects on server
105    private variable _dobj2transparency;# maps dataobj => transparency
106    private variable _dobj2raise;       # maps dataobj => raise flag 0/1
107
108    private variable _active;           # array of active models.
109    private variable _obj2models;       # array containing list of models
110                                        # for each data object.
111    private variable _view
112    private variable _click
113
114    private variable _model
115    private variable _mlist
116    private variable _mrep "ballnstick"
117
118    private variable _imagecache
119    private variable _state
120    private variable _labels "default"
121    private variable _cacheid ""
122    private variable _cacheimage ""
123    private variable _first ""
124
125    private variable _initialized
126
127    private variable _pdbdata;          # PDB data from run file sent to pymol
128    private variable _nextToken 0
129    private variable _resizePending 0;
130    private variable _updatePending 0;
131    private variable _rotatePending 0;
132    private variable _width
133    private variable _height
134    private variable _reset 1;          # Restore camera settings
135    private variable _cell 0;           # Is there a parallelepiped unit cell?
136
137    private common _settings;           # Array of settings for all known
138                                        # widgets
139    private common _downloadPopup;      # Download options from popup
140    private common _hardcopy
141    private common _useVmouseEvents 0;  # Flag to enable virtual mouse events
142}
143
144itk::usual MolvisViewer {
145    keep -background -foreground -cursor -font
146}
147
148# ----------------------------------------------------------------------
149# CONSTRUCTOR
150# ----------------------------------------------------------------------
151itcl::body Rappture::MolvisViewer::constructor {servers args} {
152    set _serverType "pymol"
153
154    #DebugOn
155
156    # Register events to the dispatcher.  Base class expects !rebuild
157    # event to be registered.
158
159    # Rebuild
160    $_dispatcher register !rebuild
161    $_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
162
163    # Resize event
164    $_dispatcher register !resize
165    $_dispatcher dispatch $this !resize "[itcl::code $this DoResize]; list"
166
167    # Update state event
168    $_dispatcher register !update
169    $_dispatcher dispatch $this !update "[itcl::code $this DoUpdate]; list"
170
171    # Rotate event
172    $_dispatcher register !rotate
173    $_dispatcher dispatch $this !rotate "[itcl::code $this DoRotate]; list"
174
175    # Rocker
176    $_dispatcher register !rocker
177    $_dispatcher dispatch $this !rocker "[itcl::code $this Rock step]; list"
178
179    # Mouse Event
180    $_dispatcher register !mevent
181    $_dispatcher dispatch $this !mevent "[itcl::code $this _mevent]; list"
182
183    $_dispatcher register !pngtimeout
184    $_dispatcher register !waiticon
185
186    array set _downloadPopup {
187        format draft
188    }
189
190    # Populate the slave interpreter with commands to handle responses from
191    # the visualization server.
192    $_parser alias image [itcl::code $this ReceiveImage]
193
194    set _rocker(dir) 1
195    set _rocker(client) 0
196    set _rocker(server) 0
197    set _rocker(on) 0
198    set _state(server) 1
199    set _state(client) 1
200    set _reset 1
201
202    array set _view {
203        theta   45
204        phi     45
205        psi     0
206        vx      0
207        vy      0
208        vz      0
209        mx      0
210        my      0
211        mz      0
212        xpan    0
213        ypan    0
214        zoom    0
215    }
216
217    # Setup default settings for widget.
218    array set _settings [subst {
219        $this-spherescale 0.25
220        $this-stickradius 0.14
221        $this-cartoontrace no
222        $this-model     ballnstick
223        $this-modelimg  [Rappture::icon ballnstick]
224        $this-opacity   1.0
225        $this-ortho     no
226        $this-rock      no
227        $this-showlabels no
228        $this-showcell  yes
229        $this-showlabels-initialized no
230    }]
231
232    itk_component add 3dview {
233        label $itk_component(plotarea).view -image $_image(plot) \
234            -highlightthickness 0 -borderwidth 0
235    } {
236        usual
237        ignore -highlightthickness -borderwidth  -background
238    }
239    bind $itk_component(3dview) <Control-F1> [itcl::code $this ToggleConsole]
240
241    set f [$itk_component(main) component controls]
242    itk_component add reset {
243        button $f.reset -borderwidth 1 -padx 1 -pady 1 \
244            -highlightthickness 0 \
245            -image [Rappture::icon reset-view] \
246            -command [itcl::code $this ResetView]
247    } {
248        usual
249        ignore -highlightthickness
250    }
251    pack $itk_component(reset) -padx 1 -pady 2
252    Rappture::Tooltip::for $itk_component(reset) \
253        "Reset the view to the default zoom level"
254
255    itk_component add zoomin {
256        button $f.zin -borderwidth 1 -padx 1 -pady 1 \
257            -highlightthickness 0 \
258            -image [Rappture::icon zoom-in] \
259            -command [itcl::code $this Zoom in]
260    } {
261        usual
262        ignore -highlightthickness
263    }
264    pack $itk_component(zoomin) -padx 2 -pady 2
265    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
266
267    itk_component add zoomout {
268        button $f.zout -borderwidth 1 -padx 1 -pady 1 \
269            -highlightthickness 0 \
270            -image [Rappture::icon zoom-out] \
271            -command [itcl::code $this Zoom out]
272    } {
273        usual
274        ignore -highlightthickness
275    }
276    pack $itk_component(zoomout) -padx 2 -pady 2
277    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
278
279    itk_component add labels {
280        Rappture::PushButton $f.labels \
281            -onimage [Rappture::icon molvis-labels-view] \
282            -offimage [Rappture::icon molvis-labels-view] \
283            -command [itcl::code $this labels update] \
284            -variable [itcl::scope _settings($this-showlabels)]
285    }
286    $itk_component(labels) deselect
287    Rappture::Tooltip::for $itk_component(labels) \
288        "Show/hide the labels on atoms"
289    pack $itk_component(labels) -padx 2 -pady {6 2}
290
291    itk_component add rock {
292        Rappture::PushButton $f.rock \
293            -onimage [Rappture::icon molvis-rock-view] \
294            -offimage [Rappture::icon molvis-rock-view] \
295            -command [itcl::code $this Rock toggle] \
296            -variable [itcl::scope _settings($this-rock)]
297    }
298    pack $itk_component(rock) -padx 2 -pady 2
299    Rappture::Tooltip::for $itk_component(rock) "Rock model back and forth"
300
301    itk_component add ortho {
302        label $f.ortho -borderwidth 1 -padx 1 -pady 1 \
303            -relief "raised" -image [Rappture::icon molvis-3dpers]
304    }
305    pack $itk_component(ortho) -padx 2 -pady 2 -ipadx 1 -ipady 1
306    Rappture::Tooltip::for $itk_component(ortho) \
307        "Use orthoscopic projection"
308
309    bind $itk_component(ortho) <ButtonPress> \
310        [itcl::code $this OrthoProjection toggle]
311
312    BuildSettingsTab
313
314    # HACK ALERT. Initially force a requested width of the 3dview label.
315
316    # It's a chicken-and-the-egg problem.  The size of the 3dview label is set
317    # from the size of the image retrieved from the server.  But the size of
318    # the image is specified by the viewport which is the size of the label.
319    # The fly-in-the-ointment is that it takes a non-trival amount of time to
320    # get the first image back from the server.  In the meantime the idletasks
321    # have already kicked in.  We end up with a 1x1 viewport and image.
322
323    # So the idea is to force a ridiculously big requested width on the label
324    # (that's why we're using the blt::table to manage the geometry).  It has
325    # to be big, because we don't know how big the user may want to stretch
326    # the window.  This at least forces the sidebarframe to give the 3dview
327    # the maximum size available, which is perfect for an initially closed
328    # sidebar.
329
330    blt::table $itk_component(plotarea) \
331        0,0 $itk_component(3dview) -fill both -reqwidth 10000
332    #
333    # RENDERING AREA
334    #
335
336    set _image(id) ""
337
338    if { $_useVmouseEvents } {
339        # set up bindings to bridge mouse events to server
340        bind $itk_component(3dview) <ButtonPress> \
341            [itcl::code $this Vmouse click %b %s %x %y]
342        bind $itk_component(3dview) <ButtonRelease> \
343            [itcl::code $this Vmouse release %b %s %x %y]
344        bind $itk_component(3dview) <B1-Motion> \
345            [itcl::code $this Vmouse drag 1 %s %x %y]
346        bind $itk_component(3dview) <B2-Motion> \
347            [itcl::code $this Vmouse drag 2 %s %x %y]
348        bind $itk_component(3dview) <B3-Motion> \
349            [itcl::code $this Vmouse drag 3 %s %x %y]
350        bind $itk_component(3dview) <Motion> \
351            [itcl::code $this Vmouse move 0 %s %x %y]
352    } else {
353        # set up bindings for rotation with mouse
354        bind $itk_component(3dview) <ButtonPress-1> \
355            [itcl::code $this Rotate click %x %y]
356        bind $itk_component(3dview) <B1-Motion> \
357            [itcl::code $this Rotate drag %x %y]
358        bind $itk_component(3dview) <ButtonRelease-1> \
359            [itcl::code $this Rotate release %x %y]
360
361        # set up bindings for panning with mouse
362        bind $itk_component(3dview) <ButtonPress-2> \
363            [itcl::code $this Pan click %x %y]
364        bind $itk_component(3dview) <B2-Motion> \
365            [itcl::code $this Pan drag %x %y]
366        bind $itk_component(3dview) <ButtonRelease-2> \
367            [itcl::code $this Pan release %x %y]
368
369        # scroll wheel zoom
370        if {[string equal "x11" [tk windowingsystem]]} {
371            bind $itk_component(3dview) <4> [itcl::code $this Zoom out 2]
372            bind $itk_component(3dview) <5> [itcl::code $this Zoom in 2]
373        }
374    }
375
376    # Set up bindings for panning with keyboard
377    bind $itk_component(3dview) <KeyPress-Left> \
378        [itcl::code $this Pan set -10 0]
379    bind $itk_component(3dview) <KeyPress-Right> \
380        [itcl::code $this Pan set 10 0]
381    bind $itk_component(3dview) <KeyPress-Up> \
382        [itcl::code $this Pan set 0 -10]
383    bind $itk_component(3dview) <KeyPress-Down> \
384        [itcl::code $this Pan set 0 10]
385    bind $itk_component(3dview) <Shift-KeyPress-Left> \
386        [itcl::code $this Pan set -50 0]
387    bind $itk_component(3dview) <Shift-KeyPress-Right> \
388        [itcl::code $this Pan set 50 0]
389    bind $itk_component(3dview) <Shift-KeyPress-Up> \
390        [itcl::code $this Pan set 0 -50]
391    bind $itk_component(3dview) <Shift-KeyPress-Down> \
392        [itcl::code $this Pan set 0 50]
393
394    # Set up bindings for zoom with keyboard
395    bind $itk_component(3dview) <KeyPress-Prior> \
396        [itcl::code $this Zoom out 2]
397    bind $itk_component(3dview) <KeyPress-Next> \
398        [itcl::code $this Zoom in 2]
399
400    bind $itk_component(3dview) <Enter> "focus $itk_component(3dview)"
401
402    bind $itk_component(3dview) <Configure> \
403        [itcl::code $this EventuallyResize %w %h]
404    bind $itk_component(3dview) <Unmap> \
405        [itcl::code $this Unmap]
406    bind $itk_component(3dview) <Map> \
407        [itcl::code $this Map]
408
409    eval itk_initialize $args
410    Connect
411}
412
413# ----------------------------------------------------------------------
414# DESTRUCTOR
415# ----------------------------------------------------------------------
416itcl::body Rappture::MolvisViewer::destructor {} {
417    VisViewer::Disconnect
418
419    image delete $_image(plot)
420    array unset _settings $this-*
421}
422
423# ----------------------------------------------------------------------
424# USAGE: add <dataobj> ?<settings>?
425#
426# Clients use this to add a data object to the plot.  The optional
427# <settings> are used to configure the plot.  Allowed settings are
428# -color, -brightness, -width, -linestyle, and -raise. Only
429# -brightness and -raise do anything.
430# ----------------------------------------------------------------------
431itcl::body Rappture::MolvisViewer::add { dataobj {options ""}} {
432    array set params {
433        -color          auto
434        -brightness     0
435        -width          1
436        -raise          0
437        -linestyle      solid
438        -description    ""
439        -param          ""
440    }
441    array set params $options
442
443    set pos [lsearch -exact $_dlist $dataobj]
444
445    if {$pos < 0} {
446        if {![Rappture::library isvalid $dataobj]} {
447            error "bad value \"$dataobj\": should be Rappture::library object"
448        }
449
450        if { !$_settings($this-showlabels-initialized) } {
451            set showlabels [$dataobj get components.molecule.about.emblems]
452            if { $showlabels != "" && [string is boolean $showlabels] } {
453                set _settings($this-showlabels) $showlabels
454            }
455        }
456
457        lappend _dlist $dataobj
458        if { $params(-brightness) >= 0.5 } {
459            set _dobj2transparency($dataobj) "ghost"
460        } else {
461            set _dobj2transparency($dataobj) "normal"
462        }
463        set _dobj2raise($dataobj) $params(-raise)
464        DebugTrace "setting parameters for $dataobj"
465
466        if { [isconnected] } {
467            $_dispatcher event -idle !rebuild
468        }
469    }
470}
471
472# ----------------------------------------------------------------------
473# USAGE: delete ?<dataobj> <dataobj> ...?
474#
475# Clients use this to delete a dataobj from the plot. If no dataobjs
476# are specified, then all dataobjs are deleted.
477# ----------------------------------------------------------------------
478itcl::body Rappture::MolvisViewer::delete { args } {
479    if {[llength $args] == 0} {
480        set args $_dlist
481    }
482
483    # delete all specified dataobjs
484    set changed 0
485    foreach dataobj $args {
486        set pos [lsearch -exact $_dlist $dataobj]
487        if {$pos >= 0} {
488            set _dlist [lreplace $_dlist $pos $pos]
489            if { [info exists _obj2models($dataobj)] } {
490                foreach model $_obj2models($dataobj) {
491                    array unset _active $model
492                }
493            }
494            array unset _obj2models $dataobj
495            array unset _dobj2transparency $dataobj
496            array unset _dobj2color $dataobj
497            array unset _dobj2width $dataobj
498            array unset _dobj2dashes $dataobj
499            array unset _dobj2raise $dataobj
500            set changed 1
501        }
502    }
503
504    # if anything changed, then rebuild the plot
505    if {$changed} {
506        if { [isconnected] } {
507            $_dispatcher event -idle !rebuild
508        }
509    }
510}
511
512# ----------------------------------------------------------------------
513# USAGE: get
514#
515# Clients use this to query the list of objects being plotted, in
516# order from bottom to top of this result.
517# ----------------------------------------------------------------------
518itcl::body Rappture::MolvisViewer::get {} {
519    # put the dataobj list in order according to -raise options
520    set dlist $_dlist
521    foreach obj $dlist {
522        if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
523            set i [lsearch -exact $dlist $obj]
524            if {$i >= 0} {
525                set dlist [lreplace $dlist $i $i]
526                lappend dlist $obj
527            }
528        }
529    }
530    return $dlist
531}
532
533# ----------------------------------------------------------------------
534# USAGE: download coming
535# USAGE: download controls <downloadCommand>
536# USAGE: download now
537#
538# Clients use this method to create a downloadable representation
539# of the plot.  Returns a list of the form {ext string}, where
540# "ext" is the file extension (indicating the type of data) and
541# "string" is the data itself.
542# ----------------------------------------------------------------------
543itcl::body Rappture::MolvisViewer::download {option args} {
544    switch $option {
545        coming {}
546        controls {
547            set popup .molvisviewerdownload
548            if {![winfo exists $popup]} {
549                # if we haven't created the popup yet, do it now
550                Rappture::Balloon $popup \
551                    -title "[Rappture::filexfer::label downloadWord] as..."
552                set inner [$popup component inner]
553                label $inner.summary -text "" -anchor w
554                radiobutton $inner.pdb \
555                    -text "PDB Protein Data Bank Format File" \
556                    -variable [itcl::scope _downloadPopup(format)] \
557                    -font "Arial 10 " \
558                    -value pdb
559                Rappture::Tooltip::for $inner.pdb \
560                    "Save as PDB Protein Data Bank format file."
561                radiobutton $inner.image -text "Image (PNG/JPEG/GIF)" \
562                    -variable [itcl::scope _downloadPopup(format)] \
563                    -font "Arial 10 " \
564                    -value image
565                Rappture::Tooltip::for $inner.image \
566                    "Save as image."
567                set f [frame $inner.frame]
568                button $f.ok -text "Save" \
569                    -highlightthickness 0 -pady 3 -padx 3 \
570                    -command [lindex $args 0] \
571                    -compound left \
572                    -image [Rappture::icon download]
573                button $f.cancel -text "Cancel" \
574                    -highlightthickness 0 -pady 3 -padx 3 \
575                    -command [list $popup deactivate] \
576                    -compound left \
577                    -image [Rappture::icon cancel]
578                blt::table $f \
579                    0,0 $f.ok \
580                    0,1 $f.cancel
581                blt::table $inner \
582                    0,0 $inner.summary -anchor w \
583                    1,0 $inner.pdb -anchor w \
584                    2,0 $inner.image -anchor w \
585                    3,0 $f -fill x -pady 4
586                $inner.pdb select
587            } else {
588                set inner [$popup component inner]
589            }
590            set num [llength [get]]
591            set num [expr {($num == 1) ? "1 result" : "$num results"}]
592            set word [Rappture::filexfer::label downloadWord]
593            $inner.summary configure -text "$word $num in the following format:"
594            update idletasks ;          # Fix initial sizes
595            return $popup
596        }
597        now {
598            set popup .molvisviewerdownload
599            if {[winfo exists $popup]} {
600                $popup deactivate
601            }
602            switch -- $_downloadPopup(format) {
603                "pdb" {
604                    return [list .pdb $_pdbdata]
605                }
606                "image" {
607                    set popup .molvisviewerimage
608                    if { ![winfo exists $popup] } {
609                        # Create the balloon popup and and the print image
610                        # dialog widget to it.
611                        Rappture::Balloon $popup -title "Save as image..." \
612                            -deactivatecommand \
613                            [itcl::code $this SetWaitVariable 0]
614                        set inner [$popup component inner]
615                        # Add image controls to the ballon popup
616                        AddImageControls $inner [lindex $args 0]
617                    } else {
618                        set inner [$popup component inner]
619                    }
620                    update
621                    # Activate the popup and call for the output.
622                    foreach { widget toolName plotName } $args break
623                    SetWaitVariable 0
624                    $popup activate $widget left
625                    set bool [WaitForResponse]
626                    $popup deactivate
627                    if { $bool } {
628                        return [GetImage $widget]
629                    }
630                    return ""
631                }
632            }
633        }
634        default {
635            error "bad option \"$option\": should be coming, controls, now"
636        }
637    }
638}
639
640#
641# isconnected --
642#
643#       Indicates if we are currently connected to the visualization server.
644#
645itcl::body Rappture::MolvisViewer::isconnected {} {
646    return [VisViewer::IsConnected]
647}
648
649#
650# Connect --
651#
652#       Establishes a connection to a new visualization server.
653#
654itcl::body Rappture::MolvisViewer::Connect {} {
655    global readyForNextFrame
656    set readyForNextFrame 1
657    if { [isconnected] } {
658        return 1
659    }
660    set hosts [GetServerList "pymol"]
661    if { "" == $hosts } {
662        return 0
663    }
664    set _reset 1
665    set result [VisViewer::Connect $hosts]
666    if { $result } {
667        if { $_reportClientInfo }  {
668            # Tell the server the viewer, hub, user and session.
669            # Do this immediately on connect before buffering any commands
670            global env
671
672            set info {}
673            set user "???"
674            if { [info exists env(USER)] } {
675                set user $env(USER)
676            }
677            set session "???"
678            if { [info exists env(SESSION)] } {
679                set session $env(SESSION)
680            }
681            lappend info "version" "$Rappture::version"
682            lappend info "build" "$Rappture::build"
683            lappend info "svnurl" "$Rappture::svnurl"
684            lappend info "installdir" "$Rappture::installdir"
685            lappend info "hub" [exec hostname]
686            lappend info "client" "molvisviewer"
687            lappend info "user" $user
688            lappend info "session" $session
689            SendCmd "clientinfo [list $info]"
690        }
691
692        $_dispatcher event -idle !rebuild
693    }
694    return $result
695}
696
697#
698# Disconnect --
699#
700#       Clients use this method to disconnect from the current rendering
701#       server.
702#
703itcl::body Rappture::MolvisViewer::Disconnect {} {
704    VisViewer::Disconnect
705
706    # disconnected -- no more data sitting on server
707    catch { after cancel $_rocker(afterid) }
708    catch { after cancel $_mevent(afterid) }
709    array unset _dataobjs
710    array unset _model
711    array unset _mlist
712    array unset _imagecache
713
714    set _state(server) 1
715    set _state(client) 1
716    global readyForNextFrame
717    set readyForNextFrame 1
718    set _reset 1
719}
720
721itcl::body Rappture::MolvisViewer::SendCmd { cmd } {
722    DebugTrace "cmd: ($cmd)"
723
724    if { $_state(server) != $_state(client) } {
725        VisViewer::SendCmd "frame -defer $_state(client)"
726        set _state(server) $_state(client)
727    }
728    if { $_rocker(server) != $_rocker(client) } {
729        VisViewer::SendCmd "rock -defer $_rocker(client)"
730        set _rocker(server) $_rocker(client)
731    }
732    VisViewer::SendCmd "$cmd"
733}
734
735#
736# ReceiveImage -bytes <size>
737#
738#     Invoked automatically whenever the "image" command comes in from
739#     the rendering server.  Indicates that binary image data with the
740#     specified <size> will follow.
741#
742set count 0
743itcl::body Rappture::MolvisViewer::ReceiveImage { size cacheid frame rock } {
744    global readyForNextFrame
745    set readyForNextFrame 1
746    set tag "$frame,$rock"
747    global count
748    incr count
749    if { $cacheid != $_cacheid } {
750        array unset _imagecache
751        set _cacheid $cacheid
752    }
753    set data [ReceiveBytes $size]
754    #DebugTrace "success: reading $size bytes from proxy"
755    if { [string match "print*" $cacheid] } {
756        # $frame is the token that we sent to the proxy.
757        set _hardcopy($this-$cacheid) $data
758        puts stderr "setting _hardcopy($this-$cacheid)"
759    } else {
760        set _imagecache($tag) $data
761        #DebugTrace "CACHED: $tag,$cacheid"
762        $_image(plot) configure -data $data
763        set _image(id) $tag
764    }
765}
766
767itcl::body Rappture::MolvisViewer::BuildSettingsTab {} {
768    set fg [option get $itk_component(hull) font Font]
769
770    set inner [$itk_component(main) insert end \
771        -title "Settings" \
772        -icon [Rappture::icon wrench]]
773    $inner configure -borderwidth 4
774
775    label $inner.pict -image $_settings($this-modelimg)
776
777    label $inner.rep_l -text "Molecule Representation" \
778        -font "Arial 9"
779
780    itk_component add representation {
781        Rappture::Combobox $inner.rep -width 20 -editable no
782    }
783    $inner.rep choices insert end \
784        "ballnstick"  "ball and stick" \
785        "spheres"     "spheres"         \
786        "sticks"      "sticks"          \
787        "lines"       "lines"           \
788        "cartoon"     "cartoon"
789
790    bind $inner.rep <<Value>> [itcl::code $this Representation]
791    $inner.rep value "ball and stick"
792
793    scale $inner.spherescale -width 10 -font "Arial 9" \
794        -from 0.1 -to 2.0 -resolution 0.05 -label "Sphere Scale" \
795        -showvalue true -orient horizontal \
796        -command [itcl::code $this EventuallyChangeSettings] \
797        -variable Rappture::MolvisViewer::_settings($this-spherescale)
798    $inner.spherescale set $_settings($this-spherescale)
799    Rappture::Tooltip::for $inner.spherescale \
800        "Adjust scale of atoms (spheres or balls). 1.0 is the full VDW radius."
801
802    scale $inner.stickradius -width 10 -font "Arial 9" \
803        -from 0.1 -to 1.0 -resolution 0.025 -label "Stick Radius" \
804        -showvalue true -orient horizontal \
805        -command [itcl::code $this EventuallyChangeSettings] \
806        -variable Rappture::MolvisViewer::_settings($this-stickradius)
807    Rappture::Tooltip::for $inner.stickradius \
808        "Adjust scale of bonds (sticks)."
809    $inner.stickradius set $_settings($this-stickradius)
810
811    checkbutton $inner.labels -text "Show labels on atoms" \
812        -command [itcl::code $this labels update] \
813        -variable [itcl::scope _settings($this-showlabels)] \
814        -font "Arial 9"
815    Rappture::Tooltip::for $inner.labels \
816        "Display atom symbol and serial number."
817
818    checkbutton $inner.rock -text "Rock model back and forth" \
819        -command [itcl::code $this Rock toggle] \
820        -variable Rappture::MolvisViewer::_settings($this-rock) \
821        -font "Arial 9"
822    Rappture::Tooltip::for $inner.rock \
823        "Rotate the object back and forth around the y-axis."
824
825    checkbutton $inner.ortho -text "Orthoscopic projection" \
826        -command [itcl::code $this OrthoProjection update] \
827        -variable Rappture::MolvisViewer::_settings($this-ortho) \
828         -font "Arial 9"
829    Rappture::Tooltip::for $inner.ortho \
830        "Toggle between orthoscopic/perspective projection modes."
831
832    checkbutton $inner.cartoontrace -text "Cartoon Trace" \
833        -command [itcl::code $this CartoonTrace update] \
834        -variable [itcl::scope _settings($this-cartoontrace)] \
835        -font "Arial 9"
836    Rappture::Tooltip::for $inner.cartoontrace \
837        "Set cartoon representation of bonds (sticks)."
838
839    checkbutton $inner.cell -text "Parallelepiped" \
840        -command [itcl::code $this Cell toggle] \
841        -font "Arial 9"
842    $inner.cell select
843
844    label $inner.spacer
845    blt::table $inner \
846        0,0 $inner.labels -anchor w -pady {1 0} \
847        1,0 $inner.rock -anchor w -pady {1 0} \
848        2,0 $inner.ortho -anchor w -pady {1 0} \
849        3,0 $inner.cartoontrace -anchor w -pady {1 0} \
850        4,0 $inner.cell -anchor w  -pady {1 0} \
851        5,0 $inner.rep_l -anchor w -pady { 2 0 } \
852        6,0 $inner.rep -anchor w  \
853        7,0 $inner.spherescale -fill x -pady {3 0} \
854        8,0 $inner.stickradius -fill x -pady {1 0} \
855
856    blt::table configure $inner r* -resize none
857    blt::table configure $inner r10 -resize expand
858}
859
860# ----------------------------------------------------------------------
861# USAGE: Rebuild
862#
863# Called automatically whenever something changes that affects the
864# data in the widget.  Clears any existing data and rebuilds the
865# widget to display new data.
866# ----------------------------------------------------------------------
867itcl::body Rappture::MolvisViewer::Rebuild {} {
868    DebugTrace "Enter"
869    set changed 0
870
871    # Turn on buffering of commands to the server.  We don't want to
872    # be preempted by a server disconnect/reconnect (that automatically
873    # generates a new call to Rebuild).
874    StartBufferingCommands
875    set _cell 0
876
877    if { $_reset } {
878        set _rocker(server) 0
879        set _cacheid 0
880
881        SendCmd "raw -defer {set auto_color,0}"
882        SendCmd "raw -defer {set auto_show_lines,0}"
883    }
884    set _first ""
885    set dlist [get]
886    foreach dataobj $dlist {
887        if { $_first == "" } {
888            set _first $dataobj
889        }
890        set model [$dataobj get components.molecule.model]
891        if {"" == $model } {
892            set model "molecule"
893            scan $dataobj "::libraryObj%d" suffix
894            set model $model$suffix
895        }
896        lappend _obj2models($dataobj) $model
897        set state [$dataobj get components.molecule.state]
898        if {"" == $state} {
899            set state $_state(server)
900        }
901        if { ![info exists _mlist($model)] } {  # new, turn on
902            set _mlist($model) 2
903        } elseif { $_mlist($model) == 1 } {     # on, leave on
904            set _mlist($model) 3
905        } elseif { $_mlist($model) == 0 } {     # off, turn on
906            set _mlist($model) 2
907        }
908        if { ![info exists _dataobjs($model-$state)] } {
909            set data1      ""
910            set serial    1
911
912            if { $_reportClientInfo }  {
913                set parent [$dataobj parent -as object]
914                while { $parent != "" } {
915                    set xmlobj $parent
916                    set parent [$parent parent -as object]
917                }
918                set info {}
919                lappend info "tool_id"      [$xmlobj get tool.id]
920                lappend info "tool_name"    [$xmlobj get tool.name]
921                lappend info "tool_title"   [$xmlobj get tool.title]
922                lappend info "tool_command" [$xmlobj get tool.execute]
923                lappend info "tool_revision" \
924                    [$xmlobj get tool.version.application.revision]
925                SendCmd "clientinfo [list $info]"
926            }
927            foreach _atom [$dataobj children -type atom components.molecule] {
928                set symbol [$dataobj get components.molecule.$_atom.symbol]
929                set xyz [$dataobj get components.molecule.$_atom.xyz]
930                regsub {,} $xyz {} xyz
931                scan $xyz "%f %f %f" x y z
932                set recname  "ATOM  "
933                set altLoc   ""
934                set resName  ""
935                set chainID  ""
936                set Seqno    ""
937                set occupancy  1
938                set tempFactor 0
939                set recID      ""
940                set segID      ""
941                set element    ""
942                set charge     ""
943                set atom $symbol
944                set line [format "%6s%5d %4s%1s%3s %1s%5s   %8.3f%8.3f%8.3f%6.2f%6.2f%8s\n" $recname $serial $atom $altLoc $resName $chainID $Seqno $x $y $z $occupancy $tempFactor $recID]
945                append data1 $line
946                incr serial
947            }
948            if {"" != $data1} {
949                # Save the PDB data in case the user wants to later save it.
950                set _pdbdata $data1
951                set numBytes [string length $data1]
952
953                # We know we're buffered here, so append the "loadpdb" command
954                # with the data payload immediately afterwards.
955                SendCmd "loadpdb -defer follows $model $state $numBytes"
956                SendData $data1
957                set _dataobjs($model-$state)  1
958            }
959            # note that pdb files always overwrite xyz files
960            set data2 [$dataobj get components.molecule.pdb]
961            if {"" != $data2} {
962                # Save the PDB data in case the user wants to later save it.
963                set _pdbdata $data2
964                set numBytes [string length $data2]
965
966                # We know we're buffered here, so append the "loadpdb" command
967                # with the data payload immediately afterwards.
968                SendCmd "loadpdb -defer follows $model $state $numBytes"
969                SendData $data2
970                set _dataobjs($model-$state)  1
971            }
972            # lammps dump file overwrites pdb file (change this?)
973            set lammpstypemap [$dataobj get components.molecule.lammpstypemap]
974            set lammpsdata [$dataobj get components.molecule.lammps]
975            if {"" != $lammpsdata} {
976                set data3 ""
977                set modelcount 0
978                foreach lammpsline [split $lammpsdata "\n"] {
979                    if {[scan $lammpsline "%d %d %f %f %f" id type x y z] == 5} {
980                        set recname  "ATOM  "
981                        set altLoc   ""
982                        set resName  ""
983                        set chainID  ""
984                        set Seqno    ""
985                        set occupancy  1
986                        set tempFactor 0
987                        set recID      ""
988                        set segID      ""
989                        set element    ""
990                        set charge     ""
991                        if { "" == $lammpstypemap} {
992                            set atom $type
993                        } else {
994                            set atom [lindex $lammpstypemap [expr {$type - 1}]]
995                            if { "" == $atom} {
996                              set atom $type
997                            }
998                        }
999                        set pdbline [format "%6s%5d %4s%1s%3s %1s%5s   %8.3f%8.3f%8.3f%6.2f%6.2f%8s\n" $recname $id $atom $altLoc $resName $chainID $Seqno $x $y $z $occupancy $tempFactor $recID]
1000                        append data3 $pdbline
1001                    }
1002                    # only read first model
1003                    if {[regexp "^ITEM: ATOMS" $lammpsline]} {
1004                      incr modelcount
1005                      if {$modelcount > 1} {
1006                        break
1007                      }
1008                    }
1009                }
1010                if {"" != $data3} {
1011                    # Save the PDB data in case the user wants to later save it.
1012                    set _pdbdata $data3
1013                    set numBytes [string length $data3]
1014
1015                    # We know we're buffered here, so append the "loadpdb"
1016                    # command with the data payload immediately afterwards.
1017                    SendCmd "loadpdb -defer follows $model $state $numBytes"
1018                    SendData $data3
1019                }
1020                set _dataobjs($model-$state) 1
1021            }
1022        }
1023        if { ![info exists _model($model-transparency)] } {
1024            set _model($model-transparency) ""
1025        }
1026        if { ![info exists _model($model-rep)] } {
1027            set _model($model-rep) ""
1028            set _model($model-newrep) $_mrep
1029        }
1030        if { $_model($model-transparency) != $_dobj2transparency($dataobj) } {
1031            set _model($model-newtransparency) $_dobj2transparency($dataobj)
1032        }
1033        if { $_dobj2transparency($dataobj) == "ghost"} {
1034            array unset _active $model
1035        } else {
1036            set _active($model) $dataobj
1037        }
1038        set vector [$dataobj get components.parallelepiped.vector]
1039        if { $vector != "" } {
1040            set vertices [ComputeParallelepipedVertices $dataobj]
1041            SendCmd "raw -defer {verts = \[$vertices\]\n}"
1042            SendCmd "raw -defer {run \$PYMOL_SITE_PATH/rappture/box.py\n}"
1043            SendCmd "raw -defer {draw_box(verts)\n}"
1044            set _cell 1
1045        }
1046    }
1047
1048    # enable/disable models as required (0=off->off, 1=on->off, 2=off->on,
1049    # 3=on->on)
1050
1051    foreach model [array names _mlist] {
1052        if { $_mlist($model) == 1 } {
1053            SendCmd "disable -defer $model"
1054            set _mlist($model) 0
1055            set changed 1
1056        } elseif { $_mlist($model) == 2 } {
1057            set _mlist($model) 1
1058            SendCmd "enable -defer $model"
1059            set changed 1
1060        } elseif { $_mlist($model) == 3 } {
1061            set _mlist($model) 1
1062        }
1063        if { $_mlist($model) == 1 } {
1064            if {  [info exists _model($model-newtransparency)] ||
1065                  [info exists _model($model-newrep)] } {
1066                if { ![info exists _model($model-newrep)] } {
1067                    set _model($model-newrep) $_model($model-rep)
1068                }
1069                if { ![info exists _model($model-newtransparency)] } {
1070                    set _model($model-newtransparency) $_model($model-transparency)
1071                }
1072                set rep $_model($model-newrep)
1073                set transp $_model($model-newtransparency)
1074                SendCmd "representation -defer -model $model $rep"
1075                set changed 1
1076                set _model($model-transparency) $_model($model-newtransparency)
1077                set _model($model-rep) $_model($model-newrep)
1078                catch {
1079                    unset _model($model-newtransparency)
1080                    unset _model($model-newrep)
1081                }
1082            }
1083        }
1084
1085    }
1086
1087    if { $changed } {
1088        array unset _imagecache
1089    }
1090    if { $dlist == "" } {
1091        set _state(server) 1
1092        set _state(client) 1
1093        SendCmd "frame 1"
1094        set flush 1
1095    } elseif { ![info exists _imagecache($state,$_rocker(client))] } {
1096        set _state(server) $state
1097        set _state(client) $state
1098        SendCmd "frame $state"
1099        set flush 1
1100    } else {
1101        set _state(client) $state
1102        UpdateState
1103        set flush 0
1104    }
1105    if { $_reset } {
1106        # Set or restore viewing parameters.  We do this for the first
1107        # model and assume this works for everything else.
1108        set w  [winfo width $itk_component(3dview)]
1109        set h  [winfo height $itk_component(3dview)]
1110        SendCmd "reset"
1111        SendCmd "screen $w $h"
1112        SendCmd "rotate $_view(mx) $_view(my) $_view(mz)"
1113        SendCmd "pan $_view(xpan) $_view(ypan)"
1114        SendCmd "zoom $_view(zoom)"
1115        DebugTrace "rotate $_view(mx) $_view(my) $_view(mz)"
1116
1117        SendCmd "raw -defer {zoom complete=1}"
1118        set _reset 0
1119    }
1120    if { $changed } {
1121        # Default settings for all models.
1122        SphereScale update
1123        StickRadius update
1124        labels update
1125        Opacity update
1126        CartoonTrace update
1127        Cell update
1128        OrthoProjection update
1129        Representation update
1130    }
1131    set inner [$itk_component(main) panel "Settings"]
1132    if { $_cell } {
1133        $inner.cell configure -state normal
1134    } else {
1135        $inner.cell configure -state disabled
1136    }
1137    if { $flush } {
1138        global readyForNextFrame
1139        set readyForNextFrame 0;        # Don't advance to the next frame
1140                                        # until we get an image.
1141        #SendCmd "ppm";                 # Flush the results.
1142    }
1143    blt::busy hold $itk_component(hull)
1144    StopBufferingCommands
1145    blt::busy release $itk_component(hull)
1146
1147    DebugTrace "Exit"
1148}
1149
1150itcl::body Rappture::MolvisViewer::Unmap { } {
1151    # Pause rocking loop while unmapped (saves CPU time)
1152    Rock pause
1153
1154    # Blank image, mark current image dirty
1155    # This will force reload from cache, or remain blank if cache is cleared
1156    # This prevents old image from briefly appearing when a new result is added
1157    # by result viewer
1158
1159    #$_image(plot) blank
1160    set _image(id) ""
1161}
1162
1163itcl::body Rappture::MolvisViewer::Map { } {
1164    if { [isconnected] } {
1165        # Resume rocking loop if it was on
1166        Rock unpause
1167        # Rebuild image if modified, or redisplay cached image if not
1168        $_dispatcher event -idle !rebuild
1169    }
1170}
1171
1172itcl::body Rappture::MolvisViewer::DoResize { } {
1173    SendCmd "screen $_width $_height"
1174    $_image(plot) configure -width $_width -height $_height
1175    # Immediately invalidate cache, defer update until mapped
1176    array unset _imagecache
1177    set _resizePending 0
1178}
1179
1180itcl::body Rappture::MolvisViewer::EventuallyResize { w h } {
1181    set _width $w
1182    set _height $h
1183    if { !$_resizePending } {
1184        $_dispatcher event -after 400 !resize
1185        set _resizePending 1
1186    }
1187}
1188
1189itcl::body Rappture::MolvisViewer::DoRotate {} {
1190    SendCmd "rotate $_view(a) $_view(b) $_view(c)"
1191    array unset _imagecache
1192    set _rotatePending 0
1193}
1194
1195itcl::body Rappture::MolvisViewer::EventuallyRotate { a b c } {
1196    set _view(a) $a
1197    set _view(b) $b
1198    set _view(c) $c
1199    if { !$_rotatePending } {
1200        $_dispatcher event -after 100 !rotate
1201        set _rotatePending 1
1202    }
1203}
1204
1205itcl::body Rappture::MolvisViewer::DoUpdate { } {
1206    array unset _imagecache
1207    set models [array names _mlist]
1208    SphereScale $_settings($this-spherescale) $models
1209    StickRadius $_settings($this-stickradius) $models
1210    set _updatePending 0
1211}
1212
1213itcl::body Rappture::MolvisViewer::EventuallyChangeSettings { args } {
1214    if { !$_updatePending } {
1215        $_dispatcher event -after 400 !update
1216        set _updatePending 1
1217    }
1218}
1219
1220# ----------------------------------------------------------------------
1221# USAGE: $this Pan click x y
1222#        $this Pan drag x y
1223#        $this Pan release x y
1224#
1225# Called automatically when the user clicks on one of the zoom
1226# controls for this widget.  Changes the zoom for the current view.
1227# ----------------------------------------------------------------------
1228itcl::body Rappture::MolvisViewer::Pan {option x y} {
1229    if { $option == "set" } {
1230        set dx $x
1231        set dy $y
1232        set _view(xpan) [expr $_view(xpan) + $dx]
1233        set _view(ypan) [expr $_view(ypan) + $dy]
1234        array unset _imagecache
1235        SendCmd "pan $dx $dy"
1236        return
1237    }
1238    if { ![info exists _mevent(x)] } {
1239        set option "click"
1240    }
1241    if { $option == "click" } {
1242        $itk_component(3dview) configure -cursor hand1
1243    }
1244    if { $option == "drag" || $option == "release" } {
1245        set dx [expr $x - $_mevent(x)]
1246        set dy [expr $y - $_mevent(y)]
1247        set _view(xpan) [expr $_view(xpan) + $dx]
1248        set _view(ypan) [expr $_view(ypan) + $dy]
1249        array unset _imagecache
1250        SendCmd "pan $dx $dy"
1251    }
1252    set _mevent(x) $x
1253    set _mevent(y) $y
1254    if { $option == "release" } {
1255        $itk_component(3dview) configure -cursor ""
1256    }
1257}
1258
1259# ----------------------------------------------------------------------
1260# USAGE: Zoom in
1261# USAGE: Zoom out
1262# USAGE: Zoom reset
1263#
1264# Called automatically when the user clicks on one of the zoom
1265# controls for this widget.  Changes the zoom for the current view.
1266# ----------------------------------------------------------------------
1267itcl::body Rappture::MolvisViewer::Zoom {option {factor 10}} {
1268    switch -- $option {
1269        "in" {
1270            set _view(zoom) [expr $_view(zoom) + $factor]
1271            SendCmd "zoom $factor"
1272        }
1273        "out" {
1274            set _view(zoom) [expr $_view(zoom) - $factor]
1275            SendCmd "zoom -$factor"
1276        }
1277        "reset" {
1278            set _view(zoom) 0
1279            SendCmd "reset"
1280        }
1281    }
1282    array unset _imagecache
1283}
1284
1285itcl::body Rappture::MolvisViewer::UpdateState { args } {
1286    set tag "$_state(client),$_rocker(client)"
1287    if { $_image(id) != "$tag" } {
1288        if { [info exists _imagecache($tag)] } {
1289            $_image(plot) configure -data $_imagecache($tag)
1290            set _image(id) "$tag"
1291        }
1292    }
1293}
1294
1295# ----------------------------------------------------------------------
1296# USAGE: Rock on|off|toggle
1297# USAGE: Rock pause|unpause|step
1298#
1299# Used to control the "rocking" model for the molecule being displayed.
1300# Clients should use only the on/off/toggle options; the rest are for
1301# internal control of the rocking motion.
1302# ----------------------------------------------------------------------
1303itcl::body Rappture::MolvisViewer::Rock { option } {
1304    # cancel any pending rocks
1305    if { [info exists _rocker(afterid)] } {
1306        after cancel $_rocker(afterid)
1307        unset _rocker(afterid)
1308    }
1309    if { ![winfo viewable $itk_component(3dview)] } {
1310        return
1311    }
1312    set _rocker(on) $_settings($this-rock)
1313    if { $option == "step"} {
1314        if { $_rocker(client) >= 10 } {
1315            set _rocker(dir) -1
1316        } elseif { $_rocker(client) <= -10 } {
1317            set _rocker(dir) 1
1318        }
1319        set _rocker(client) [expr {$_rocker(client) + $_rocker(dir)}]
1320        if { ![info exists _imagecache($_state(server),$_rocker(client))] } {
1321            set _rocker(server) $_rocker(client)
1322            SendCmd "rock $_rocker(client)"
1323        }
1324        UpdateState
1325    }
1326    if { $_rocker(on) && $option != "pause" } {
1327         set _rocker(afterid) [after 200 [itcl::code $this Rock step]]
1328    }
1329}
1330
1331#
1332# Send virtual mouse events using the vmouse command
1333#
1334itcl::body Rappture::MolvisViewer::Vmouse {option b m x y} {
1335    set now [clock clicks -milliseconds]
1336    set vButton [expr $b - 1]
1337    set vModifier 0
1338    set vState 1
1339
1340    if { $m & 1 }      { set vModifier [expr $vModifier | 1 ] }
1341    if { $m & 4 }      { set vModifier [expr $vModifier | 2 ] }
1342    if { $m & 131072 } { set vModifier [expr $vModifier | 4 ] }
1343
1344    if { $option == "click"   } { set vState 0 }
1345    if { $option == "release" } { set vState 1 }
1346    if { $option == "drag"    } { set vState 2 }
1347    if { $option == "move"    } { set vState 3 }
1348
1349    if { $vState == 2 || $vState == 3} {
1350        set diff 0
1351
1352        catch { set diff [expr $now - $_mevent(time)] }
1353        if {$diff < 75} { # 75ms between motion updates
1354            return
1355        }
1356    }
1357    SendCmd "vmouse $vButton $vModifier $vState $x $y"
1358    set _mevent(time) $now
1359}
1360
1361# ----------------------------------------------------------------------
1362# USAGE: Rotate click <x> <y>
1363# USAGE: Rotate drag <x> <y>
1364# USAGE: Rotate release <x> <y>
1365#
1366# Called automatically when the user clicks/drags/releases in the
1367# plot area.  Moves the plot according to the user's actions.
1368# ----------------------------------------------------------------------
1369itcl::body Rappture::MolvisViewer::Rotate {option x y} {
1370    set now  [clock clicks -milliseconds]
1371    # cancel any pending delayed dragging events
1372    if { [info exists _mevent(afterid)] } {
1373        after cancel $_mevent(afterid)
1374        unset _mevent(afterid)
1375    }
1376
1377    if { ![info exists _mevent(x)] } {
1378        set option "click"
1379    }
1380    if { $option == "click" } {
1381        $itk_component(3dview) configure -cursor fleur
1382    }
1383    if { $option == "drag" || $option == "release" } {
1384        set diff 0
1385        catch { set diff [expr $now - $_mevent(time) ] }
1386        if {$diff < 25 && $option == "drag" } { # 75ms between motion updates
1387            set _mevent(afterid) [after [expr 25 - $diff] [itcl::code $this Rotate drag $x $y]]
1388            return
1389        }
1390        set w [winfo width $itk_component(3dview)]
1391        set h [winfo height $itk_component(3dview)]
1392        if {$w <= 0 || $h <= 0} {
1393            return
1394        }
1395        set x1 [expr double($w) / 3]
1396        set x2 [expr $x1 * 2]
1397        set y1 [expr double($h) / 3]
1398        set y2 [expr $y1 * 2]
1399        set dx [expr $x - $_mevent(x)]
1400        set dy [expr $y - $_mevent(y)]
1401        set mx 0
1402        set my 0
1403        set mz 0
1404
1405        if { $_mevent(x) < $x1 } {
1406            set mz $dy
1407        } elseif { $_mevent(x) < $x2 } {
1408            set mx $dy
1409        } else {
1410            set mz [expr -$dy]
1411        }
1412
1413        if { $_mevent(y) < $y1 } {
1414            set mz [expr -$dx]
1415        } elseif { $_mevent(y) < $y2 } {
1416            set my $dx
1417        } else {
1418            set mz $dx
1419        }
1420        # Accumlate movements
1421        set _view(mx) [expr {$_view(mx) + $mx}]
1422        set _view(my) [expr {$_view(my) + $my}]
1423        set _view(mz) [expr {$_view(mz) + $mz}]
1424        #SendCmd "rotate $mx $my $mz"
1425        EventuallyRotate $mx $my $mz
1426        DebugTrace "rotate $_view(mx) $_view(my) $_view(mz)"
1427    }
1428    set _mevent(x) $x
1429    set _mevent(y) $y
1430    set _mevent(time) $now
1431    if { $option == "release" } {
1432        $itk_component(3dview) configure -cursor ""
1433    }
1434}
1435
1436# ----------------------------------------------------------------------
1437# USAGE: Rotate.old click <x> <y>
1438# USAGE: Rotate.old drag <x> <y>
1439# USAGE: Rotate.old release <x> <y>
1440#
1441# Called automatically when the user clicks/drags/releases in the
1442# plot area.  Moves the plot according to the user's actions.
1443# ----------------------------------------------------------------------
1444itcl::body Rappture::MolvisViewer::Rotate.old {option x y} {
1445    set now  [clock clicks -milliseconds]
1446    #update idletasks
1447    # cancel any pending delayed dragging events
1448    if { [info exists _mevent(afterid)] } {
1449        after cancel $_mevent(afterid)
1450        unset _mevent(afterid)
1451    }
1452    switch -- $option {
1453        click {
1454            $itk_component(3dview) configure -cursor fleur
1455            set _click(x) $x
1456            set _click(y) $y
1457            set _click(theta) $_view(theta)
1458            set _click(phi) $_view(phi)
1459        }
1460        drag {
1461            if {[array size _click] == 0} {
1462                Rotate.old click $x $y
1463            } else {
1464                set w [winfo width $itk_component(3dview)]
1465                set h [winfo height $itk_component(3dview)]
1466                if {$w <= 0 || $h <= 0} {
1467                    return
1468                }
1469                #set diff 0
1470                #catch { set diff [expr $now - $_mevent(time) ] }
1471                #if {$diff < 75 && $option == "drag" } { # 75ms between motion updates
1472                #    set _mevent(afterid) [after [expr 75 - $diff] [itcl::code $this Rotate.old drag $x $y]]
1473                #    return
1474                #}
1475
1476                if {[catch {
1477                    # this fails sometimes for no apparent reason
1478                    set dx [expr {double($x-$_click(x))/$w}]
1479                    set dy [expr {double($y-$_click(y))/$h}]
1480                }]} {
1481                    return
1482                }
1483
1484                #
1485                # Rotate the camera in 3D
1486                #
1487                if {$_view(psi) > 90 || $_view(psi) < -90} {
1488                    # when psi is flipped around, theta moves backwards
1489                    set dy [expr {-$dy}]
1490                }
1491                set theta [expr {$_view(theta) - $dy*180}]
1492                while {$theta < 0} { set theta [expr {$theta+180}] }
1493                while {$theta > 180} { set theta [expr {$theta-180}] }
1494
1495                if {abs($theta) >= 30 && abs($theta) <= 160} {
1496                    set phi [expr {$_view(phi) - $dx*360}]
1497                    while {$phi < 0} { set phi [expr {$phi+360}] }
1498                    while {$phi > 360} { set phi [expr {$phi-360}] }
1499                    set psi $_view(psi)
1500                } else {
1501                    set phi $_view(phi)
1502                    set psi [expr {$_view(psi) - $dx*360}]
1503                    while {$psi < -180} { set psi [expr {$psi+360}] }
1504                    while {$psi > 180} { set psi [expr {$psi-360}] }
1505                }
1506                array set _view [subst {
1507                    theta $theta
1508                    phi $phi
1509                    psi $psi
1510                }]
1511                foreach { vx vy vz } [Euler2XYZ $theta $phi $psi] break
1512                set a [expr $vx - $_view(vx)]
1513                set a [expr -$a]
1514                set b [expr $vy - $_view(vy)]
1515                set c [expr $vz - $_view(vz)]
1516                array set _view [subst {
1517                    vx $vx
1518                    vy $vy
1519                    vz $vz
1520                }]
1521                EventuallyRotate $a $b $c
1522                #SendCmd "rotate $a $b $c"
1523                DebugTrace "x,y: $x $y: rotate $_view(vx) $_view(vy) $_view(vz)"
1524                set _click(x) $x
1525                set _click(y) $y
1526            }
1527        }
1528        release {
1529            Rotate.old drag $x $y
1530            $itk_component(3dview) configure -cursor ""
1531            catch {unset _click}
1532        }
1533        default {
1534            error "bad option \"$option\": should be click, drag, release"
1535        }
1536    }
1537    set _mevent(time) $now
1538}
1539
1540# ----------------------------------------------------------------------
1541# USAGE: Representation spheres|ballnstick|lines|sticks
1542#
1543# Used internally to change the molecular representation used to render
1544# our scene.
1545# ----------------------------------------------------------------------
1546itcl::body Rappture::MolvisViewer::Representation { { option "" } } {
1547    if { $option == "" } {
1548        set value [$itk_component(representation) value]
1549        set option [$itk_component(representation) translate $value]
1550    }
1551    if { $option == $_mrep } {
1552        return
1553    }
1554    if { $option == "update" } {
1555        set option $_settings($this-model)
1556    }
1557    array unset _imagecache
1558    if { $option == "sticks" } {
1559        set _settings($this-modelimg) [Rappture::icon lines]
1560    }  else {
1561        set _settings($this-modelimg) [Rappture::icon $option]
1562    }
1563    set inner [$itk_component(main) panel "Settings"]
1564    $inner.pict configure -image $_settings($this-modelimg)
1565
1566    # Save the current option to set all radiobuttons -- just in case.
1567    # This method gets called without the user clicking on a radiobutton.
1568    set _settings($this-model) $option
1569    set _mrep $option
1570
1571    foreach model [array names _mlist] {
1572        if { [info exists _model($model-rep)] } {
1573            if { $_model($model-rep) != $option } {
1574                set _model($model-newrep) $option
1575            } else {
1576                catch { unset _model($model-newrep) }
1577            }
1578        }
1579    }
1580    if { [isconnected] } {
1581        SendCmd "representation -model $model $option"
1582        #$_dispatcher event -idle !rebuild
1583    }
1584}
1585
1586# ----------------------------------------------------------------------
1587# USAGE: OrthoProjection on|off|toggle
1588# USAGE: OrthoProjection update
1589#
1590# Used internally to turn labels associated with atoms on/off, and to
1591# update the positions of the labels so they sit on top of each atom.
1592# ----------------------------------------------------------------------
1593itcl::body Rappture::MolvisViewer::OrthoProjection {option} {
1594    array unset _imagecache
1595    switch -- $option {
1596        "orthoscopic" {
1597            set ortho 1
1598        }
1599        "perspective" {
1600            set ortho 0
1601        }
1602        "toggle" {
1603            set ortho [expr {$_settings($this-ortho) == 0}]
1604        }
1605        "update" {
1606            set ortho $_settings($this-ortho)
1607        }
1608        default {
1609            error "bad option \"$option\": should be on, off, toggle, or update"
1610        }
1611    }
1612    if { $ortho == $_settings($this-ortho) && $option != "update"} {
1613        # nothing to do
1614        return
1615    }
1616    if { $ortho } {
1617        $itk_component(ortho) configure -image [Rappture::icon molvis-3dorth]
1618        Rappture::Tooltip::for $itk_component(ortho) \
1619            "Use perspective projection"
1620        set _settings($this-ortho) 1
1621        SendCmd "orthoscopic on"
1622    } else {
1623        $itk_component(ortho) configure -image [Rappture::icon molvis-3dpers]
1624        Rappture::Tooltip::for $itk_component(ortho) \
1625            "Use orthoscopic projection"
1626        set _settings($this-ortho) 0
1627        SendCmd "orthoscopic off"
1628    }
1629}
1630
1631# ----------------------------------------------------------------------
1632# USAGE: Cell on|off|toggle
1633#
1634# Used internally to turn labels associated with atoms on/off, and to
1635# update the positions of the labels so they sit on top of each atom.
1636# ----------------------------------------------------------------------
1637itcl::body Rappture::MolvisViewer::Cell {option} {
1638    switch -- $option {
1639        "on" - "off" {
1640            set cell $option
1641        }
1642        "toggle" {
1643            set cell [expr {$_settings($this-showcell) == 0}]
1644        }
1645        "update" {
1646            set cell $_settings($this-showcell)
1647        }
1648        default {
1649            error "bad option \"$option\": should be on, off, toggle, or update"
1650        }
1651    }
1652    if { $cell == $_settings($this-showcell) && $option != "update"} {
1653        # nothing to do
1654        return
1655    }
1656    array unset _imagecache
1657    if { $cell } {
1658        Rappture::Tooltip::for $itk_component(ortho) \
1659            "Hide the cell."
1660        set _settings($this-showcell) 1
1661        SendCmd "raw {show everything,unitcell}"
1662    } else {
1663        Rappture::Tooltip::for $itk_component(ortho) \
1664            "Show the cell."
1665        set _settings($this-showcell) 0
1666        SendCmd "raw {hide everything,unitcell}"
1667    }
1668}
1669
1670#
1671# ResetView
1672#
1673itcl::body Rappture::MolvisViewer::ResetView {} {
1674    array set _view {
1675        theta   45
1676        phi     45
1677        psi     0
1678        mx      0
1679        my      0
1680        mz      0
1681        xpan    0
1682        ypan    0
1683        zoom    0
1684    }
1685    SendCmd "reset"
1686    DoResize
1687    SendCmd "rotate $_view(mx) $_view(my) $_view(mz)"
1688    DebugTrace "rotate $_view(mx) $_view(my) $_view(mz)"
1689    SendCmd "pan $_view(xpan) $_view(ypan)"
1690    SendCmd "zoom $_view(zoom)"
1691}
1692
1693itcl::body Rappture::MolvisViewer::WaitIcon { option widget } {
1694    switch -- $option {
1695        "start" {
1696            $_dispatcher dispatch $this !waiticon \
1697                "[itcl::code $this WaitIcon "next" $widget] ; list"
1698            set _icon 0
1699            $widget configure -image [Rappture::icon bigroller${_icon}]
1700            $_dispatcher event -after 100 !waiticon
1701        }
1702        "next" {
1703            incr _icon
1704            if { $_icon >= 8 } {
1705                set _icon 0
1706            }
1707            $widget configure -image [Rappture::icon bigroller${_icon}]
1708            $_dispatcher event -after 100 !waiticon
1709        }
1710        "stop" {
1711            $_dispatcher cancel !waiticon
1712        }
1713    }
1714}
1715
1716itcl::body Rappture::MolvisViewer::GetImage { widget } {
1717    set token "print[incr _nextToken]"
1718    set var ::Rappture::MolvisViewer::_hardcopy($this-$token)
1719    set $var ""
1720
1721    set controls $_downloadPopup(image_controls)
1722    set combo $controls.size
1723    set size [$combo translate [$combo value]]
1724    switch -- $size {
1725        "standard" {
1726            set width 1200
1727            set height 1200
1728        }
1729        "highquality" {
1730            set width 2400
1731            set height 2400
1732        }
1733        "draft" {
1734            set width 400
1735            set height 400
1736        }
1737        default {
1738            error "unknown image size [$combo value]"
1739        }
1740    }
1741    # Setup an automatic timeout procedure.
1742    $_dispatcher dispatch $this !pngtimeout "set $var {} ; list"
1743
1744    set popup .molvisviewerimagedownload
1745    if { ![winfo exists $popup] } {
1746        Rappture::Balloon $popup -title "Generating file..."
1747        set inner [$popup component inner]
1748        label $inner.title -text "Generating hardcopy." -font "Arial 10 bold"
1749        label $inner.please -text "This may take a minute." -font "Arial 10"
1750        label $inner.icon -image [Rappture::icon bigroller0]
1751        button $inner.cancel -text "Cancel" -font "Arial 10 bold" \
1752            -command [list set $var ""]
1753        blt::table $inner \
1754            0,0 $inner.title -cspan 2 \
1755            1,0 $inner.please -anchor w \
1756            1,1 $inner.icon -anchor e  \
1757            2,0 $inner.cancel -cspan 2
1758        blt::table configure $inner r0 -pady 4
1759        blt::table configure $inner r2 -pady 4
1760        bind $inner.cancel <Return> [list $inner.cancel invoke]
1761        bind $inner.cancel <KP_Enter> [list $inner.cancel invoke]
1762    } else {
1763        set inner [$popup component inner]
1764    }
1765    set combo $controls.bgcolor
1766    set bgcolor [$combo translate [$combo value]]
1767
1768    $_dispatcher event -after 60000 !pngtimeout
1769    WaitIcon start $inner.icon
1770    grab set $inner
1771    focus $inner.cancel
1772
1773    SendCmd "print $token $width $height $bgcolor"
1774
1775    $popup activate $widget below
1776    # We wait here for either
1777    #  1) the png to be delivered or
1778    #  2) timeout or
1779    #  3) user cancels the operation.
1780    tkwait variable $var
1781
1782    # Clean up.
1783    $_dispatcher cancel !pngtimeout
1784    WaitIcon stop $inner.icon
1785    grab release $inner
1786    $popup deactivate
1787    update
1788
1789    if { $_hardcopy($this-$token) != "" } {
1790        set combo $controls.format
1791        set fmt [$combo translate [$combo value]]
1792        switch -- $fmt {
1793            "jpg" {
1794                set img [image create photo -data $_hardcopy($this-$token)]
1795                set bytes [$img data -format "jpeg -quality 100"]
1796                set bytes [Rappture::encoding::decode -as b64 $bytes]
1797                return [list .jpg $bytes]
1798            }
1799            "gif" {
1800                set img [image create photo -data $_hardcopy($this-$token)]
1801                set bytes [$img data -format "gif"]
1802                set bytes [Rappture::encoding::decode -as b64 $bytes]
1803                return [list .gif $bytes]
1804            }
1805            "png" {
1806                return [list .png $_hardcopy($this-$token)]
1807            }
1808        }
1809    }
1810    return ""
1811}
1812
1813# ----------------------------------------------------------------------
1814# USAGE: SphereScale radius ?model?
1815#        SphereScale update ?model?
1816#
1817# Used internally to change the molecular atom scale used to render
1818# our scene.
1819#
1820# Note: Only sets the specified radius for active models.  If the model
1821#       is inactive, then it overridden with the value "0.1".
1822# ----------------------------------------------------------------------
1823itcl::body Rappture::MolvisViewer::SphereScale { option {models "all"} } {
1824    if { $option == "update" } {
1825        set radius $_settings($this-spherescale)
1826    } elseif { [string is double $option] } {
1827        set radius $option
1828        if { ($radius < 0.1) || ($radius > 2.0) } {
1829            error "bad atom size \"$radius\""
1830        }
1831    } else {
1832        error "bad option \"$option\""
1833    }
1834    set _settings($this-spherescale) $radius
1835    if { $models == "all" } {
1836        SendCmd "spherescale -model all $radius"
1837        return
1838    }
1839    set overrideradius [expr $radius * 0.8]
1840    SendCmd "spherescale -model all $overrideradius"
1841    foreach model $models {
1842        if { [info exists _active($model)] } {
1843            SendCmd "spherescale -model $model $radius"
1844        }
1845    }
1846}
1847
1848# ----------------------------------------------------------------------
1849# USAGE: StickRadius radius ?models?
1850#        StickRadius update ?models?
1851#
1852# Used internally to change the stick radius used to render
1853# our scene.
1854#
1855# Note: Only sets the specified radius for active models.  If the model
1856#       is inactive, then it overridden with the value "0.25".
1857# ----------------------------------------------------------------------
1858itcl::body Rappture::MolvisViewer::StickRadius { option {models "all"} } {
1859    if { $option == "update" } {
1860        set radius $_settings($this-stickradius)
1861    } elseif { [string is double $option] } {
1862        set radius $option
1863        if { ($radius < 0.1) || ($radius > 2.0) } {
1864            error "bad stick radius \"$radius\""
1865        }
1866    } else {
1867        error "bad option \"$option\""
1868    }
1869    set _settings($this-stickradius) $radius
1870    if { $models == "all" } {
1871        SendCmd "stickradius -model all $radius"
1872        return
1873    }
1874    set overrideradius [expr $radius * 0.8]
1875    SendCmd "stickradius -model all $overrideradius"
1876    foreach model $models {
1877        if { [info exists _active($model)] } {
1878            SendCmd "stickradius -model $model $radius"
1879        }
1880    }
1881}
1882
1883# ----------------------------------------------------------------------
1884# USAGE: Opacity value ?models?
1885#        Opacity update ?models?
1886#
1887# Used internally to change the opacity (transparency) used to render
1888# our scene.
1889#
1890# Note: Only sets the specified transparency for active models.  If the model
1891#       is inactive, then it overridden with the value "0.75".
1892# ----------------------------------------------------------------------
1893itcl::body Rappture::MolvisViewer::Opacity { option } {
1894    array unset _imagecache
1895    if { $option == "update" } {
1896        set opacity $_settings($this-opacity)
1897    } elseif { [string is double $option] } {
1898        set opacity $option
1899        if { ($opacity < 0.0) || ($opacity > 1.0) } {
1900            error "bad opacity \"$opacity\""
1901        }
1902    } else {
1903        error "bad option \"$option\""
1904    }
1905    set _settings($this-opacity) $opacity
1906    set transparency [expr 1.0 - $opacity]
1907    set models [array names _active]
1908    if { [llength $models] == 0 } {
1909        SendCmd "transparency -model all $transparency"
1910        return
1911    }
1912    set overridetransparency 0.60
1913    SendCmd "transparency -model all $overridetransparency"
1914    foreach model $models {
1915        SendCmd "transparency -model $model $transparency"
1916    }
1917}
1918
1919# ----------------------------------------------------------------------
1920# USAGE: labels on|off|toggle
1921# USAGE: labels update
1922#
1923# Used internally to turn labels associated with atoms on/off, and to
1924# update the positions of the labels so they sit on top of each atom.
1925# ----------------------------------------------------------------------
1926itcl::body Rappture::MolvisViewer::labels {option {models "all"}} {
1927    set showlabels $_settings($this-showlabels)
1928    if { $option == "update" } {
1929        set showlabels $_settings($this-showlabels)
1930    } elseif { [string is boolean $option] } {
1931        set showlabels $option
1932    } else {
1933        error "bad option \"$option\""
1934    }
1935    # Clear the image cache
1936    array unset _imagecache
1937    set _settings($this-showlabels) $showlabels
1938    if { $models == "all" } {
1939        SendCmd "label -model all $showlabels"
1940        return
1941    }
1942    SendCmd "label -model all off"
1943    if { $showlabels } {
1944        foreach model $models {
1945            if { [info exists _active($model)] } {
1946                SendCmd "label -model $model $showlabels"
1947            }
1948        }
1949    }
1950}
1951
1952# ----------------------------------------------------------------------
1953# USAGE: CartoonTrace on|off|toggle
1954# USAGE: CartoonTrace update
1955#
1956# Used internally to turn labels associated with atoms on/off, and to
1957# update the positions of the labels so they sit on top of each atom.
1958# ----------------------------------------------------------------------
1959itcl::body Rappture::MolvisViewer::CartoonTrace {option {models "all"}} {
1960    array unset _imagecache
1961    set trace $_settings($this-cartoontrace)
1962    if { $option == "update" } {
1963        set trace $_settings($this-cartoontrace)
1964    } elseif { [string is boolean $option] } {
1965        set trace $option
1966    } else {
1967        error "bad option \"$option\""
1968    }
1969    set _settings($this-cartoontrace) $trace
1970    if { $models == "all" } {
1971        SendCmd "cartoontrace -model all $trace"
1972        return
1973    }
1974    SendCmd "cartoontrace -model all off"
1975    if { $trace } {
1976        foreach model $models {
1977            if { [info exists _active($model)] } {
1978                SendCmd "cartoontrace -model $model $trace"
1979            }
1980        }
1981    }
1982}
1983
1984itcl::body Rappture::MolvisViewer::AddImageControls { inner widget } {
1985    label $inner.size_l -text "Size:" -font "Arial 9"
1986    set _downloadPopup(image_controls) $inner
1987    set img $_image(plot)
1988    set res "[image width $img]x[image height $img]"
1989    Rappture::Combobox $inner.size -width 30 -editable no
1990    $inner.size choices insert end \
1991        "draft"  "Draft (400x400)"         \
1992        "standard"  "Standard (1200x1200)"          \
1993        "highquality"  "High Quality (2400x2400)"
1994
1995    label $inner.bgcolor_l -text "Background:" -font "Arial 9"
1996    Rappture::Combobox $inner.bgcolor -width 30 -editable no
1997    $inner.bgcolor choices insert end \
1998        "black"  "Black" \
1999        "white"  "White" \
2000        "none"  "Transparent (PNG only)"
2001
2002    label $inner.format_l -text "Format:" -font "Arial 9"
2003    Rappture::Combobox $inner.format -width 30 -editable no
2004    $inner.format choices insert end \
2005        "png"  "PNG (Portable Network Graphics format)" \
2006        "jpg"  "JPEG (Joint Photographic Experts Group format)" \
2007        "gif"  "GIF (GIF Graphics Interchange Format)"
2008
2009    set f [frame $inner.frame]
2010    button $f.ok -text "Save" \
2011        -highlightthickness 0 -pady 3 -padx 3 \
2012        -command [itcl::code $this SetWaitVariable 1] \
2013        -compound left \
2014        -image [Rappture::icon download
2015]
2016    button $f.cancel -text "Cancel" \
2017        -highlightthickness 0 -pady 3 -padx 3 \
2018        -command [itcl::code $this SetWaitVariable 0] \
2019        -compound left \
2020        -image [Rappture::icon cancel]
2021    blt::table $f \
2022        0,0 $f.ok  \
2023        0,1 $f.cancel
2024
2025    blt::table $inner \
2026        0,0 $inner.format_l -anchor e \
2027        0,1 $inner.format -anchor w -fill x  \
2028        1,0 $inner.size_l -anchor e \
2029        1,1 $inner.size -anchor w -fill x \
2030        2,0 $inner.bgcolor_l -anchor e \
2031        2,1 $inner.bgcolor -anchor w -fill x \
2032        3,0 $f -cspan 2 -fill x
2033    blt::table configure $inner r0 r1 r2 r3 -pady { 4 0 }
2034    blt::table configure $inner r3 -pady { 4 4 }
2035    $inner.bgcolor value "Black"
2036    $inner.size value "Draft (400x400)"
2037    $inner.format value  "PNG (Portable Network Graphics format)"
2038}
2039
2040itcl::body Rappture::MolvisViewer::snap { w h } {
2041    if { $w <= 0 || $h <= 0 } {
2042        set w [image width $_image(plot)]
2043        set h [image height $_image(plot)]
2044    }
2045    set tag "$_state(client),$_rocker(client)"
2046    if { $_image(id) != "$tag" } {
2047        while { ![info exists _imagecache($tag)] } {
2048            update idletasks
2049            update
2050            after 100
2051        }
2052        if { [info exists _imagecache($tag)] } {
2053            $_image(plot) configure -data $_imagecache($tag)
2054            set _image(id) "$tag"
2055        }
2056    }
2057    set img [image create picture -width $w -height $h]
2058    $img resample $_image(plot)
2059    return $img
2060}
2061
2062# FIXME: Handle 2D vectors
2063itcl::body Rappture::MolvisViewer::ComputeParallelepipedVertices { dataobj } {
2064    # Create a vector for every 3D point
2065    blt::vector point0(3) point1(3) point2(3) point3(3) point4(3) point5(3) \
2066        point6(3) point7(3) origin(3) scale(3)
2067
2068    set count 0
2069    set parent [$dataobj element -as object "components.parallelepiped"]
2070    foreach child [$parent children] {
2071        if { ![string match "vector*" $child] } {
2072            continue
2073        }
2074        incr count
2075        set values [$parent get $child]
2076        regexp -all {,} $values { } values
2077        point$count set $values
2078    }
2079    itcl::delete object $parent
2080    if { $count < 1 || $count > 3 } {
2081        error "bad number of vectors supplied to parallelepiped"
2082    }
2083    point0 set { 0.0 0.0 0.0 }
2084    point4 expr {point2 + point1}
2085    point5 expr {point4 + point3}
2086    point6 expr {point2 + point3}
2087    point7 expr {point1 + point3}
2088
2089    set values [$dataobj get components.parallelepiped.scale]
2090    set n [llength $values]
2091    scale set { 1.0 1.0 1.0 }
2092    if { $n == 1 } {
2093        set scale(0:2) [lindex $values 0]
2094    } elseif { $n == 2 } {
2095        set scale(0:1) [lindex $values 0]
2096    } elseif { $n == 3 } {
2097        scale set $values
2098    }
2099    set values [$dataobj get components.parallelepiped.origin]
2100    set n [llength $values]
2101    origin set { 0.0 0.0 0.0 }
2102    if { $n == 1 } {
2103        set origin(0) [lindex $values 0]
2104    } elseif { $n == 2 } {
2105        set origin(0) [lindex $values 0]
2106        set origin(1) [lindex $values 1]
2107    } elseif { $n == 3 } {
2108        origin set $values
2109    }
2110
2111    # Scale and translate points
2112    for { set i 0 } { $i < 8 } { incr i } {
2113        point${i} expr "(point${i} * scale) + origin"
2114    }
2115
2116    # Generate vertices as a string for PyMOL
2117    set vertices ""
2118    foreach n { 0 1 0 2 0 3 1 4 2 4 2 6 1 7 3 7 5 7 4 5 3 6 5 } {
2119        set values [point${n} range 0 end]
2120        append vertices "\[ [join $values {, }] \], \\\n"
2121    }
2122    set values [point6 range 0 end]
2123    append vertices "\[ [join $values {, }] \]  \\\n"
2124    blt::vector destroy point0 point1 point2 point3 point4 point5 point6 \
2125        point7 origin scale
2126    return $vertices
2127}
2128
2129# ----------------------------------------------------------------------
2130# OPTION: -device
2131# ----------------------------------------------------------------------
2132itcl::configbody Rappture::MolvisViewer::device {
2133    if {$itk_option(-device) != "" } {
2134        if {![Rappture::library isvalid $itk_option(-device)]} {
2135            error "bad value \"$itk_option(-device)\": should be Rappture::library object"
2136        }
2137        $this delete
2138        $this add $itk_option(-device)
2139    } else {
2140        $this delete
2141    }
2142
2143    if { [isconnected] } {
2144        $_dispatcher event -idle !rebuild
2145    }
2146}
Note: See TracBrowser for help on using the repository browser.