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

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