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

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

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