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

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

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