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

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

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