source: trunk/gui/scripts/molvisviewer.tcl @ 5015

Last change on this file since 5015 was 5015, checked in by ldelgass, 6 years ago

whitespace

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