Changeset 648


Ignore:
Timestamp:
Mar 28, 2007 9:37:31 PM (17 years ago)
Author:
nkissebe
Message:

molvisviewer.tcl: beta2 of molvisviewer

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/gui/scripts/molvisviewer.tcl

    r609 r648  
    2929    constructor {hostlist args} { # defined below }
    3030    destructor { # defined below }
    31 
    3231    public method emblems {option}
     32    public method representation {option}
    3333
    3434    public method connect {{hostlist ""}}
    3535    public method disconnect {}
    3636    public method isconnected {}
    37 
     37    public method download {option args}
     38    protected method _rock {option}
    3839    protected method _send {args}
    3940    protected method _receive {}
    40     protected method _receive_image {size}
     41    protected method _update { args }
    4142    protected method _rebuild {}
    4243    protected method _zoom {option}
    43     protected method _move {option x y}
    44     protected method _speed {option}
     44    protected method _vmouse2 {option b m x y}
     45    protected method _vmouse  {option b m x y}
    4546    protected method _serverDown {}
    46 
     47    protected method _decodeb64 { arg }
     48
     49    private variable _base64 ""
    4750    private variable _dispatcher "" ;# dispatcher for !events
    4851    private variable _sid ""       ;# socket connection to nanovis server
    4952    private variable _image        ;# image displayed in plotting area
    5053
    51     private variable _click        ;# info used for _move operations
     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 ""
    5266}
    5367
     
    6175itcl::body Rappture::MolvisViewer::constructor {hostlist args} {
    6276    #puts stderr "MolvisViewer::_constructor()"
     77
     78    set _rocker(dir) 1
     79    set _rocker(x) 0
     80    set _rocker(on) 0
     81
    6382    Rappture::dispatcher _dispatcher
    6483    $_dispatcher register !serverDown
    6584    $_dispatcher dispatch $this !serverDown "[itcl::code $this _serverDown]; list"
    66 
    6785    #
    6886    # Set up the widgets in the main body
     
    7189    pack propagate $itk_component(hull) no
    7290
    73     itk_component add bottom_controls {
    74         frame $itk_interior.b_cntls
    75     } {
    76         usual
     91    itk_component add left_controls {
     92        frame $itk_interior.l_cntls
     93        } {
     94        usual
    7795        rename -background -controlbackground controlBackground Background
    78     }
    79     pack $itk_component(bottom_controls) -side bottom -fill y
    80 
    81     itk_component add mrewind {
    82             button $itk_component(bottom_controls).mrewind \
    83             -borderwidth 1 -padx 1 -pady 1 \
    84             -text "|<" \
    85             -command [itcl::code $this _send rewind]
    86     } {
    87         usual
    88         ignore -borderwidth
    89         rename -highlightbackground -controlbackground controlBackground Background
    90     }
    91     pack $itk_component(mrewind) -padx 4 -pady 4 -side left
    92 
    93     itk_component add mbackward {
    94             button $itk_component(bottom_controls).mbackward \
    95             -borderwidth 1 -padx 1 -pady 1 \
    96             -text "<" \
    97             -command [itcl::code $this _send backward]
    98     } {
    99         usual
    100         ignore -borderwidth
    101         rename -highlightbackground -controlbackground controlBackground Background
    102     }
    103     pack $itk_component(mbackward) -padx 4 -pady 4 -side left
    104 
    105     itk_component add mstop {
    106             button $itk_component(bottom_controls).mstop \
    107             -borderwidth 1 -padx 1 -pady 1 \
    108             -text "Stop" \
    109             -command [itcl::code $this _send mstop]
    110     } {
    111         usual
    112         ignore -borderwidth
    113         rename -highlightbackground -controlbackground controlBackground Background
    114     }
    115     pack $itk_component(mstop) -padx 4 -pady 4 -side left
    116 
    117     itk_component add mplay {
    118             button $itk_component(bottom_controls).mplay \
    119             -borderwidth 1 -padx 1 -pady 1 \
    120             -text "Play" \
    121             -command [itcl::code $this _send mplay]
     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]
    122104    } {
    123105        usual
     
    125107        rename -highlightbackground -controlbackground controlBackground Background
    126108    }
    127     pack $itk_component(mplay) -padx 4 -pady 4 -side left
    128    
    129     itk_component add mforward {
    130             button $itk_component(bottom_controls).mforward \
    131             -borderwidth 1 -padx 1 -pady 1 \
    132             -text ">" \
    133             -command [itcl::code $this _send forward]
     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]
    134116    } {
    135117        usual
     
    137119        rename -highlightbackground -controlbackground controlBackground Background
    138120    }
    139     pack $itk_component(mforward) -padx 4 -pady 4 -side left
    140    
    141     itk_component add mend {
    142             button $itk_component(bottom_controls).mend \
    143             -borderwidth 1 -padx 1 -pady 1 \
    144             -text ">|" \
    145             -command [itcl::code $this _send ending]
    146     } {
    147         usual
    148         ignore -borderwidth
    149         rename -highlightbackground -controlbackground controlBackground Background
    150     }
    151     pack $itk_component(mend) -padx 4 -pady 4 -side left
    152    
    153     itk_component add mclear {
    154             button $itk_component(bottom_controls).mclear \
    155             -borderwidth 1 -padx 1 -pady 1 \
    156             -text "MClear" \
    157             -command [itcl::code $this _send mclear]
    158     } {
    159         usual
    160         ignore -borderwidth
    161         rename -highlightbackground -controlbackground controlBackground Background
    162     }
    163     pack $itk_component(mclear) -padx 4 -pady 4 -side left
    164    
    165     itk_component add speed {
    166             ::scale $itk_component(bottom_controls).speed \
    167             -borderwidth 1 \
    168             -from 100 -to 1000 -orient horizontal \
    169             -command [itcl::code $this _speed]
    170     } {
    171         usual
    172         ignore -borderwidth
    173         rename -highlightbackground -controlbackground controlBackground Background
    174     }
    175     pack $itk_component(speed) -padx 4 -pady 4 -side right
    176            
    177     itk_component add left_controls {
    178         frame $itk_interior.l_cntls
    179         } {
    180         usual
    181         rename -background -controlbackground controlBackground Background
    182         }
    183     pack $itk_component(left_controls) -side left -fill y
    184 
    185     itk_component add show_ball_and_stick {
    186             button $itk_component(left_controls).sbs \
    187             -borderwidth 2 -padx 0 -pady 0 \
    188             -image [Rappture::icon ballnstick] \
    189             -command [itcl::code $this _send ball_and_stick]
    190     } {
    191         usual
    192         ignore -borderwidth
    193         rename -highlightbackground -controlbackground controlBackground Background
    194     }
    195     pack $itk_component(show_ball_and_stick) -padx 4 -pady 4
    196 
    197     itk_component add show_spheres {
    198             button $itk_component(left_controls).ss \
    199             -borderwidth 1 -padx 1 -pady 1 \
    200             -image [Rappture::icon spheres] \
    201             -command [itcl::code $this _send spheres]
    202     } {
    203         usual
    204         ignore -borderwidth
    205         rename -highlightbackground -controlbackground controlBackground Background
    206     }
    207121    pack $itk_component(show_spheres) -padx 4 -pady 4
    208122
    209123    itk_component add show_lines {
    210             button $itk_component(left_controls).sl \
    211             -borderwidth 1 -padx 1 -pady 1 \
     124            button $itk_component(left_controls).sl \
     125            -borderwidth 1 -padx 1 -pady 1 \
    212126            -image [Rappture::icon lines] \
    213             -command [itcl::code $this _send lines]
     127            -command [itcl::code $this representation lines]
    214128    } {
    215129        usual
     
    281195
    282196    itk_component add rock {
    283         button $itk_component(controls).rock \
     197        label $itk_component(controls).rock \
    284198            -borderwidth 1 -padx 1 -pady 1 \
    285             -text "R" \
    286             -command [itcl::code $this _send rock]
     199            -relief "raised" -text "R" \
    287200    } {
    288201        usual
     
    291204    }
    292205    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]
    293210
    294211    #
     
    302219
    303220    set _image(plot) [image create photo]
     221    set _image(id) ""
    304222
    305223    itk_component add 3dview {
     
    313231
    314232    # 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
    315241    bind $itk_component(3dview) <ButtonPress> \
    316         [itcl::code $this _move click %x %y]
     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]
    317245    bind $itk_component(3dview) <B1-Motion> \
    318         [itcl::code $this _move drag %x %y]
    319     bind $itk_component(3dview) <ButtonRelease> \
    320         [itcl::code $this _move release %x %y]
     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
    321254    bind $itk_component(3dview) <Configure> \
    322255        [itcl::code $this _send screen %w %h]
    323256
    324     connect $hostlist
     257        connect $hostlist
    325258
    326259    $_dispatcher register !rebuild
     
    328261   
    329262    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]
    330299}
    331300
     
    340309
    341310# ----------------------------------------------------------------------
     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# ----------------------------------------------------------------------
    342334# USAGE: connect ?<host:port>,<host:port>...?
    343335#
     
    347339# ----------------------------------------------------------------------
    348340itcl::body Rappture::MolvisViewer::connect {{hostlist ""}} {
    349     # puts stderr "MolvisViewer::connect()"
     341    if { "" != $hostlist } { set _hostlist $hostlist }
     342
     343    set hostlist $_hostlist
     344
     345    puts stderr "MolvisViewer::connect($hostlist)"
    350346
    351347    if ([isconnected]) {
     
    374370
    375371    while {1} {
     372        puts stderr "Connecting to $hostname:$port"
    376373        if {[catch {socket $hostname $port} sid]} {
    377374            if {[llength $hosts] == 0} {
     
    383380            continue
    384381        }
    385         fconfigure $sid -translation binary -encoding binary -buffering line
     382        fconfigure $sid -translation binary -encoding binary -buffering line -buffersize 1000
    386383        puts -nonewline $sid "AB01"
    387384        flush $sid
     
    410407    blt::busy release $itk_component(hull)
    411408
     409   
    412410    return 0
    413411}
     
    425423        catch {
    426424            close $_sid
     425            unset _dataobjs
     426            unset _imagecache
    427427        }
    428428        set _sid ""
     429        set _model ""
     430        set _state ""
    429431    }
    430432}
     
    447449# ----------------------------------------------------------------------
    448450itcl::body Rappture::MolvisViewer::_send {args} {
    449     # puts stderr "MolvisViewer::_send() $args"
    450451    if {"" == $_sid} {
    451452        $_dispatcher cancel !serverDown
     
    453454        set y [expr {[winfo rooty $itk_component(area)]+10}]
    454455        Rappture::Tooltip::cue @$x,$y "Connecting..."
     456        update idletasks
    455457
    456458        if {[catch {connect} ok] == 0 && $ok} {
     
    458460            set h [winfo height $itk_component(3dview)]
    459461            puts $_sid "screen $w $h"
     462            flush $_sid
    460463            after idle [itcl::code $this _rebuild]
    461464            Rappture::Tooltip::cue hide
     
    465468        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."
    466469       
    467         return
     470        return
    468471    }
    469472
    470473    if {"" != $_sid} {
    471474        puts $_sid $args
     475        flush $_sid
    472476    }
    473477}
     
    482486itcl::body Rappture::MolvisViewer::_receive {} {
    483487    #puts stderr "MolvisViewer::_receive()"
    484     if {"" != $_sid} {
     488
     489    if {"" != $_sid} { fileevent $_sid readable {} }
     490
     491    while {$_sid != ""} {
     492        fconfigure $_sid -buffering line -blocking 0
     493       
    485494        if {[gets $_sid line] < 0} {
     495            if { [fblocked $_sid] } {
     496                break;
     497            }
     498           
    486499            disconnect
     500           
    487501            $_dispatcher event -after 750 !serverDown
    488         } elseif {[regexp {^\s*nv>\s*image\s+(\d+)\s*$} $line whole match]} {
    489             set bytes [read $_sid $match]
    490             $_image(plot) configure -data $bytes
     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
    491514            update idletasks
     515            break
    492516        } else {
    493517            # this shows errors coming back from the engine
     
    495519        }
    496520    }
     521
     522    if { "" != $_sid } { fileevent $_sid readable [itcl::code $this _receive] }
    497523}
    498524
     
    524550    set data1      ""
    525551    set data2      ""
    526    
     552
    527553    if {$itk_option(-device) != ""} {
    528554        set dev $itk_option(-device)
    529 
    530         foreach _atom [$dev children -type atom components.molecule] {
    531             set symbol [$dev get components.molecule.$_atom.symbol]
    532             set xyz [$dev get components.molecule.$_atom.xyz]
    533             regsub {,} $xyz {} xyz
    534             scan $xyz "%f %f %f" x y z
    535             set atom $symbol
    536             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]
    537             append data1 $line
    538             incr serial
    539         }
    540 
    541         set data2 [$dev get components.molecule.pdb]
    542 
    543     }
    544 
    545     if {"" != $data1} {
    546         eval _send loadpdb \"$data1\" data1
    547     }
    548 
    549     if {"" != $data2} {
    550         eval _send loadpdb \"$data2\" data2
    551     }
    552 }
    553 
    554 itcl::body Rappture::MolvisViewer::_speed {option} {
    555         #puts stderr "MolvisViewer::_speed($option)"
    556         _send mspeed $option
     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    }
    557613}
    558614
     
    580636}
    581637
    582 # ----------------------------------------------------------------------
    583 # USAGE: _move click <x> <y>
    584 # USAGE: _move drag <x> <y>
    585 # USAGE: _move release <x> <y>
     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>
    586656#
    587657# Called automatically when the user clicks/drags/releases in the
    588658# plot area.  Moves the plot according to the user's actions.
    589659# ----------------------------------------------------------------------
    590 itcl::body Rappture::MolvisViewer::_move {option x y} {
    591     #puts stderr "MolvisViewer::_move($option $x $y)"
     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)"
    592734    switch -- $option {
    593735        click {
    594736            $itk_component(3dview) configure -cursor fleur
    595             set _click(x) $x
    596             set _click(y) $y
    597             set _click(time) [clock clicks -milliseconds]
     737            set _mevent(x) $x
     738            set _mevent(y) $y
     739            set _mevent(time) [clock clicks -milliseconds]
    598740        }
    599741        drag {
    600             if {[array size _click] == 0} {
    601                 _move click $x $y
     742            if {[array size _mevent] == 0} {
     743                 _vmouse click $b $m $x $y
    602744            } else {
    603                 set now [clock clicks -milliseconds]
    604                 set diff [expr {abs($_click(time) - $now)}]
    605                 if {$diff < 75} { # 75ms between motion updates
    606                         return
    607                 }
     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                }
    608750                set w [winfo width $itk_component(3dview)]
    609751                set h [winfo height $itk_component(3dview)]
    610752                if {$w <= 0 || $h <= 0} {
    611                     return
     753                    return
    612754                }
    613755
    614                 eval _send camera angle [expr $y-$_click(y)] [expr $x-$_click(x)]
    615 
    616                 set _click(x) $x
    617                 set _click(y) $y
    618                 set _click(time) $now
     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
    619761            }
    620762        }
    621763        release {
    622             _move drag $x $y
     764            _vmouse drag $b $m $x $y
    623765            $itk_component(3dview) configure -cursor ""
    624             catch {unset _click}
    625         }
     766            catch {unset _mevent}
     767        }
     768                move { }
    626769        default {
    627             error "bad option \"$option\": should be click, drag, release"
     770            error "bad option \"$option\": should be click, drag, release, move"
    628771        }
    629772    }
     
    641784    set x [expr {[winfo rootx $itk_component(area)]+10}]
    642785    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
    643789    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."
    644790}
     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
    645818
    646819# ----------------------------------------------------------------------
     
    654827itcl::body Rappture::MolvisViewer::emblems {option} {
    655828    #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
    656836    switch -- $option {
    657837        on {
    658             set state 1
     838            set emblem 1
    659839        }
    660840        off {
    661             set state 0
     841            set emblem 0
    662842        }
    663843        toggle {
    664             if {[$itk_component(labels) cget -relief] == "sunken"} {
    665                 set state 0
     844            if { $current_emblem == 1 } {
     845                set emblem 0
    666846            } else {
    667                 set state 1
     847                set emblem 1
    668848            }
    669849        }
     
    673853    }
    674854
    675     if {$state} {
     855    if {$emblem == $current_emblem} { return }
     856
     857    if {$emblem} {
    676858        $itk_component(labels) configure -relief sunken
    677859        _send label on
     
    694876        }
    695877
    696         set state [$itk_option(-device) get components.molecule.about.emblems]
    697 
    698         if {$state == "" || ![string is boolean $state] || !$state} {
     878        set emblem [$itk_option(-device) get components.molecule.about.emblems]
     879
     880        if {$emblem == "" || ![string is boolean $emblem] || !$emblem} {
    699881            emblems off
    700882        } else {
     
    706888}
    707889
     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 TracChangeset for help on using the changeset viewer.