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

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