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

Last change on this file since 1215 was 1215, checked in by gah, 16 years ago

changes to allow panning and zooming (via scrollwhell)

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