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

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

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