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

Last change on this file since 766 was 766, checked in by mmc, 17 years ago

Fixed the output viewer for numbers/integers to show a plot of
the value versus input parameters. As you change the ResultSet?
control, the x-axis updates to show the number versus values
in the result set.

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