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

Last change on this file since 1228 was 1228, checked in by gah, 15 years ago

Fixes for parallel makes
File size: 36.5 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
17package require Img
18
19option add *MolvisViewer.width 4i widgetDefault
20option add *MolvisViewer.height 4i widgetDefault
21option add *MolvisViewer.foreground black widgetDefault
22option add *MolvisViewer.controlBackground gray widgetDefault
23option add *MolvisViewer.controlDarkBackground #999999 widgetDefault
24option add *MolvisViewer.font -*-helvetica-medium-r-normal-*-12-* widgetDefault
25
26# must use this name -- plugs into Rappture::resources::load
27proc MolvisViewer_init_resources {} {
28    Rappture::resources::register \
29        molvis_server Rappture::MolvisViewer::SetServerList
30}
31
32set debug 0
33proc debug { args } {
34    global debug
35    if { $debug } {
36        puts stderr "[info level -1]: $args"
37    }
38}
39
40itcl::class Rappture::MolvisViewer {
41    inherit Rappture::VisViewer
42
43    itk_option define -device device Device ""
44
45    constructor { hostlist args } {
46        Rappture::VisViewer::constructor $hostlist
47    } {
48        # defined below
49    }
50    destructor {
51        # defined below
52    }
53    public proc SetServerList { namelist } {
54        Rappture::VisViewer::SetServerList "pymol" $namelist
55    }
56    public method Connect {}
57    public method Disconnect {}
58    public method isconnected {}
59    public method download {option args}
60
61    public method add {dataobj {options ""}}
62    public method get {}
63    public method delete {args}
64    public method parameters {title args} { # do nothing }
65
66    public method emblems {option}
67    public method rock {option}
68    public method representation {option {model "all"} }
69    public method ResetView {}
70
71    protected method _send {args}
72    protected method _update { args }
73    protected method _rebuild { }
74    protected method _zoom {option {factor 10}}
75    protected method _pan {option x y}
76    protected method _configure {w h}
77    protected method _unmap {}
78    protected method _map {}
79    protected method _vmouse2 {option b m x y}
80    protected method _vmouse  {option b m x y}
81    private method _receive_image { size cacheid frame rock }
82
83    private variable _inrebuild 0
84
85    private variable _mevent       ;# info used for mouse event operations
86    private variable _rocker       ;# info used for rock operations
87    private variable _dlist ""    ;# list of dataobj objects
88    private variable _dataobjs     ;# data objects on server
89    private variable _dobj2transparency  ;# maps dataobj => transparency
90    private variable _dobj2raise  ;# maps dataobj => raise flag 0/1
91    private variable _dobj2ghost
92
93    private variable view_
94
95    private variable _model
96    private variable _mlist
97    private variable _mrepresentation "ballnstick"
98
99    private variable _imagecache
100    private variable _state
101    private variable _labels  "default"
102    private variable _cacheid ""
103    private variable _cacheimage ""
104    private variable _busy 0
105
106    private variable delta1_ 10
107    private variable delta2_ 2
108
109    private common _settings  ;# array of settings for all known widgets
110}
111
112itk::usual MolvisViewer {
113    keep -background -foreground -cursor -font
114}
115
116# ----------------------------------------------------------------------
117# CONSTRUCTOR
118# ----------------------------------------------------------------------
119itcl::body Rappture::MolvisViewer::constructor {hostlist args} {
120    # Register events to the dispatcher.  Base class expects !rebuild
121    # event to be registered.
122
123    # Rebuild
124    $_dispatcher register !rebuild
125    $_dispatcher dispatch $this !rebuild "[itcl::code $this _rebuild]; list"
126    # Rocker
127    $_dispatcher register !rocker
128    $_dispatcher dispatch $this !rocker "[itcl::code $this rock step]; list"
129    # Mouse Event
130    $_dispatcher register !mevent
131    $_dispatcher dispatch $this !mevent "[itcl::code $this _mevent]; list"
132
133    # Populate the slave interpreter with commands to handle responses from
134    # the visualization server.
135    $_parser alias image [itcl::code $this _receive_image]
136
137    set _rocker(dir) 1
138    set _rocker(client) 0
139    set _rocker(server) 0
140    set _rocker(on) 0
141    set _state(server) 1
142    set _state(client) 1
143    set _hostlist $hostlist
144
145    array set view_ {
146        zoom 0
147        mx 0
148        my 0
149        mz 0
150        x  0
151        y  0
152        z  0
153    }
154
155    array set _settings [subst {
156        $this-model $_mrepresentation
157        $this-modelimg [Rappture::icon ballnstick]
158        $this-emblems 0
159        $this-rock 0
160    }]
161
162    #
163    # Set up the widgets in the main body
164    #
165    itk_component add zoom {
166        frame $itk_component(controls).zoom
167    } {
168        usual
169        rename -background -controlbackground controlBackground Background
170    }
171    pack $itk_component(zoom) -side top
172
173    itk_component add reset {
174        button $itk_component(zoom).reset \
175            -borderwidth 1 -padx 1 -pady 1 \
176            -bitmap [Rappture::icon reset] \
177            -command [itcl::code $this ResetView]
178    } {
179        usual
180        ignore -borderwidth
181        rename -highlightbackground -controlbackground controlBackground Background
182    }
183    pack $itk_component(reset) -side left -padx {4 1} -pady 4
184    Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
185
186    itk_component add zoomin {
187        button $itk_component(zoom).zin \
188            -borderwidth 1 -padx 1 -pady 1 \
189            -bitmap [Rappture::icon zoomin] \
190            -command [itcl::code $this _zoom in]
191    } {
192        usual
193        ignore -borderwidth
194        rename -highlightbackground -controlbackground controlBackground Background
195    }
196    pack $itk_component(zoomin) -side left -padx 1 -pady 4
197    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
198
199    itk_component add zoomout {
200        button $itk_component(zoom).zout \
201            -borderwidth 1 -padx 1 -pady 1 \
202            -bitmap [Rappture::icon zoomout] \
203            -command [itcl::code $this _zoom out]
204    } {
205        usual
206        ignore -borderwidth
207        rename -highlightbackground -controlbackground controlBackground Background
208    }
209    pack $itk_component(zoomout) -side left -padx {1 4} -pady 4
210
211    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
212
213    #
214    # Settings panel...
215    #
216    itk_component add settings {
217        button $itk_component(controls).settings -text "Settings..." \
218            -borderwidth 1 -relief flat -overrelief raised \
219            -padx 2 -pady 1 \
220            -command [list $itk_component(controls).panel activate $itk_component(controls).settings left]
221    } {
222        usual
223        ignore -borderwidth
224        rename -background -controlbackground controlBackground Background
225        rename -highlightbackground -controlbackground controlBackground Background
226    }
227    pack $itk_component(settings) -side top -pady {8 2}
228
229    Rappture::Balloon $itk_component(controls).panel -title "Rendering Options"
230    set inner [$itk_component(controls).panel component inner]
231    frame $inner.model
232    pack $inner.model -side top -fill x
233    set fg [option get $itk_component(hull) font Font]
234
235    label $inner.model.pict -image $_settings($this-modelimg)
236    pack $inner.model.pict -side left -anchor n
237    label $inner.model.heading -text "Method for drawing atoms:"
238    pack $inner.model.heading -side top -anchor w
239    radiobutton $inner.model.bstick -text "Balls and sticks" \
240        -command [itcl::code $this representation ballnstick all] \
241        -variable Rappture::MolvisViewer::_settings($this-model) \
242        -value ballnstick
243    pack $inner.model.bstick -side top -anchor w
244    radiobutton $inner.model.spheres -text "Spheres" \
245        -command [itcl::code $this representation spheres all] \
246        -variable Rappture::MolvisViewer::_settings($this-model) \
247        -value spheres
248    pack $inner.model.spheres -side top -anchor w
249    radiobutton $inner.model.lines -text "Lines" \
250        -command [itcl::code $this representation lines all] \
251        -variable Rappture::MolvisViewer::_settings($this-model) \
252        -value lines
253    pack $inner.model.lines -side top -anchor w
254
255    checkbutton $inner.labels -text "Show labels on atoms" \
256        -command [itcl::code $this emblems update] \
257        -variable Rappture::MolvisViewer::_settings($this-emblems)
258    pack $inner.labels -side top -anchor w -pady {4 1}
259
260    checkbutton $inner.rock -text "Rock model back and forth" \
261        -command [itcl::code $this rock toggle] \
262        -variable Rappture::MolvisViewer::_settings($this-rock)
263    pack $inner.rock -side top -anchor w -pady {1 4}
264
265    #
266    # Shortcuts
267    #
268    itk_component add shortcuts {
269        frame $itk_component(controls).shortcuts
270    } {
271        usual
272        rename -background -controlbackground controlBackground Background
273    }
274    pack $itk_component(shortcuts) -side top
275
276    itk_component add labels {
277        label $itk_component(shortcuts).labels \
278            -borderwidth 1 -padx 1 -pady 1 \
279            -relief "raised" -bitmap [Rappture::icon atoms]
280    } {
281        usual
282        ignore -borderwidth
283        rename -highlightbackground -controlbackground controlBackground Background
284    }
285    pack $itk_component(labels) -side left -padx {4 1} -pady 4 -ipadx 1 -ipady 1
286    Rappture::Tooltip::for $itk_component(labels) "Show/hide the labels on atoms"
287    bind $itk_component(labels) <ButtonPress> \
288        [itcl::code $this emblems toggle]
289
290    itk_component add rock {
291        label $itk_component(shortcuts).rock \
292            -borderwidth 1 -padx 1 -pady 1 \
293            -relief "raised" -bitmap [Rappture::icon rocker]
294    } {
295        usual
296        ignore -borderwidth
297        rename -highlightbackground -controlbackground controlBackground Background
298    }
299    pack $itk_component(rock) -side left -padx 1 -pady 4 -ipadx 1 -ipady 1
300    Rappture::Tooltip::for $itk_component(rock) "Rock model back and forth"
301
302    bind $itk_component(rock) <ButtonPress> \
303        [itcl::code $this rock toggle]
304
305    #
306    # RENDERING AREA
307    #
308
309    set _image(id) ""
310
311    # set up bindings for rotation
312    bind $itk_component(3dview) <ButtonPress-1> \
313        [itcl::code $this _vmouse click %b %s %x %y]
314    bind $itk_component(3dview) <B1-Motion> \
315        [itcl::code $this _vmouse drag 1 %s %x %y]
316    bind $itk_component(3dview) <ButtonRelease-1> \
317        [itcl::code $this _vmouse release %b %s %x %y]
318
319    bind $itk_component(3dview) <ButtonPress-2> \
320        [itcl::code $this _pan click %x %y]
321    bind $itk_component(3dview) <B2-Motion> \
322        [itcl::code $this _pan drag %x %y]
323    bind $itk_component(3dview) <ButtonRelease-2> \
324        [itcl::code $this _pan release %x %y]
325
326    bind $itk_component(3dview) <KeyPress-Left> \
327        [itcl::code $this _pan set -10 0]
328    bind $itk_component(3dview) <KeyPress-Right> \
329        [itcl::code $this _pan set 10 0]
330    bind $itk_component(3dview) <KeyPress-Up> \
331        [itcl::code $this _pan set 0 -10]
332    bind $itk_component(3dview) <KeyPress-Down> \
333        [itcl::code $this _pan set 0 10]
334    bind $itk_component(3dview) <Shift-KeyPress-Left> \
335        [itcl::code $this _pan set -2 0]
336    bind $itk_component(3dview) <Shift-KeyPress-Right> \
337        [itcl::code $this _pan set 2 0]
338    bind $itk_component(3dview) <Shift-KeyPress-Up> \
339        [itcl::code $this _pan set 0 -2]
340    bind $itk_component(3dview) <Shift-KeyPress-Down> \
341        [itcl::code $this _pan set 0 2]
342    bind $itk_component(3dview) <KeyPress-Prior> \
343        [itcl::code $this _zoom out 2]
344    bind $itk_component(3dview) <KeyPress-Next> \
345        [itcl::code $this _zoom in 2]
346
347    bind $itk_component(3dview) <Enter> "focus $itk_component(3dview)"
348
349
350    if {[string equal "x11" [tk windowingsystem]]} {
351        bind $itk_component(3dview) <4> [itcl::code $this _zoom out 2]
352        bind $itk_component(3dview) <5> [itcl::code $this _zoom in 2]
353    }
354
355    # set up bindings to bridge mouse events to server
356    #bind $itk_component(3dview) <ButtonPress> \
357    #   [itcl::code $this _vmouse2 click %b %s %x %y]
358    #bind $itk_component(3dview) <ButtonRelease> \
359    #    [itcl::code $this _vmouse2 release %b %s %x %y]
360    #bind $itk_component(3dview) <B1-Motion> \
361    #    [itcl::code $this _vmouse2 drag 1 %s %x %y]
362    #bind $itk_component(3dview) <B2-Motion> \
363    #    [itcl::code $this _vmouse2 drag 2 %s %x %y]
364    #bind $itk_component(3dview) <B3-Motion> \
365    #    [itcl::code $this _vmouse2 drag 3 %s %x %y]
366    #bind $itk_component(3dview) <Motion> \
367    #    [itcl::code $this _vmouse2 move 0 %s %x %y]
368
369    bind $itk_component(3dview) <Configure> \
370        [itcl::code $this _configure %w %h]
371    bind $itk_component(3dview) <Unmap> \
372        [itcl::code $this _unmap]
373    bind $itk_component(3dview) <Map> \
374        [itcl::code $this _map]
375
376    eval itk_initialize $args
377    Connect
378}
379
380# ----------------------------------------------------------------------
381# DESTRUCTOR
382# ----------------------------------------------------------------------
383itcl::body Rappture::MolvisViewer::destructor {} {
384    VisViewer::Disconnect
385
386    image delete $_image(plot)
387    array unset _settings $this-*
388}
389
390# ----------------------------------------------------------------------
391# USAGE: download coming
392# USAGE: download controls <downloadCommand>
393# USAGE: download now
394#
395# Clients use this method to create a downloadable representation
396# of the plot.  Returns a list of the form {ext string}, where
397# "ext" is the file extension (indicating the type of data) and
398# "string" is the data itself.
399# ----------------------------------------------------------------------
400itcl::body Rappture::MolvisViewer::download {option args} {
401    switch $option {
402        coming {}
403        controls {}
404        now {
405            return [list .jpg [Rappture::encoding::decode -as b64 [$_image(plot) data -format jpeg]]]
406        }
407        default {
408            error "bad option \"$option\": should be coming, controls, now"
409        }
410    }
411}
412
413#
414# isconnected --
415#
416#       Indicates if we are currently connected to the visualization server.
417#
418itcl::body Rappture::MolvisViewer::isconnected {} {
419    return [VisViewer::IsConnected]
420}
421
422
423#
424# Connect --
425#
426#       Establishes a connection to a new visualization server.
427#
428itcl::body Rappture::MolvisViewer::Connect {} {
429    #$_image(plot) blank
430    set hosts [GetServerList "pymol"]
431    if { "" == $hosts } {
432        return 0
433    }
434    set result [VisViewer::Connect $hosts]
435    if { $result } {
436        set _rocker(server) 0
437        set _cacheid 0
438        _send "raw -defer {set auto_color,0}"
439        _send "raw -defer {set auto_show_lines,0}"
440    }
441    return $result
442}
443
444#
445# Disconnect --
446#
447#       Clients use this method to disconnect from the current rendering
448#       server.
449#
450itcl::body Rappture::MolvisViewer::Disconnect {} {
451    VisViewer::Disconnect
452
453    # disconnected -- no more data sitting on server
454    catch { after cancel $_rocker(afterid) }
455    catch { after cancel $_mevent(afterid) }
456    array unset _dataobjs
457    array unset _model
458    array unset _mlist
459    array unset _imagecache
460
461    set _state(server) 1
462    set _state(client) 1
463    set _outbuf ""
464}
465
466itcl::body Rappture::MolvisViewer::_send { args } {
467    if { $_state(server) != $_state(client) } {
468        if { ![SendBytes "frame -defer $_state(client)"] } {
469            set _state(server) $_state(client)
470        }
471    }
472
473    if { $_rocker(server) != $_rocker(client) } {
474        if { ![SendBytes "rock -defer $_rocker(client)"] } {
475            set _rocker(server) $_rocker(client)
476        }
477    }
478    eval SendBytes $args
479}
480
481#
482# _receive_image -bytes <size>
483#
484#     Invoked automatically whenever the "image" command comes in from
485#     the rendering server.  Indicates that binary image data with the
486#     specified <size> will follow.
487#
488itcl::body Rappture::MolvisViewer::_receive_image { size cacheid frame rock } {
489    set tag "$frame,$rock"
490    if { $cacheid != $_cacheid } {
491        array unset _imagecache
492        set _cacheid $cacheid
493    }
494    set _imagecache($tag) [ReceiveBytes $size]
495 
496    #puts stderr "CACHED: $tag,$cacheid"
497    $_image(plot) configure -data $_imagecache($tag)
498    set _image(id) $tag
499}
500
501
502# ----------------------------------------------------------------------
503# USAGE: _rebuild
504#
505# Called automatically whenever something changes that affects the
506# data in the widget.  Clears any existing data and rebuilds the
507# widget to display new data.
508# ----------------------------------------------------------------------
509itcl::body Rappture::MolvisViewer::_rebuild {} {
510    if { $_inrebuild } {
511        # don't allow overlapping rebuild calls
512        return
513    }
514
515    #set _inrebuild 1
516    set changed 0
517    set _busy 1
518
519    $itk_component(3dview) configure -cursor watch
520
521    # refresh GUI (primarily to make pending cursor changes visible)
522    update idletasks
523    set dlist [get]
524    foreach dev $dlist {
525        set model [$dev get components.molecule.model]
526        set state [$dev get components.molecule.state]
527       
528        if {"" == $model } {
529            set model "molecule"
530            scan $dev "::libraryObj%d" suffix
531            set model $model$suffix
532        }
533
534        if {"" == $state} { set state $_state(server) }
535
536        if { ![info exists _mlist($model)] } { # new, turn on
537            set _mlist($model) 2
538        } elseif { $_mlist($model) == 1 } { # on, leave on
539            set _mlist($model) 3
540        } elseif { $_mlist($model) == 0 } { # off, turn on
541            set _mlist($model) 2
542        }
543        if { ![info exists _dataobjs($model-$state)] } {
544            set data1      ""
545            set serial   0
546
547            foreach _atom [$dev children -type atom components.molecule] {
548                set symbol [$dev get components.molecule.$_atom.symbol]
549                set xyz [$dev get components.molecule.$_atom.xyz]
550                regsub {,} $xyz {} xyz
551                scan $xyz "%f %f %f" x y z
552                set recname  "ATOM  "
553                set altLoc   ""
554                set resName  ""
555                set chainID  ""
556                set Seqno    ""
557                set occupancy  1
558                set tempFactor 0
559                set recID      ""
560                set segID      ""
561                set element    ""
562                set charge     ""
563                set atom $symbol
564                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]
565                append data1 $line
566                incr serial
567            }
568            set data2 [$dev get components.molecule.pdb]
569            if {"" != $data1} {
570                _send "loadpdb -defer \"$data1\" $model $state"
571                set _dataobjs($model-$state)  1
572            }
573            if {"" != $data2} {
574                _send "loadpdb -defer \"$data2\" $model $state"
575                set _dataobjs($model-$state)  1
576            }
577        }
578        if { ![info exists _model($model-transparency)] } {
579            set _model($model-transparency) "undefined"
580        }
581        if { ![info exists _model($model-representation)] } {
582            set _model($model-representation) "undefined"
583            set _model($model-newrepresentation) $_mrepresentation
584        }
585        if { $_model($model-transparency) != $_dobj2transparency($dev) } {
586            set _model($model-newtransparency) $_dobj2transparency($dev)
587        }
588    }
589
590    # enable/disable models as required (0=off->off, 1=on->off, 2=off->on,
591    # 3=on->on)
592
593    foreach obj [array names _mlist] {
594        if { $_mlist($obj) == 1 } {
595            _send "disable -defer $obj"
596            set _mlist($obj) 0
597            set changed 1
598        } elseif { $_mlist($obj) == 2 } {
599            set _mlist($obj) 1
600            _send "enable -defer $obj"
601            if { $_labels } {
602                _send "label -defer on"
603            } else {
604                _send "label -defer off"
605            }
606            set changed 1
607        } elseif { $_mlist($obj) == 3 } {
608            set _mlist($obj) 1
609        }
610
611        if { $_mlist($obj) == 1 } {
612            if {  [info exists _model($obj-newtransparency)] ||
613                  [info exists _model($obj-newrepresentation)] } {
614                if { ![info exists _model($obj-newrepresentation)] } {
615                    set _model($obj-newrepresentation) $_model($obj-representation)
616                }
617                if { ![info exists _model($obj-newtransparency)] } {
618                    set _model($obj-newtransparency) $_model($obj-transparency)
619                }
620                set rep $_model($obj-newrepresentation)
621                set transp $_model($obj-newtransparency)
622                _send "$_model($obj-newrepresentation) -defer -model $obj -$_model($obj-newtransparency)"
623                set changed 1
624                set _model($obj-transparency) $_model($obj-newtransparency)
625                set _model($obj-representation) $_model($obj-newrepresentation)
626                catch {
627                    unset _model($obj-newtransparency)
628                    unset _model($obj-newrepresentation)
629                }
630            }
631        }
632
633    }
634
635    if { $changed } {
636        array unset _imagecache
637    }
638    if { $dlist == "" } {
639        set _state(server) 1
640        set _state(client) 1
641        _send "frame -push 1"
642    } elseif { ![info exists _imagecache($state,$_rocker(client))] } {
643        set _state(server) $state
644        set _state(client) $state
645        _send "frame -push $state"
646    } else {
647        set _state(client) $state
648        _update
649    }
650    # Reset screen size
651    set w  [winfo width $itk_component(3dview)]
652    set h  [winfo height $itk_component(3dview)]
653    _send "screen $w $h"
654    # Reset viewing parameters
655    _send "reset"
656    _send "rotate $view_(mx) $view_(my) $view_(mz)"
657    _send "pan $view_(x) $view_(y)"
658    _send "zoom $view_(zoom)"
659
660    set _inrebuild 0
661    $itk_component(3dview) configure -cursor ""
662}
663
664itcl::body Rappture::MolvisViewer::_unmap { } {
665    #pause rocking loop while unmapped (saves CPU time)
666    rock pause
667
668    # Blank image, mark current image dirty
669    # This will force reload from cache, or remain blank if cache is cleared
670    # This prevents old image from briefly appearing when a new result is added
671    # by result viewer
672
673    #$_image(plot) blank
674    set _image(id) ""
675}
676
677itcl::body Rappture::MolvisViewer::_map { } {
678    if { [isconnected] } {
679        # resume rocking loop if it was on
680        rock unpause
681        # rebuild image if modified, or redisplay cached image if not
682        $_dispatcher event -idle !rebuild
683    }
684}
685
686itcl::body Rappture::MolvisViewer::_configure { w h } {
687    $_image(plot) configure -width $w -height $h
688    # immediately invalidate cache, defer update until mapped
689    array unset _imagecache
690    if { [isconnected] } {
691        if { [winfo ismapped $itk_component(3dview)] } {
692            _send "screen $w $h"
693            # Why do a reset?
694            #_send "reset -push"
695        } else {
696            _send "screen -defer $w $h"
697            # Why do a reset?
698            #_send "reset -push"
699        }
700    }
701}
702
703# ----------------------------------------------------------------------
704# USAGE: $this _pan click x y
705#        $this _pan drag x y
706#        $this _pan release x y
707#
708# Called automatically when the user clicks on one of the zoom
709# controls for this widget.  Changes the zoom for the current view.
710# ----------------------------------------------------------------------
711itcl::body Rappture::MolvisViewer::_pan {option x y} {
712    if { $option == "set" } {
713        set dx $x
714        set dy $y
715        set view_(x) [expr $view_(x) + $dx]
716        set view_(y) [expr $view_(y) + $dy]
717        _send "pan $dx $dy"
718        return
719    }
720    if { ![info exists _mevent(x)] } {
721        set option "click"
722    }
723    if { $option == "click" } {
724        $itk_component(3dview) configure -cursor hand1
725    }
726    if { $option == "drag" || $option == "release" } {
727        set dx [expr $x - $_mevent(x)]
728        set dy [expr $y - $_mevent(y)]
729        set view_(x) [expr $view_(x) + $dx]
730        set view_(y) [expr $view_(y) + $dy]
731        _send "pan $dx $dy"
732    }
733    set _mevent(x) $x
734    set _mevent(y) $y
735    if { $option == "release" } {
736        $itk_component(3dview) configure -cursor ""
737    }
738}
739
740# ----------------------------------------------------------------------
741# USAGE: _zoom in
742# USAGE: _zoom out
743# USAGE: _zoom reset
744#
745# Called automatically when the user clicks on one of the zoom
746# controls for this widget.  Changes the zoom for the current view.
747# ----------------------------------------------------------------------
748itcl::body Rappture::MolvisViewer::_zoom {option {factor 10}} {
749    switch -- $option {
750        "in" {
751            set view_(zoom) [expr $view_(zoom) + $factor]
752            _send "zoom $factor"
753        }
754        "out" {
755            set view_(zoom) [expr $view_(zoom) - $factor]
756            _send "zoom -$factor"
757        }
758        "reset" {
759            set view_(zoom) 0
760            _send "reset"
761        }
762    }
763}
764
765itcl::body Rappture::MolvisViewer::_update { args } {
766    set tag "$_state(client),$_rocker(client)"
767    if { $_image(id) != "$tag" } {
768        if { [info exists _imagecache($tag)] } {
769            #puts stderr "DISPLAYING CACHED IMAGE"
770            $_image(plot) configure -data $_imagecache($tag)
771            set _image(id) "$tag"
772        }
773    }
774}
775
776# ----------------------------------------------------------------------
777# USAGE: rock on|off|toggle
778# USAGE: rock pause|unpause|step
779#
780# Used to control the "rocking" model for the molecule being displayed.
781# Clients should use only the on/off/toggle options; the rest are for
782# internal control of the rocking motion.
783# ----------------------------------------------------------------------
784itcl::body Rappture::MolvisViewer::rock { option } {
785    # cancel any pending rocks
786    if { [info exists _rocker(afterid)] } {
787        after cancel $_rocker(afterid)
788        unset _rocker(afterid)
789    }
790
791    if { $option == "toggle" } {
792        if { $_rocker(on) } {
793            set option "off"
794        } else {
795            set option "on"
796        }
797    }
798    if { $option == "on" || ($option == "toggle" && !$_rocker(on)) } {
799        set _rocker(on) 1
800        set _settings($this-rock) 1
801        $itk_component(rock) configure -relief sunken
802    } elseif { $option == "off" || ($option == "toggle" && $_rocker(on)) } {
803        set _rocker(on) 0
804        set _settings($this-rock) 0
805        $itk_component(rock) configure -relief raised
806    } elseif { $option == "step"} {
807        if { $_rocker(client) >= 10 } {
808            set _rocker(dir) -1
809        } elseif { $_rocker(client) <= -10 } {
810            set _rocker(dir) 1
811        }
812        set _rocker(client) [expr {$_rocker(client) + $_rocker(dir)}]
813        if { ![info exists _imagecache($_state(server),$_rocker(client))] } {
814            set _rocker(server) $_rocker(client)
815            _send "rock $_rocker(client)"
816        }
817        _update
818    }
819    if { $_rocker(on) && $option != "pause" } {
820         set _rocker(afterid) [after 200 [itcl::code $this rock step]]
821    }
822}
823
824itcl::body Rappture::MolvisViewer::_vmouse2 {option b m x y} {
825    set now [clock clicks -milliseconds]
826    set vButton [expr $b - 1]
827    set vModifier 0
828    set vState 1
829
830    if { $m & 1 }      { set vModifier [expr $vModifier | 1 ] }
831    if { $m & 4 }      { set vModifier [expr $vModifier | 2 ] }
832    if { $m & 131072 } { set vModifier [expr $vModifier | 4 ] }
833
834    if { $option == "click"   } { set vState 0 }
835    if { $option == "release" } { set vState 1 }
836    if { $option == "drag"    } { set vState 2 }
837    if { $option == "move"    } { set vState 3 }
838
839    if { $vState == 2 || $vState == 3} {
840        set diff 0
841
842        catch { set diff [expr $now - $_mevent(time)] }
843        if {$diff < 75} { # 75ms between motion updates
844            return
845        }
846    }
847    _send "vmouse $vButton $vModifier $vState $x $y"
848    set _mevent(time) $now
849}
850
851itcl::body Rappture::MolvisViewer::_vmouse {option b m x y} {
852    set now  [clock clicks -milliseconds]
853    # cancel any pending delayed dragging events
854    if { [info exists _mevent(afterid)] } {
855        after cancel $_mevent(afterid)
856        unset _mevent(afterid)
857    }
858
859    if { ![info exists _mevent(x)] } {
860        set option "click"
861    }
862    if { $option == "click" } {
863        $itk_component(3dview) configure -cursor fleur
864    }
865    if { $option == "drag" || $option == "release" } {
866        set diff 0
867        catch { set diff [expr $now - $_mevent(time) ] }
868        if {$diff < 75 && $option == "drag" } { # 75ms between motion updates
869            set _mevent(afterid) [after [expr 75 - $diff] [itcl::code $this _vmouse drag $b $m $x $y]]
870            return
871        }
872        set w [winfo width $itk_component(3dview)]
873        set h [winfo height $itk_component(3dview)]
874        if {$w <= 0 || $h <= 0} {
875            return
876        }
877        set x1 [expr $w / 3]
878        set x2 [expr $x1 * 2]
879        set y1 [expr $h / 3]
880        set y2 [expr $y1 * 2]
881        set dx [expr $x - $_mevent(x)]
882        set dy [expr $y - $_mevent(y)]
883        set mx 0
884        set my 0
885        set mz 0
886
887        if { $_mevent(x) < $x1 } {
888            set mz $dy
889        } elseif { $_mevent(x) < $x2 } {
890            set mx $dy
891        } else {
892            set mz [expr -$dy]
893        }
894
895        if { $_mevent(y) < $y1 } {
896            set mz [expr -$dx]
897        } elseif { $_mevent(y) < $y2 } {
898            set my $dx
899        } else {
900            set mz $dx
901        }
902        # Accumlate movements
903        set view_(mx) [expr {$view_(mx) + $mx}]
904        set view_(my) [expr {$view_(my) + $my}]
905        set view_(mz) [expr {$view_(mz) + $mz}]
906        _send "rotate $mx $my $mz"
907    }
908    set _mevent(x) $x
909    set _mevent(y) $y
910    set _mevent(time) $now
911    if { $option == "release" } {
912        $itk_component(3dview) configure -cursor ""
913    }
914}
915
916# ----------------------------------------------------------------------
917# USAGE: representation spheres
918# USAGE: representation ballnstick
919# USAGE: representation lines
920#
921# Used internally to change the molecular representation used to render
922# our scene.
923# ----------------------------------------------------------------------
924itcl::body Rappture::MolvisViewer::representation {option {model "all"} } {
925    if { $option == $_mrepresentation } {
926        return
927    }
928    set _settings($this-modelimg) [Rappture::icon $option]
929    set inner [$itk_component(controls).panel component inner]
930    $inner.model.pict configure -image $_settings($this-modelimg)
931
932    # Save the current option to set all radiobuttons -- just in case.
933    # This method gets called without the user clicking on a radiobutton.
934    set _settings($this-model) $option
935    set _mrepresentation $option
936
937    if { $model == "all" } {
938        set models [array names _mlist]
939    } else {
940        set models $model
941    }
942    foreach obj $models {
943        if { [info exists _model($obj-representation)] } {
944            if { $_model($obj-representation) != $option } {
945                set _model($obj-newrepresentation) $option
946            } else {
947                catch { unset _model($obj-newrepresentation) }
948            }
949        }
950    }
951    if { [isconnected] } {
952        $_dispatcher event -idle !rebuild
953    }
954}
955
956# ----------------------------------------------------------------------
957# USAGE: emblems on|off|toggle
958# USAGE: emblems update
959#
960# Used internally to turn labels associated with atoms on/off, and to
961# update the positions of the labels so they sit on top of each atom.
962# ----------------------------------------------------------------------
963itcl::body Rappture::MolvisViewer::emblems {option} {
964    switch -- $option {
965        on {
966            set emblem 1
967        }
968        off {
969            set emblem 0
970        }
971        toggle {
972            if {$_settings($this-emblems)} {
973                set emblem 0
974            } else {
975                set emblem 1
976            }
977        }
978        update {
979            set emblem $_settings($this-emblems)
980        }
981        default {
982            error "bad option \"$option\": should be on, off, toggle, or update"
983        }
984    }
985    set _labels $emblem
986    if {$emblem == $_settings($this-emblems) && $option != "update"} {
987        # nothing to do
988        return
989    }
990
991    if {$emblem} {
992        $itk_component(labels) configure -relief sunken
993        set _settings($this-emblems) 1
994        _send "label on"
995    } else {
996        $itk_component(labels) configure -relief raised
997        set _settings($this-emblems) 0
998        _send "label off"
999    }
1000}
1001
1002# ----------------------------------------------------------------------
1003# USAGE: add <dataobj> ?<settings>?
1004#
1005# Clients use this to add a data object to the plot.  The optional
1006# <settings> are used to configure the plot.  Allowed settings are
1007# -color, -brightness, -width, -linestyle, and -raise. Only
1008# -brightness and -raise do anything.
1009# ----------------------------------------------------------------------
1010itcl::body Rappture::MolvisViewer::add { dataobj {options ""}} {
1011    array set params {
1012        -color          auto
1013        -brightness     0
1014        -width          1
1015        -raise          0
1016        -linestyle      solid
1017        -description    ""
1018        -param          ""
1019    }
1020
1021    foreach {opt val} $options {
1022        if {![info exists params($opt)]} {
1023            error "bad settings \"$opt\": should be [join [lsort [array names params]] {, }]"
1024        }
1025        set params($opt) $val
1026    }
1027 
1028    set pos [lsearch -exact $dataobj $_dlist]
1029
1030    if {$pos < 0} {
1031        if {![Rappture::library isvalid $dataobj]} {
1032            error "bad value \"$dataobj\": should be Rappture::library object"
1033        }
1034   
1035        if { $_labels == "default" } {
1036            set emblem [$dataobj get components.molecule.about.emblems]
1037
1038            if {$emblem == "" || ![string is boolean $emblem] || !$emblem} {
1039                emblems off
1040            } else {
1041                emblems on
1042            }
1043        }
1044
1045        lappend _dlist $dataobj
1046        if { $params(-brightness) >= 0.5 } {
1047            set _dobj2transparency($dataobj) "ghost"
1048        } else {
1049            set _dobj2transparency($dataobj) "normal"
1050        }
1051        set _dobj2raise($dataobj) $params(-raise)
1052
1053        if { [isconnected] } {
1054            $_dispatcher event -idle !rebuild
1055        }
1056    }
1057}
1058
1059#
1060# ResetView
1061#
1062itcl::body Rappture::MolvisViewer::ResetView {} {
1063    array set view_ {
1064        mx 0
1065        my 0
1066        mz 0
1067        x 0
1068        y 0
1069        z 0
1070        zoom 0
1071    }
1072    _send "reset"
1073}
1074
1075# ----------------------------------------------------------------------
1076# USAGE: get
1077#
1078# Clients use this to query the list of objects being plotted, in
1079# order from bottom to top of this result.
1080# ----------------------------------------------------------------------
1081itcl::body Rappture::MolvisViewer::get {} {
1082    # put the dataobj list in order according to -raise options
1083    set dlist $_dlist
1084    foreach obj $dlist {
1085        if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
1086            set i [lsearch -exact $dlist $obj]
1087            if {$i >= 0} {
1088                set dlist [lreplace $dlist $i $i]
1089                lappend dlist $obj
1090            }
1091        }
1092    }
1093    return $dlist
1094}
1095
1096# ----------------------------------------------------------------------
1097# USAGE: delete ?<dataobj> <dataobj> ...?
1098#
1099# Clients use this to delete a dataobj from the plot. If no dataobjs
1100# are specified, then all dataobjs are deleted.
1101# ----------------------------------------------------------------------
1102itcl::body Rappture::MolvisViewer::delete {args} {
1103    if {[llength $args] == 0} {
1104        set args $_dlist
1105    }
1106
1107    # delete all specified dataobjs
1108    set changed 0
1109    foreach dataobj $args {
1110        set pos [lsearch -exact $_dlist $dataobj]
1111        if {$pos >= 0} {
1112            set _dlist [lreplace $_dlist $pos $pos]
1113            catch {unset _dobj2transparency($dataobj)}
1114            catch {unset _dobj2color($dataobj)}
1115            catch {unset _dobj2width($dataobj)}
1116            catch {unset _dobj2dashes($dataobj)}
1117            catch {unset _dobj2raise($dataobj)}
1118            set changed 1
1119        }
1120    }
1121
1122    # if anything changed, then rebuild the plot
1123    if {$changed} {
1124        if { [isconnected] } {
1125            $_dispatcher event -idle !rebuild
1126        }
1127    }
1128}
1129
1130# ----------------------------------------------------------------------
1131# OPTION: -device
1132# ----------------------------------------------------------------------
1133itcl::configbody Rappture::MolvisViewer::device {
1134    if {$itk_option(-device) != "" } {
1135
1136        if {![Rappture::library isvalid $itk_option(-device)]} {
1137            error "bad value \"$itk_option(-device)\": should be Rappture::library object"
1138        }
1139        $this delete
1140        $this add $itk_option(-device)
1141    } else {
1142        $this delete
1143    }
1144
1145    if { [isconnected] } {
1146        $_dispatcher event -idle !rebuild
1147    }
1148}
1149
Note: See TracBrowser for help on using the repository browser.