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

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