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

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

molvisviewer.tcl: beta2 of molvisviewer
File size: 30.3 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-*-*-120-* 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    public method emblems {option}
32    public method representation {option}
33
34    public method connect {{hostlist ""}}
35    public method disconnect {}
36    public method isconnected {}
37    public method download {option args}
38    protected method _rock {option}
39    protected method _send {args}
40    protected method _receive {}
41    protected method _update { args }
42    protected method _rebuild {}
43    protected method _zoom {option}
44    protected method _vmouse2 {option b m x y}
45    protected method _vmouse  {option b m x y}
46    protected method _serverDown {}
47    protected method _decodeb64 { arg }
48
49    private variable _base64 ""
50    private variable _dispatcher "" ;# dispatcher for !events
51    private variable _sid ""       ;# socket connection to nanovis server
52    private variable _image        ;# image displayed in plotting area
53
54    private variable _mevent       ;# info used for mouse event operations
55    private variable _rocker       ;# info used for rock operations
56
57
58    private variable _dataobjs     ;# data objects on server
59    private variable _imagecache
60    private variable _state 1
61    private variable _cacheid ""
62    private variable _hostlist ""
63    private variable _model ""
64    private variable _mrepresentation "spheres"
65    private variable _cacheimage ""
66}
67
68itk::usual MolvisViewer {
69    keep -background -foreground -cursor -font
70}
71
72# ----------------------------------------------------------------------
73# CONSTRUCTOR
74# ----------------------------------------------------------------------
75itcl::body Rappture::MolvisViewer::constructor {hostlist args} {
76    #puts stderr "MolvisViewer::_constructor()"
77
78    set _rocker(dir) 1
79    set _rocker(x) 0
80    set _rocker(on) 0
81
82    Rappture::dispatcher _dispatcher
83    $_dispatcher register !serverDown
84    $_dispatcher dispatch $this !serverDown "[itcl::code $this _serverDown]; list"
85    #
86    # Set up the widgets in the main body
87    #
88    option add hull.width hull.height
89    pack propagate $itk_component(hull) no
90
91    itk_component add left_controls {
92        frame $itk_interior.l_cntls
93        } {
94        usual
95        rename -background -controlbackground controlBackground Background
96        }
97    pack $itk_component(left_controls) -side left -fill y
98
99    itk_component add show_ball_and_stick {
100            button $itk_component(left_controls).sbs \
101            -borderwidth 2 -padx 0 -pady 0 \
102            -image [Rappture::icon ballnstick] \
103            -command [itcl::code $this representation ball-and-stick]
104    } {
105        usual
106        ignore -borderwidth
107        rename -highlightbackground -controlbackground controlBackground Background
108    }
109    pack $itk_component(show_ball_and_stick) -padx 4 -pady 4
110
111    itk_component add show_spheres {
112            button $itk_component(left_controls).ss \
113            -borderwidth 1 -padx 1 -pady 1 \
114            -image [Rappture::icon spheres] \
115            -command [itcl::code $this representation spheres]
116    } {
117        usual
118        ignore -borderwidth
119        rename -highlightbackground -controlbackground controlBackground Background
120    }
121    pack $itk_component(show_spheres) -padx 4 -pady 4
122
123    itk_component add show_lines {
124            button $itk_component(left_controls).sl \
125            -borderwidth 1 -padx 1 -pady 1 \
126            -image [Rappture::icon lines] \
127            -command [itcl::code $this representation lines]
128    } {
129        usual
130        ignore -borderwidth
131        rename -highlightbackground -controlbackground controlBackground Background
132    }
133    pack $itk_component(show_lines) -padx 4 -pady 4
134
135    itk_component add controls {
136        frame $itk_interior.cntls
137    } {
138        usual
139        rename -background -controlbackground controlBackground Background
140    }
141    pack $itk_component(controls) -side right -fill y
142
143    itk_component add reset {
144        button $itk_component(controls).reset \
145            -borderwidth 1 -padx 1 -pady 1 \
146            -bitmap [Rappture::icon reset] \
147            -command [itcl::code $this _send reset]
148    } {
149        usual
150        ignore -borderwidth
151        rename -highlightbackground -controlbackground controlBackground Background
152    }
153    pack $itk_component(reset) -padx 4 -pady 4
154    Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
155
156    itk_component add zoomin {
157        button $itk_component(controls).zin \
158            -borderwidth 1 -padx 1 -pady 1 \
159            -bitmap [Rappture::icon zoomin] \
160            -command [itcl::code $this _zoom in]
161    } {
162        usual
163        ignore -borderwidth
164        rename -highlightbackground -controlbackground controlBackground Background
165    }
166    pack $itk_component(zoomin) -padx 4 -pady 4
167    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
168
169    itk_component add zoomout {
170        button $itk_component(controls).zout \
171            -borderwidth 1 -padx 1 -pady 1 \
172            -bitmap [Rappture::icon zoomout] \
173            -command [itcl::code $this _zoom out]
174    } {
175        usual
176        ignore -borderwidth
177        rename -highlightbackground -controlbackground controlBackground Background
178    }
179    pack $itk_component(zoomout) -padx 4 -pady 4
180    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
181
182    itk_component add labels {
183        label $itk_component(controls).labels \
184            -borderwidth 1 -padx 1 -pady 1 \
185            -bitmap [Rappture::icon atoms]
186    } {
187        usual
188        ignore -borderwidth
189        rename -highlightbackground -controlbackground controlBackground Background
190    }
191    pack $itk_component(labels) -padx 4 -pady 8 -ipadx 1 -ipady 1
192    Rappture::Tooltip::for $itk_component(labels) "Show/hide the labels on atoms"
193    bind $itk_component(labels) <ButtonPress> \
194        [itcl::code $this emblems toggle]
195
196    itk_component add rock {
197        label $itk_component(controls).rock \
198            -borderwidth 1 -padx 1 -pady 1 \
199            -relief "raised" -text "R" \
200    } {
201        usual
202        ignore -borderwidth
203        rename -highlightbackground -controlbackground controlBackground Background
204    }
205    pack $itk_component(rock) -padx 4 -pady 8 -ipadx 1 -ipady 1
206    Rappture::Tooltip::for $itk_component(rock) "Rock model +/- 10 degrees"
207
208    bind $itk_component(rock) <ButtonPress> \
209        [itcl::code $this _rock toggle]
210
211    #
212    # RENDERING AREA
213    #
214
215    itk_component add area {
216        frame $itk_interior.area
217    }
218    pack $itk_component(area) -expand yes -fill both
219
220    set _image(plot) [image create photo]
221    set _image(id) ""
222
223    itk_component add 3dview {
224        label $itk_component(area).vol -image $_image(plot) \
225            -highlightthickness 0
226    } {
227        usual
228        ignore -highlightthickness
229    }
230    pack $itk_component(3dview) -expand yes -fill both
231
232    # set up bindings for rotation
233    #bind $itk_component(3dview) <ButtonPress> \
234    #    [itcl::code $this _vmouse click %b %s %x %y]
235    #bind $itk_component(3dview) <B1-Motion> \
236    #    [itcl::code $this _vmouse drag 1 %s %x %y]
237    #bind $itk_component(3dview) <ButtonRelease> \
238    #    [itcl::code $this _vmouse release %b %s %x %y]
239
240        # set up bindings to bridge mouse events to server
241    bind $itk_component(3dview) <ButtonPress> \
242        [itcl::code $this _vmouse2 click %b %s %x %y]
243    bind $itk_component(3dview) <ButtonRelease> \
244        [itcl::code $this _vmouse2 release %b %s %x %y]
245    bind $itk_component(3dview) <B1-Motion> \
246        [itcl::code $this _vmouse2 drag 1 %s %x %y]
247    bind $itk_component(3dview) <B2-Motion> \
248        [itcl::code $this _vmouse2 drag 2 %s %x %y]
249    bind $itk_component(3dview) <B3-Motion> \
250        [itcl::code $this _vmouse2 drag 3 %s %x %y]
251    bind $itk_component(3dview) <Motion> \
252        [itcl::code $this _vmouse2 move 0 %s %x %y]
253
254    bind $itk_component(3dview) <Configure> \
255        [itcl::code $this _send screen %w %h]
256
257        connect $hostlist
258
259    $_dispatcher register !rebuild
260    $_dispatcher dispatch $this !rebuild "[itcl::code $this _rebuild]; list"
261   
262    eval itk_initialize $args
263
264    _update forever
265    set _state 0
266    set _model ""
267
268    set i 0
269    foreach char {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z \
270                a b c d e f g h i j k l m n o p q r s t u v w x y z \
271                0 1 2 3 4 5 6 7 8 9 + /} {
272        set base64_tmp($char) $i
273        incr i
274    }
275
276    #
277    # Create base64 as list: to code for instance C<->3, specify
278    # that [lindex $base64 67] be 3 (C is 67 in ascii); non-coded
279    # ascii chars get a {}. we later use the fact that lindex on a
280    # non-existing index returns {}, and that [expr {} < 0] is true
281    #
282
283    # the last ascii char is 'z'
284    scan z %c len
285    for {set i 0} {$i <= $len} {incr i} {
286        set char [format %c $i]
287        set val {}
288        if {[info exists base64_tmp($char)]} {
289            set val $base64_tmp($char)
290        } else {
291            set val {}
292        }
293        lappend _base64 $val
294    }
295
296    # code the character "=" as -1; used to signal end of message
297    scan = %c i
298    set _base64 [lreplace $_base64 $i $i -1]
299}
300
301# ----------------------------------------------------------------------
302# DESTRUCTOR
303# ----------------------------------------------------------------------
304itcl::body Rappture::MolvisViewer::destructor {} {
305    # puts stderr "MolvisViewer::destructor()"
306    after cancel [itcl::code $this _rebuild]
307    image delete $_image(plot)
308}
309
310# ----------------------------------------------------------------------
311# USAGE: download coming
312# USAGE: download controls <downloadCommand>
313# USAGE: download now
314#
315# Clients use this method to create a downloadable representation
316# of the plot.  Returns a list of the form {ext string}, where
317# "ext" is the file extension (indicating the type of data) and
318# "string" is the data itself.
319# ----------------------------------------------------------------------
320itcl::body Rappture::MolvisViewer::download {option args} {
321    switch $option {
322        coming {}
323        controls {}
324        now {
325            return [list .jpg [_decodeb64 [$_image(plot) data -format jpeg]]]
326        }
327        default {
328            error "bad option \"$option\": should be coming, controls, now"
329        }
330    }
331}
332
333# ----------------------------------------------------------------------
334# USAGE: connect ?<host:port>,<host:port>...?
335#
336# Clients use this method to establish a connection to a new
337# server, or to reestablish a connection to the previous server.
338# Any existing connection is automatically closed.
339# ----------------------------------------------------------------------
340itcl::body Rappture::MolvisViewer::connect {{hostlist ""}} {
341    if { "" != $hostlist } { set _hostlist $hostlist }
342
343    set hostlist $_hostlist
344
345    puts stderr "MolvisViewer::connect($hostlist)"
346
347    if ([isconnected]) {
348        disconnect
349    }
350
351    if {"" == $hostlist} {
352        return 0
353    }
354
355    blt::busy hold $itk_component(hull);
356   
357    update idletasks
358
359    #
360    # Connect to the hubvis server. 
361    # If it's too busy, that server may
362    # forward us to another.
363    #
364
365    set hosts [split $hostlist ,]
366
367    foreach {hostname port} [split [lindex $hosts 0] :] break
368
369    set hosts [lrange $hosts 1 end]
370
371    while {1} {
372        puts stderr "Connecting to $hostname:$port"
373        if {[catch {socket $hostname $port} sid]} {
374            if {[llength $hosts] == 0} {
375                blt::busy release $itk_component(hull)
376                return 0
377            }
378            foreach {hostname port} [split [lindex $hosts 0] :] break
379            set hosts [lrange $hosts 1 end]
380            continue
381        }
382        fconfigure $sid -translation binary -encoding binary -buffering line -buffersize 1000
383        puts -nonewline $sid "AB01"
384        flush $sid
385
386        # read back a reconnection order
387        set data [read $sid 4]
388
389        if {[binary scan $data cccc b1 b2 b3 b4] != 4} {
390            error "couldn't read redirection request"
391        }
392
393        set hostname [format "%u.%u.%u.%u" \
394            [expr {$b1 & 0xff}] \
395            [expr {$b2 & 0xff}] \
396            [expr {$b3 & 0xff}] \
397            [expr {$b4 & 0xff}]]
398
399        if {[string equal $hostname "0.0.0.0"]} {
400            fileevent $sid readable [itcl::code $this _receive]
401            set _sid $sid
402            blt::busy release $itk_component(hull)
403            return 1
404        }
405    }
406
407    blt::busy release $itk_component(hull)
408
409   
410    return 0
411}
412
413# ----------------------------------------------------------------------
414# USAGE: disconnect
415#
416# Clients use this method to disconnect from the current rendering
417# server.
418# ----------------------------------------------------------------------
419itcl::body Rappture::MolvisViewer::disconnect {} {
420    #puts stderr "MolvisViewer::disconnect()"
421
422    if {"" != $_sid} {
423        catch {
424            close $_sid
425            unset _dataobjs
426            unset _imagecache
427        }
428        set _sid ""
429        set _model ""
430        set _state ""
431    }
432}
433
434# ----------------------------------------------------------------------
435# USAGE: isconnected
436#
437# Clients use this method to see if we are currently connected to
438# a server.
439# ----------------------------------------------------------------------
440itcl::body Rappture::MolvisViewer::isconnected {} {
441    #puts stderr "MolvisViewer::isconnected()"
442    return [expr {"" != $_sid}]
443}
444
445# ----------------------------------------------------------------------
446# USAGE: _send <arg> <arg> ...
447#
448# Used internally to send commands off to the rendering server.
449# ----------------------------------------------------------------------
450itcl::body Rappture::MolvisViewer::_send {args} {
451    if {"" == $_sid} {
452        $_dispatcher cancel !serverDown
453        set x [expr {[winfo rootx $itk_component(area)]+10}]
454        set y [expr {[winfo rooty $itk_component(area)]+10}]
455        Rappture::Tooltip::cue @$x,$y "Connecting..."
456        update idletasks
457
458        if {[catch {connect} ok] == 0 && $ok} {
459            set w [winfo width $itk_component(3dview)]
460            set h [winfo height $itk_component(3dview)]
461            puts $_sid "screen $w $h"
462            flush $_sid
463            after idle [itcl::code $this _rebuild]
464            Rappture::Tooltip::cue hide
465            return
466        }
467
468        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."
469       
470        return
471    }
472
473    if {"" != $_sid} {
474        puts $_sid $args
475        flush $_sid
476    }
477}
478
479# ----------------------------------------------------------------------
480# USAGE: _receive
481#
482# Invoked automatically whenever a command is received from the
483# rendering server.  Reads the incoming command and executes it in
484# a safe interpreter to handle the action.
485# ----------------------------------------------------------------------
486itcl::body Rappture::MolvisViewer::_receive {} {
487    #puts stderr "MolvisViewer::_receive()"
488
489    if {"" != $_sid} { fileevent $_sid readable {} }
490
491    while {$_sid != ""} {
492        fconfigure $_sid -buffering line -blocking 0
493       
494        if {[gets $_sid line] < 0} {
495            if { [fblocked $_sid] } {
496                break;
497            }
498           
499            disconnect
500           
501            $_dispatcher event -after 750 !serverDown
502        } elseif {[regexp {^\s*nv>\s*image\s+(\d+)\s*(\d+)\s*,\s*(\d+)\s*,\s*(-{0,1}\d+)} $line whole match cacheid frame rock]} {
503            set tag "$frame,$rock"
504   
505            if { $cacheid != $_cacheid } {
506                catch { unset _imagecache }
507                set _cacheid $cacheid
508            }
509
510            fconfigure $_sid -buffering none -blocking 1
511               set _imagecache($tag) [read $_sid $match]
512            $_image(plot) configure -data $_imagecache($tag)
513            set _image(id) $tag
514            update idletasks
515            break
516        } else {
517            # this shows errors coming back from the engine
518            puts $line
519        }
520    }
521
522    if { "" != $_sid } { fileevent $_sid readable [itcl::code $this _receive] }
523}
524
525# ----------------------------------------------------------------------
526# USAGE: _rebuild
527#
528# Called automatically whenever something changes that affects the
529# data in the widget.  Clears any existing data and rebuilds the
530# widget to display new data.
531# ----------------------------------------------------------------------
532itcl::body Rappture::MolvisViewer::_rebuild {} {
533    #puts stderr "MolvisViewer::_rebuild()"
534    set recname  "ATOM  "
535    set serial   0
536    set atom     ""
537    set altLoc   ""
538    set resName  ""
539    set chainID  ""
540    set Seqno    ""
541    set x        0
542    set y        0
543    set z        0
544    set occupancy  1
545    set tempFactor 0
546    set recID      ""
547    set segID      ""
548    set element    ""
549    set charge     ""
550    set data1      ""
551    set data2      ""
552
553    if {$itk_option(-device) != ""} {
554        set dev $itk_option(-device)
555        set model [$dev get components.molecule.model]
556        set _state [$dev get components.molecule.state]
557       
558        if {"" == $model } { set model "molecule" }
559        if {"" == $_state} { set _state 1 }
560
561        if { $model != $_model && $_model != "" } {
562            _send raw disable $_model
563        }
564
565        if { [info exists _dataobjs($model-$_state)] } {
566            if { $model != $_model } {
567                _send raw enable $model
568                set _model $model
569            }
570        } else {
571
572            foreach _atom [$dev children -type atom components.molecule] {
573                set symbol [$dev get components.molecule.$_atom.symbol]
574                set xyz [$dev get components.molecule.$_atom.xyz]
575                regsub {,} $xyz {} xyz
576                scan $xyz "%f %f %f" x y z
577                set atom $symbol
578                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]
579                append data1 $line
580                incr serial
581            }
582
583            set data2 [$dev get components.molecule.pdb]
584
585            if {"" != $data1} {
586                    eval _send loadpdb \"$data1\" $model $_state
587                    set _dataobjs($model-$_state)  1
588                if {$_model != $model} {
589                    set _model $model
590                    representation $_mrepresentation
591                }
592                    puts stderr "loaded model $model into state $_state"
593            }
594
595            if {"" != $data2} {
596                eval _send loadpdb \"$data2\" $model $_state
597                    set _dataobjs($model-$_state)  1
598                if {$_model != $model} {
599                    set _model $model
600                    representation $_mrepresentation
601                }
602                puts stderr "loaded model $model into state $_state"
603            }
604        }   
605        if { ![info exists _imagecache($_state,$_rocker(x))] } {
606            _send frame $_state 1
607        } else {
608            _send frame $_state 0
609        }
610    } else {
611        _send raw disable all
612    }
613}
614
615# ----------------------------------------------------------------------
616# USAGE: _zoom in
617# USAGE: _zoom out
618# USAGE: _zoom reset
619#
620# Called automatically when the user clicks on one of the zoom
621# controls for this widget.  Changes the zoom for the current view.
622# ----------------------------------------------------------------------
623itcl::body Rappture::MolvisViewer::_zoom {option} {
624    #puts stderr "MolvisViewer::_zoom()"
625    switch -- $option {
626        in {
627            _send camera zoom 10
628        }
629        out {
630            _send camera zoom -10
631        }
632        reset {
633            _send reset
634        }
635    }
636}
637
638itcl::body Rappture::MolvisViewer::_update { args } {
639    if { [info exists _imagecache($_state,$_rocker(x))] } {
640            if { $_image(id) != "$_state,$_rocker(x)" } {
641                $_image(plot) put $_imagecache($_state,$_rocker(x))
642                update idletasks
643            }
644    }
645
646    if { $args == "forever" } {
647        after 100 [itcl::code $this _update forever]
648    }
649
650}
651
652# ----------------------------------------------------------------------
653# USAGE: _vmouse click <x> <y>
654# USAGE: _vmouse drag <x> <y>
655# USAGE: _vmouse release <x> <y>
656#
657# Called automatically when the user clicks/drags/releases in the
658# plot area.  Moves the plot according to the user's actions.
659# ----------------------------------------------------------------------
660
661itcl::body Rappture::MolvisViewer::_rock { option } {
662    # puts "MolvisViewer::_rock()"
663   
664    if { $option == "toggle" } {
665        if { $_rocker(on) } {
666            set option "off"
667        } else {
668            set option "on"
669        }
670    }
671
672    if { $option == "on" || $option == "toggle" && !$_rocker(on) } {
673        set _rocker(on) 1
674        $itk_component(rock) configure -relief sunken
675    } elseif { $option == "off" || $option == "toggle" && $_rocker(on) } {
676        set _rocker(on) 0
677        $itk_component(rock) configure -relief raised
678    } elseif { $option == "step" } {
679
680        if { $_rocker(x) >= 10 } {
681            set _rocker(dir) -1
682        } elseif { $_rocker(x) <= -10 } {
683            set _rocker(dir) 1
684        }
685   
686        set _rocker(x) [expr $_rocker(x) + $_rocker(dir) ]
687
688        if { [info exists _imagecache($_state,$_rocker(x))] } {
689            _send rock $_rocker(dir)
690        } else {
691            _send rock $_rocker(dir) $_rocker(x)
692        }
693    }
694
695        if { $_rocker(on) } {
696        after 200 [itcl::code $this _rock step]
697    }
698}
699
700itcl::body Rappture::MolvisViewer::_vmouse2 {option b m x y} {
701    # puts stderr "MolvisViewer::_vmouse2($option $b $m $x $y)"
702
703    set vButton [expr $b - 1]
704    set vModifier 0
705    set vState 1
706
707    if { $m & 1 }      { set vModifier [expr $vModifier | 1 ] }
708    if { $m & 4 }      { set vModifier [expr $vModifier | 2 ] }
709    if { $m & 131072 } { set vModifier [expr $vModifier | 4 ] }
710
711    if { $option == "click"   } { set vState 0 }
712    if { $option == "release" } { set vState 1 }
713    if { $option == "drag"    } { set vState 2 }
714    if { $option == "move"    } { set vState 3 }
715
716    if { $vState == 2 || $vState == 3} {
717        set now [clock clicks -milliseconds]
718        set diff 0
719
720                catch { set diff [expr {abs($_mevent(time) - $now)}] }
721
722        if {$diff < 75} { # 75ms between motion updates
723            return
724        }
725    }
726
727        _send vmouse $vButton $vModifier $vState $x $y
728
729    set _mevent(time) [clock clicks -milliseconds]
730}
731
732itcl::body Rappture::MolvisViewer::_vmouse {option b m x y} {
733    puts stderr "MolvisViewer::_vmouse($option $b $m $x $y)"
734    switch -- $option {
735        click {
736            $itk_component(3dview) configure -cursor fleur
737            set _mevent(x) $x
738            set _mevent(y) $y
739            set _mevent(time) [clock clicks -milliseconds]
740        }
741        drag {
742            if {[array size _mevent] == 0} {
743                 _vmouse click $b $m $x $y
744            } else {
745                set now [clock clicks -milliseconds]
746                set diff [expr {abs($_mevent(time) - $now)}]
747                if {$diff < 75} { # 75ms between motion updates
748                        return
749                }
750                set w [winfo width $itk_component(3dview)]
751                set h [winfo height $itk_component(3dview)]
752                if {$w <= 0 || $h <= 0} {
753                    return
754                }
755
756                eval _send camera angle [expr $y-$_mevent(y)] [expr $x-$_mevent(x)]
757
758                set _mevent(x) $x
759                set _mevent(y) $y
760                set _mevent(time) $now
761            }
762        }
763        release {
764            _vmouse drag $b $m $x $y
765            $itk_component(3dview) configure -cursor ""
766            catch {unset _mevent}
767        }
768                move { }
769        default {
770            error "bad option \"$option\": should be click, drag, release, move"
771        }
772    }
773}
774
775# ----------------------------------------------------------------------
776# USAGE: _serverDown
777#
778# Used internally to let the user know when the connection to the
779# visualization server has been lost.  Puts up a tip encouraging the
780# user to press any control to reconnect.
781# ----------------------------------------------------------------------
782itcl::body Rappture::MolvisViewer::_serverDown {} {
783    #puts stderr "MolvisViewer::_serverDown()"
784    set x [expr {[winfo rootx $itk_component(area)]+10}]
785    set y [expr {[winfo rooty $itk_component(area)]+10}]
786    # this would automatically switch to vtk viewer:
787    # set parent [winfo parent $itk_component(hull)]
788    # $parent viewer vtk
789    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."
790}
791
792# ----------------------------------------------------------------------
793# USAGE: representation spheres
794# USAGE: representation ball-and-stick
795# USAGE: representation lines
796#
797# Used internally to change the molecular representation used to render
798# our scene.
799# ----------------------------------------------------------------------
800itcl::body Rappture::MolvisViewer::representation {option} {
801    #puts "Rappture::MolvisViewer::representation($option)"
802    switch -- $option {
803        spheres {
804            _send spheres
805             set _mrepresentation "spheres"
806        }
807        ball-and-stick {
808            _send ball_and_stick
809             set _mrepresentation "ball-and-stick"
810        }
811        lines {
812            _send lines
813             set _mrepresentation "lines"
814        }
815    }
816}
817
818
819# ----------------------------------------------------------------------
820# USAGE: emblems on
821# USAGE: emblems off
822# USAGE: emblems toggle
823#
824# Used internally to turn labels associated with atoms on/off, and to
825# update the positions of the labels so they sit on top of each atom.
826# ----------------------------------------------------------------------
827itcl::body Rappture::MolvisViewer::emblems {option} {
828    #puts stderr "MolvisViewer::emblems($option)"
829
830    if {[$itk_component(labels) cget -relief] == "sunken"} {
831        set current_emblem 1
832    } else {
833        set current_emblem 0
834    }
835
836    switch -- $option {
837        on {
838            set emblem 1
839        }
840        off {
841            set emblem 0
842        }
843        toggle {
844            if { $current_emblem == 1 } {
845                set emblem 0
846            } else {
847                set emblem 1
848            }
849        }
850        default {
851            error "bad option \"$option\": should be on, off, toggle"
852        }
853    }
854
855    if {$emblem == $current_emblem} { return }
856
857    if {$emblem} {
858        $itk_component(labels) configure -relief sunken
859        _send label on
860    } else {
861        $itk_component(labels) configure -relief raised
862        _send label off
863    }
864}
865
866# ----------------------------------------------------------------------
867# OPTION: -device
868# ----------------------------------------------------------------------
869itcl::configbody Rappture::MolvisViewer::device {
870    #puts stderr "MolvisViewer::device()"
871
872    if {$itk_option(-device) != "" } {
873
874        if {![Rappture::library isvalid $itk_option(-device)]} {
875            error "bad value \"$itk_option(-device)\": should be Rappture::library object"
876        }
877
878        set emblem [$itk_option(-device) get components.molecule.about.emblems]
879
880        if {$emblem == "" || ![string is boolean $emblem] || !$emblem} {
881            emblems off
882        } else {
883            emblems on
884        }
885    }
886
887    $_dispatcher event -idle !rebuild
888}
889
890# ::base64::decode --
891#
892#   Base64 decode a given string.
893#
894# Arguments:
895#   string  The string to decode.  Characters not in the base64
896#       alphabet are ignored (e.g., newlines)
897#
898# Results:
899#   The decoded value.
900
901itcl::body Rappture::MolvisViewer::_decodeb64 {arg} {
902    if {[string length $arg] == 0} {return ""}
903
904    set base64 $_base64
905    set output "" ; # Fix for [Bug 821126]
906
907    binary scan $arg c* X
908    foreach x $X {
909        set bits [lindex $base64 $x]
910        if {$bits >= 0} {
911            if {[llength [lappend nums $bits]] == 4} {
912                foreach {v w z y} $nums break
913                set a [expr {($v << 2) | ($w >> 4)}]
914                set b [expr {(($w & 0xF) << 4) | ($z >> 2)}]
915                set c [expr {(($z & 0x3) << 6) | $y}]
916                append output [binary format ccc $a $b $c]
917                set nums {}
918            }               
919        } elseif {$bits == -1} {
920            # = indicates end of data.  Output whatever chars are left.
921            # The encoding algorithm dictates that we can only have 1 or 2
922            # padding characters.  If x=={}, we have 12 bits of input
923            # (enough for 1 8-bit output).  If x!={}, we have 18 bits of
924            # input (enough for 2 8-bit outputs).
925               
926            foreach {v w z} $nums break
927            set a [expr {($v << 2) | (($w & 0x30) >> 4)}]
928            if {$z == {}} {
929                append output [binary format c $a ]
930            } else {
931                set b [expr {(($w & 0xF) << 4) | (($z & 0x3C) >> 2)}]
932                append output [binary format cc $a $b]
933            }               
934            break
935        } else {
936            # RFC 2045 says that line breaks and other characters not part
937            # of the Base64 alphabet must be ignored, and that the decoder
938            # can optionally emit a warning or reject the message.  We opt
939            # not to do so, but to just ignore the character.
940            continue
941        }
942    }
943    return $output
944}
Note: See TracBrowser for help on using the repository browser.