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

Last change on this file since 697 was 697, checked in by nkissebe, 17 years ago

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