source: branches/blt4/gui/scripts/molvisviewer.tcl @ 1807

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