Changeset 690 for trunk/gui/scripts


Ignore:
Timestamp:
May 1, 2007, 2:25:18 PM (17 years ago)
Author:
nkissebe
Message:

molvisviewer.tcl: rc1 of molvisviewer

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/gui/scripts/molvisviewer.tcl

    r676 r690  
    2929    constructor {hostlist args} { # defined below }
    3030    destructor { # defined below }
     31
     32    public method add {dataobj {settings ""}}
     33    public method get {}
     34    public method delete {args}
     35
    3136    public method emblems {option}
    32     public method representation {option}
     37    public method representation {option {model "all"} }
    3338
    3439    public method connect {{hostlist ""}}
    … …  
    4045    protected method _receive {}
    4146    protected method _update { args }
    42     protected method _rebuild {}
     47    protected method _rebuild { }
    4348    protected method _zoom {option}
     49        protected method _configure {w h}
     50        protected method _unmap {}
     51        protected method _map {}
    4452    protected method _vmouse2 {option b m x y}
    4553    protected method _vmouse  {option b m x y}
    4654    protected method _serverDown {}
    47     protected method _decodeb64 { arg }
    48 
    49     private variable _base64 ""
     55
    5056    private variable _dispatcher "" ;# dispatcher for !events
    5157    private variable _sid ""       ;# socket connection to nanovis server
    5258    private variable _image        ;# image displayed in plotting area
    5359
     60    private variable _inrebuild 0
     61
    5462    private variable _mevent       ;# info used for mouse event operations
    5563    private variable _rocker       ;# info used for rock operations
    56 
    57 
     64    private variable _dlist ""    ;# list of dataobj objects
    5865    private variable _dataobjs     ;# data objects on server
     66    private variable _dobj2transparency  ;# maps dataobj => transparency
     67    private variable _dobj2raise  ;# maps dataobj => raise flag 0/1
     68    private variable _dobj2ghost
     69
     70    private variable _model
     71    private variable _mlist
     72
    5973    private variable _imagecache
    60     private variable _state 1
    61     private variable _labels
     74    private variable _state
     75    private variable _labels  "default"
    6276    private variable _cacheid ""
    6377    private variable _hostlist ""
    64     private variable _model ""
    6578    private variable _mrepresentation "spheres"
    6679    private variable _cacheimage ""
    … …  
    7891
    7992    set _rocker(dir) 1
    80     set _rocker(x) 0
     93    set _rocker(client) 0
     94    set _rocker(server) 0
    8195    set _rocker(on) 0
     96    set _state(server) 1
     97        set _state(client) 1
    8298
    8399    Rappture::dispatcher _dispatcher
    84100    $_dispatcher register !serverDown
    85101    $_dispatcher dispatch $this !serverDown "[itcl::code $this _serverDown]; list"
     102
    86103    #
    87104    # Set up the widgets in the main body
    … …  
    89106    option add hull.width hull.height
    90107    pack propagate $itk_component(hull) no
    91 
    92     itk_component add left_controls {
    93         frame $itk_interior.l_cntls
    94         } {
    95         usual
    96         rename -background -controlbackground controlBackground Background
    97         }
    98     pack $itk_component(left_controls) -side left -fill y
    99 
    100     itk_component add show_ball_and_stick {
    101             button $itk_component(left_controls).sbs \
    102             -borderwidth 2 -padx 0 -pady 0 \
    103             -image [Rappture::icon ballnstick] \
    104             -command [itcl::code $this representation ball-and-stick]
    105     } {
    106         usual
    107         ignore -borderwidth
    108         rename -highlightbackground -controlbackground controlBackground Background
    109     }
    110     pack $itk_component(show_ball_and_stick) -padx 4 -pady 4
    111 
    112     itk_component add show_spheres {
    113             button $itk_component(left_controls).ss \
    114             -borderwidth 1 -padx 1 -pady 1 \
    115             -image [Rappture::icon spheres] \
    116             -command [itcl::code $this representation spheres]
    117     } {
    118         usual
    119         ignore -borderwidth
    120         rename -highlightbackground -controlbackground controlBackground Background
    121     }
    122     pack $itk_component(show_spheres) -padx 4 -pady 4
    123 
    124     itk_component add show_lines {
    125             button $itk_component(left_controls).sl \
    126             -borderwidth 1 -padx 1 -pady 1 \
    127             -image [Rappture::icon lines] \
    128             -command [itcl::code $this representation lines]
    129     } {
    130         usual
    131         ignore -borderwidth
    132         rename -highlightbackground -controlbackground controlBackground Background
    133     }
    134     pack $itk_component(show_lines) -padx 4 -pady 4
    135108
    136109    itk_component add controls {
    … …  
    179152    }
    180153    pack $itk_component(zoomout) -padx 4 -pady 4
     154
    181155    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
    182156
    … …  
    184158        label $itk_component(controls).labels \
    185159            -borderwidth 1 -padx 1 -pady 1 \
    186             -bitmap [Rappture::icon atoms]
     160            -relief "raised" -bitmap [Rappture::icon atoms]
    187161    } {
    188162        usual
    … …  
    190164        rename -highlightbackground -controlbackground controlBackground Background
    191165    }
    192     pack $itk_component(labels) -padx 4 -pady 8 -ipadx 1 -ipady 1
     166    pack $itk_component(labels) -padx 4 -pady 4 -ipadx 1 -ipady 1
    193167    Rappture::Tooltip::for $itk_component(labels) "Show/hide the labels on atoms"
    194168    bind $itk_component(labels) <ButtonPress> \
    … …  
    204178        rename -highlightbackground -controlbackground controlBackground Background
    205179    }
    206     pack $itk_component(rock) -padx 4 -pady 8 -ipadx 1 -ipady 1
     180    pack $itk_component(rock) -padx 4 -pady 4 -ipadx 1 -ipady 1
    207181    Rappture::Tooltip::for $itk_component(rock) "Rock model +/- 10 degrees"
    208182
     183    itk_component add show_lines {
     184            label $itk_component(controls).show_lines \
     185            -borderwidth 1 -padx 1 -pady 1 \
     186            -relief "raised" -text "/" \
     187    } {
     188        usual
     189        ignore -borderwidth
     190        rename -highlightbackground -controlbackground controlBackground Background
     191    }
     192    pack $itk_component(show_lines) -padx 4 -pady 4
     193    bind $itk_component(show_lines) <ButtonPress> \
     194        [itcl::code $this representation lines all]
     195
     196        itk_component add show_spheres {
     197            label $itk_component(controls).show_spheres \
     198            -borderwidth 1 -padx 1 -pady 1 \
     199            -relief "sunken" -text "O" \
     200    } {
     201        usual
     202        ignore -borderwidth
     203        rename -highlightbackground -controlbackground controlBackground Background
     204    }
     205    pack $itk_component(show_spheres) -padx 4 -pady 4
     206    bind $itk_component(show_spheres) <ButtonPress> \
     207        [itcl::code $this representation spheres all]
     208
     209    itk_component add show_ball_and_stick {
     210            label $itk_component(controls).show_ball_and_stick \
     211            -borderwidth 1 -padx 1 -pady 1 \
     212            -relief "raised" -text "%" \
     213    } {
     214        usual
     215        ignore -borderwidth
     216        rename -highlightbackground -controlbackground controlBackground Background
     217    }
     218    pack $itk_component(show_ball_and_stick) -padx 4 -pady 4
     219    bind $itk_component(show_ball_and_stick) <ButtonPress> \
     220        [itcl::code $this representation ball_and_stick all]
     221   
    209222    bind $itk_component(rock) <ButtonPress> \
    210223        [itcl::code $this _rock toggle]
    … …  
    253266    #    [itcl::code $this _vmouse2 move 0 %s %x %y]
    254267
     268        connect $hostlist
     269
    255270    bind $itk_component(3dview) <Configure> \
    256         [itcl::code $this _send screen %w %h]
    257 
    258         connect $hostlist
     271        [itcl::code $this _configure %w %h]
     272    bind $itk_component(3dview) <Unmap> \
     273        [itcl::code $this _unmap]
     274    bind $itk_component(3dview) <Map> \
     275        [itcl::code $this _map]
    259276
    260277    $_dispatcher register !rebuild
    … …  
    262279   
    263280    eval itk_initialize $args
    264 
    265     _update forever
    266     set _state 0
    267     set _model ""
    268281}
    269282
    … …  
    272285# ----------------------------------------------------------------------
    273286itcl::body Rappture::MolvisViewer::destructor {} {
    274     # puts stderr "MolvisViewer::destructor()"
    275     after cancel [itcl::code $this _rebuild]
    276     image delete $_image(plot)
     287    #puts stderr "MolvisViewer::destructor()"
     288        disconnect
    277289}
    278290
    … …  
    312324    set hostlist $_hostlist
    313325
    314     puts stderr "MolvisViewer::connect($hostlist)"
    315 
    316326    if ([isconnected]) {
    317327        disconnect
    … …  
    339349
    340350    while {1} {
    341         puts stderr "Connecting to $hostname:$port"
    342351        if {[catch {socket $hostname $port} sid]} {
    343352            if {[llength $hosts] == 0} {
    … …  
    350359        }
    351360        fconfigure $sid -translation binary -encoding binary -buffering line -buffersize 1000
    352         puts -nonewline $sid "AB01"
     361        puts $sid "pymol"
    353362        flush $sid
    354363
    … …  
    369378            fileevent $sid readable [itcl::code $this _receive]
    370379            set _sid $sid
     380
     381                        set _rocker(server) 0
     382                        set _cacheid 0
     383
     384            _send raw -defer set auto_color,0
     385            _send raw -defer set auto_show_lines,0
    371386            blt::busy release $itk_component(hull)
    372387            return 1
    … …  
    375390
    376391    blt::busy release $itk_component(hull)
    377 
    378392   
    379393    return 0
    … …  
    389403    #puts stderr "MolvisViewer::disconnect()"
    390404
    391     if {"" != $_sid} {
    392         catch {
    393             close $_sid
    394             unset _dataobjs
    395             unset _imagecache
    396         }
    397         set _sid ""
    398         set _model ""
    399         set _state ""
    400     }
     405    fileevent $_sid readable {}
     406    catch { after cancel $_rocker(afterid) }
     407        catch { after cancel $_mevent(afterid) }
     408    image delete $_image(plot)
     409
     410    catch {
     411        close $_sid
     412        unset _dataobjs
     413            unset _model
     414                unset _mlist
     415        unset _imagecache
     416    }
     417    set _sid ""
     418        set _state(server) 1
     419        set _state(client) 1
    401420}
    402421
    … …  
    418437# ----------------------------------------------------------------------
    419438itcl::body Rappture::MolvisViewer::_send {args} {
     439    #puts stderr "Rappture::MolvisViewer::_send($args)"
     440
    420441    if {"" == $_sid} {
    421442        $_dispatcher cancel !serverDown
    … …  
    428449            set w [winfo width $itk_component(3dview)]
    429450            set h [winfo height $itk_component(3dview)]
    430             puts $_sid "screen $w $h"
     451            puts $_sid "screen -push $w $h"
    431452            flush $_sid
    432             after idle [itcl::code $this _rebuild]
     453            $_dispatcher event -idle !rebuild
    433454            Rappture::Tooltip::cue hide
    434455            return
    … …  
    438459       
    439460        return
    440     }
    441 
    442     if {"" != $_sid} {
     461    } else {
     462
     463        if { $_state(server) != $_state(client) } {
     464                    puts $_sid "frame -defer $_state(client)"
     465                    set _state(server) $_state(client)
     466            }
     467
     468                if { $_rocker(server) != $_rocker(client) } {
     469                    puts $_sid "rock -defer $_rocker(client)"
     470                    set _rocker(server) $_rocker(client)
     471            }
     472
    443473        puts $_sid $args
     474
    444475        flush $_sid
    445476    }
    … …  
    454485# ----------------------------------------------------------------------
    455486itcl::body Rappture::MolvisViewer::_receive {} {
    456     #puts stderr "MolvisViewer::_receive()"
     487    #puts stderr "Rappture::MolvisViewer::_receive()"
    457488
    458489    if {"" != $_sid} { fileevent $_sid readable {} }
    … …  
    471502        } elseif {[regexp {^\s*nv>\s*image\s+(\d+)\s*(\d+)\s*,\s*(\d+)\s*,\s*(-{0,1}\d+)} $line whole match cacheid frame rock]} {
    472503            set tag "$frame,$rock"
    473    
     504               
    474505            if { $cacheid != $_cacheid } {
    475506                catch { unset _imagecache }
    … …  
    478509
    479510            fconfigure $_sid -buffering none -blocking 1
    480                set _imagecache($tag) [read $_sid $match]
    481             $_image(plot) configure -data $_imagecache($tag)
     511            set _imagecache($tag) [read $_sid $match]
     512                        #puts stderr "CACHED: $tag,$cacheid"
     513            $_image(plot) put $_imagecache($tag)
    482514            set _image(id) $tag
     515            $itk_component(3dview) configure -cursor ""
    483516            update idletasks
    484517            break
    … …  
    500533# ----------------------------------------------------------------------
    501534itcl::body Rappture::MolvisViewer::_rebuild {} {
    502     #puts stderr "MolvisViewer::_rebuild()"
    503     set recname  "ATOM  "
    504     set serial   0
    505     set atom     ""
    506     set altLoc   ""
    507     set resName  ""
    508     set chainID  ""
    509     set Seqno    ""
    510     set x        0
    511     set y        0
    512     set z        0
    513     set occupancy  1
    514     set tempFactor 0
    515     set recID      ""
    516     set segID      ""
    517     set element    ""
    518     set charge     ""
    519     set data1      ""
    520     set data2      ""
    521 
    522     if {$itk_option(-device) != ""} {
    523         set dev $itk_option(-device)
     535    #puts stderr "Rappture::MolvisViewer::_rebuild()"
     536
     537    if { $_inrebuild } {
     538                # don't allow overlapping rebuild calls
     539            return
     540        }
     541
     542        set _inrebuild 1
     543        set changed 0
     544
     545        # refresh GUI (primarily to make pending cursor changes visible)
     546    update idletasks
     547
     548    set dlist [get]
     549
     550    foreach dev $dlist {
    524551        set model [$dev get components.molecule.model]
    525         set _state [$dev get components.molecule.state]
     552        set state [$dev get components.molecule.state]
    526553       
    527554        if {"" == $model } {
    528                     set model "molecule"
     555            set model "molecule"
    529556            scan $dev "::libraryObj%d" suffix
    530                     set model $model$suffix     
    531         }
    532         if {"" == $_state} { set _state 1 }
    533 
    534         if { $model != $_model && $_model != "" } {
    535             _send disable $_model 0
    536         }
    537 
    538         if { [info exists _dataobjs($model-$_state)] } {
    539             if { $model != $_model } {
    540                 _send enable $model 1
    541                 set _model $model
    542             }
    543         } else {
     557            set model $model$suffix     
     558        }
     559
     560        if {"" == $state} { set state $_state(server) }
     561
     562                if { ![info exists _mlist($model)] } { # new, turn on
     563                    set _mlist($model) 2
     564                } elseif { $_mlist($model) == 1 } { # on, leave on
     565                    set _mlist($model) 3
     566                } elseif { $_mlist($model) == 0 } { # off, turn on
     567                    set _mlist($model) 2
     568                }
     569
     570        if { ![info exists _dataobjs($model-$state)] } {
     571                set data1      ""
     572                set serial   0
    544573
    545574            foreach _atom [$dev children -type atom components.molecule] {
    … …  
    548577                regsub {,} $xyz {} xyz
    549578                scan $xyz "%f %f %f" x y z
     579                        set recname  "ATOM  "
     580                        set altLoc   ""
     581                        set resName  ""
     582                        set chainID  ""
     583                        set Seqno    ""
     584                        set occupancy  1
     585                        set tempFactor 0
     586                        set recID      ""
     587                        set segID      ""
     588                        set element    ""
     589                        set charge     ""
    550590                set atom $symbol
    551591                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]
    … …  
    557597
    558598            if {"" != $data1} {
    559                     eval _send loadpdb \"$data1\" $model $_state
    560                     set _dataobjs($model-$_state)  1
    561                 if {$_model != $model} {
    562                     set _model $model
    563                     representation $_mrepresentation
    564                 }
    565                     puts stderr "loaded model $model into state $_state"
     599                eval _send loadpdb -defer \"$data1\" $model $state
     600                set _dataobjs($model-$state)  1
     601                #puts stderr "loaded model $model into state $state"
    566602            }
    567 
     603           
    568604            if {"" != $data2} {
    569                 eval _send loadpdb \"$data2\" $model $_state
    570                     set _dataobjs($model-$_state)  1
    571                 if {$_model != $model} {
    572                     set _model $model
    573                     representation $_mrepresentation
    574                 }
    575                 puts stderr "loaded model $model into state $_state"
     605                eval _send loadpdb -defer \"$data2\" $model $state
     606                set _dataobjs($model-$state)  1
     607                #puts stderr "loaded model $model into state $state"
    576608            }
    577         }   
    578         if { ![info exists _imagecache($_state,$_rocker(x))] } {
    579             _send frame $_state 1
    580         } else {
    581             _send frame $_state 0
    582         }
     609        }
     610
     611                if { ![info exists _model($model-transparency)] } {
     612                        set _model($model-transparency) "undefined"
     613                }
     614
     615                if { ![info exists _model($model-representation)] } {
     616                        set _model($model-representation) "undefined"
     617                        set _model($model-newrepresentation) $_mrepresentation
     618                }
     619
     620
     621                if { $_model($model-transparency) != $_dobj2transparency($dev) } {
     622                        set  _model($model-newtransparency) $_dobj2transparency($dev)
     623                }
     624    }
     625
     626    # enable/disable models as required (0=off->off, 1=on->off, 2=off->on, 3=on->on)
     627
     628    foreach obj [array names _mlist] {
     629        if { $_mlist($obj) == 1 } {
     630            _send disable -defer $obj
     631                        set _mlist($obj) 0
     632                set changed 1
     633                } elseif { $_mlist($obj) == 2 } {
     634                        set _mlist($obj) 1
     635                        _send enable -defer $obj
     636                    if { $_labels } {
     637                                _send label on
     638                        } else {
     639                                _send label off
     640                        }
     641                set changed 1
     642                } elseif { $_mlist($obj) == 3 } {
     643                    set _mlist($obj) 1
     644                }
     645
     646
     647                if { $_mlist($obj) == 1 } {
     648                        if {  [info exists _model($obj-newtransparency)] || [info exists _model($obj-newrepresentation)] } {
     649                                if { ![info exists _model($obj-newrepresentation)] } {
     650                                        set _model($obj-newrepresentation) $_model($obj-representation)
     651                                }
     652                                if { ![info exists _model($obj-newtransparency)] } {
     653                                        set _model($obj-newtransparency) $_model($obj-transparency)
     654                                }
     655                                _send $_model($obj-newrepresentation) -defer -model $obj -$_model($obj-newtransparency)
     656                                set changed 1
     657                            set _model($obj-transparency) $_model($obj-newtransparency)
     658                            set _model($obj-representation) $_model($obj-newrepresentation)
     659                            catch {
     660                                    unset _model($obj-newtransparency)
     661                                unset _model($obj-newrepresentation)
     662                                }
     663                        }
     664                }
     665
     666        }
     667
     668        if { $changed } {
     669        catch { unset _imagecache }
     670        }
     671
     672    if { $dlist == "" } {
     673                set _state(server) 1
     674                set _state(client) 1
     675                _send frame -push 1
     676        } elseif { ![info exists _imagecache($state,$_rocker(client))] } {
     677                set _state(server) $state
     678                set _state(client) $state
     679        _send frame -push $state
    583680    } else {
    584         _send raw disable all
    585     }
     681                set _state(client) $state
     682        $itk_component(3dview) configure -cursor ""
     683                _update
     684        }
     685
     686        set _inrebuild 0
     687}
     688
     689itcl::body Rappture::MolvisViewer::_unmap { } {
     690    #puts stderr "Rappture::MolvisViewer::_unmap()"
     691
     692    #pause rocking loop while unmapped (saves CPU time)
     693        _rock pause
     694
     695        # blank image, mark current image dirty
     696        # this will force reload from cache, or remain blank if cache is cleared
     697        # this prevents old image from briefly appearing when a new result is added
     698        # by result viewer
     699
     700    $_image(plot) blank
     701        set _image(id) ""
     702}
     703
     704itcl::body Rappture::MolvisViewer::_map { } {
     705    #puts stderr "Rappture::MolvisViewer::_map()"
     706   
     707        # resume rocking loop if it was on
     708        _rock unpause
     709
     710        # rebuild image if modified, or redisplay cached image if not
     711    $_dispatcher event -idle !rebuild
     712}
     713
     714itcl::body Rappture::MolvisViewer::_configure { w h } {
     715    #puts stderr "Rappture::MolvisViewer::_configure($w $h)"
     716
     717        _send screen -push $w $h
     718    $_image(plot) configure -width $w -height $h
    586719}
    587720
    … …  
    598731    switch -- $option {
    599732        in {
    600             _send camera zoom 10
     733            _send zoom 10
    601734        }
    602735        out {
    603             _send camera zoom -10
     736            _send zoom -10
    604737        }
    605738        reset {
    … …  
    610743
    611744itcl::body Rappture::MolvisViewer::_update { args } {
    612     if { [info exists _imagecache($_state,$_rocker(x))] } {
    613             if { $_image(id) != "$_state,$_rocker(x)" } {
    614                 $_image(plot) put $_imagecache($_state,$_rocker(x))
    615                 update idletasks
    616             }
    617     }
    618 
    619     if { $args == "forever" } {
    620         after 100 [itcl::code $this _update forever]
    621     }
    622 
     745    #puts stderr "Rappture::MolvisViewer::_update($args)"
     746
     747    if { $_image(id) != "$_state(client),$_rocker(client)" } {
     748        if { [info exists _imagecache($_state(client),$_rocker(client))] } {
     749                #puts stderr "DISPLAYING CACHED IMAGE"
     750            $_image(plot) put $_imagecache($_state(client),$_rocker(client))
     751                set _image(id) "$_state(client),$_rocker(client)"
     752        }
     753        }
    623754}
    624755
    … …  
    633764
    634765itcl::body Rappture::MolvisViewer::_rock { option } {
    635     # puts "MolvisViewer::_rock()"
     766    #puts "MolvisViewer::_rock($option,$_rocker(client))"
    636767   
     768    # cancel any pending rocks
     769    if { [info exists _rocker(afterid)] } {
     770        after cancel $_rocker(afterid)
     771        unset _rocker(afterid)
     772    }
     773
    637774    if { $option == "toggle" } {
    638775        if { $_rocker(on) } {
    … …  
    649786        set _rocker(on) 0
    650787        $itk_component(rock) configure -relief raised
    651     } elseif { $option == "step" } {
    652 
    653         if { $_rocker(x) >= 10 } {
     788    } elseif { $option == "step"} {
     789
     790        if { $_rocker(client) >= 10 } {
    654791            set _rocker(dir) -1
    655         } elseif { $_rocker(x) <= -10 } {
    656             set _rocker(dir) 1
    657         }
     792        } elseif { $_rocker(client) <= -10 } {
     793                    set _rocker(dir) 1
     794        }
     795
     796            set _rocker(client) [expr $_rocker(client) + $_rocker(dir)]
    658797   
    659         set _rocker(x) [expr $_rocker(x) + $_rocker(dir) ]
    660 
    661         if { [info exists _imagecache($_state,$_rocker(x))] } {
    662             _send rock $_rocker(dir)
    663         } else {
    664             _send rock $_rocker(dir) $_rocker(x)
    665         }
    666     }
    667 
    668         if { $_rocker(on) } {
    669         after 200 [itcl::code $this _rock step]
    670     }
     798        if { ![info exists _imagecache($_state(server),$_rocker(client))] } {
     799                set _rocker(server) $_rocker(client)
     800            _send rock $_rocker(client)
     801        }
     802           
     803            _update
     804    }
     805
     806        if { $_rocker(on) && $option != "pause" } {
     807                 set _rocker(afterid) [after 200 [itcl::code $this _rock step]]
     808        }
    671809}
    672810
    673811itcl::body Rappture::MolvisViewer::_vmouse2 {option b m x y} {
    674     # puts stderr "MolvisViewer::_vmouse2($option $b $m $x $y)"
    675 
     812    set now [clock clicks -milliseconds]
    676813    set vButton [expr $b - 1]
    677814    set vModifier 0
    … …  
    688825
    689826    if { $vState == 2 || $vState == 3} {
    690         set now [clock clicks -milliseconds]
    691827        set diff 0
    692828
    693         catch { set diff [expr {abs($_mevent(time) - $now)}] }
     829        catch { set diff [expr $now - $_mevent(time)] }
    694830
    695831        if {$diff < 75} { # 75ms between motion updates
    … …  
    700836     _send vmouse $vButton $vModifier $vState $x $y
    701837
    702     set _mevent(time) [clock clicks -milliseconds]
     838    set _mevent(time) $now
    703839}
    704840
    705841itcl::body Rappture::MolvisViewer::_vmouse {option b m x y} {
    706     #puts stderr "MolvisViewer::_vmouse($option $b $m $x $y)"
    707     switch -- $option {
    708         click {
    709             $itk_component(3dview) configure -cursor fleur
    710             set _mevent(x) $x
    711             set _mevent(y) $y
    712             set _mevent(time) [clock clicks -milliseconds]
    713         }
    714         drag {
    715             if {[array size _mevent] == 0} {
    716                  _vmouse click $b $m $x $y
    717             } else {
    718                 set now [clock clicks -milliseconds]
    719                 set diff [expr {abs($_mevent(time) - $now)}]
    720                 if {$diff < 75} { # 75ms between motion updates
    721                         return
    722                 }
    723                 set w [winfo width $itk_component(3dview)]
    724                 set h [winfo height $itk_component(3dview)]
    725                 if {$w <= 0 || $h <= 0} {
    726                     return
    727                 }
    728 
    729                 set x1 [expr $w / 3]
    730                 set x2 [expr $x1 * 2]
    731                 set x3 $w
    732                 set y1 [expr $h / 3]
    733                 set y2 [expr $y1 * 2]
    734                 set y3 $h
    735                 set dx [expr $x - $_mevent(x)]
    736                 set dy [expr $y - $_mevent(y)]
    737                 set mx 0
    738                 set my 0
    739                 set mz 0
    740 
    741                 if { $_mevent(x) < $x1 } {
    742                     set mz $dy
    743                 } elseif { $_mevent(x) < $x2 } {
    744                     set mx $dy 
    745                 } else {
    746                     set mz [expr -$dy]
    747                 }
    748 
    749                 if { $_mevent(y) < $y1 } {
    750                     set mz [expr -$dx]
    751                 } elseif { $_mevent(y) < $y2 } {
    752                     set my $dx 
    753                 } else {
    754                     set mz $dx
    755                 }
    756 
    757                 _send camera angle $mx $my $mz
    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         }
     842    #puts stderr "Rappture::MolvisViewer::_vmouse($option,$b,$m,$x,$y)"
     843
     844    set now  [clock clicks -milliseconds]
     845
     846    # cancel any pending delayed dragging events
     847    if { [info exists _mevent(afterid)] } {
     848        after cancel $_mevent(afterid)
     849        unset _mevent(afterid)
     850    }
     851
     852    if { $option == "click" } {
     853        $itk_component(3dview) configure -cursor fleur
     854    }
     855
     856    if { $option == "drag" || $option == "release" } {
     857        set diff [expr $now - $_mevent(time) ]
     858
     859        if {$diff < 75 && $option == "drag" } { # 75ms between motion updates
     860            set _mevent(afterid) [after [expr 75 - $diff] [itcl::code $this _vmouse drag $b $m $x $y]]
     861            return
     862        }
     863
     864        set w [winfo width $itk_component(3dview)]
     865        set h [winfo height $itk_component(3dview)]
     866
     867        if {$w <= 0 || $h <= 0} {
     868            return
     869        }
     870
     871        set x1 [expr $w / 3]
     872        set x2 [expr $x1 * 2]
     873        set y1 [expr $h / 3]
     874        set y2 [expr $y1 * 2]
     875        set dx [expr $x - $_mevent(x)]
     876        set dy [expr $y - $_mevent(y)]
     877        set mx 0
     878        set my 0
     879        set mz 0
     880
     881        if { $_mevent(x) < $x1 } {
     882            set mz $dy
     883        } elseif { $_mevent(x) < $x2 } {
     884            set mx $dy 
     885        } else {
     886            set mz [expr -$dy]
     887        }
     888
     889        if { $_mevent(y) < $y1 } {
     890            set mz [expr -$dx]
     891        } elseif { $_mevent(y) < $y2 } {
     892            set my $dx 
     893        } else {
     894            set mz $dx
     895        }
     896
     897        _send rotate $mx $my $mz
     898
     899    }
     900
     901    set _mevent(x) $x
     902    set _mevent(y) $y
     903    set _mevent(time) $now
     904
     905    if { $option == "release" } {
     906        $itk_component(3dview) configure -cursor ""
    772907    }
    773908}
    … …  
    792927# ----------------------------------------------------------------------
    793928# USAGE: representation spheres
    794 # USAGE: representation ball-and-stick
     929# USAGE: representation ball_and_stick
    795930# USAGE: representation lines
    796931#
    … …  
    798933# our scene.
    799934# ----------------------------------------------------------------------
    800 itcl::body Rappture::MolvisViewer::representation {option} {
    801     #puts "Rappture::MolvisViewer::representation($option)"
     935itcl::body Rappture::MolvisViewer::representation {option {model "all"} } {
     936    #puts stderr "Rappture::MolvisViewer::representation($option,$model)"
     937
     938    if { $option == $_mrepresentation } { return }
     939
    802940    switch -- $option {
    803941        spheres {
    804             _send spheres
    805              set _mrepresentation "spheres"
    806         }
    807         ball-and-stick {
    808             _send ball_and_stick
    809              set _mrepresentation "ball-and-stick"
     942             $itk_component(show_spheres) configure -relief sunken
     943             $itk_component(show_lines) configure -relief raised
     944             $itk_component(show_ball_and_stick) configure -relief raised
     945        }
     946        ball_and_stick {
     947             $itk_component(show_spheres) configure -relief raised
     948             $itk_component(show_lines) configure -relief raised
     949             $itk_component(show_ball_and_stick) configure -relief sunken
    810950        }
    811951        lines {
    812             _send lines
    813              set _mrepresentation "lines"
    814         }
    815     }
    816 }
    817 
     952            $itk_component(show_spheres) configure -relief raised
     953            $itk_component(show_lines) configure -relief sunken
     954            $itk_component(show_ball_and_stick) configure -relief raised
     955        }
     956                default {
     957                        return
     958                }
     959        }
     960
     961    set _mrepresentation $option
     962
     963    if { $model == "all" } {
     964        set models [array names _mlist]
     965        } else {
     966            set models $model
     967        }
     968
     969    foreach obj $models {
     970                if { [info exists _model($obj-representation)] } {
     971                        if { $_model($obj-representation) != $option } {
     972                        set _model($obj-newrepresentation) $option
     973                        } else {
     974                                catch { unset _model($obj-newrepresentation) }
     975                        }
     976                }
     977        }
     978
     979    $_dispatcher event -idle !rebuild
     980}
    818981
    819982# ----------------------------------------------------------------------
    … …  
    8671030
    8681031# ----------------------------------------------------------------------
    869 # OPTION: -device
    870 # ----------------------------------------------------------------------
    871 itcl::configbody Rappture::MolvisViewer::device {
    872     #puts stderr "MolvisViewer::device()"
    873 
    874     if {$itk_option(-device) != "" } {
    875 
    876         if {![Rappture::library isvalid $itk_option(-device)]} {
    877             error "bad value \"$itk_option(-device)\": should be Rappture::library object"
    878         }
    879 
    880         if { ![info exists _labels] } {
    881             set emblem [$itk_option(-device) get components.molecule.about.emblems]
     1032# USAGE: add <dataobj> ?<settings>?
     1033#
     1034# Clients use this to add a data object to the plot.  The optional
     1035# <settings> are used to configure the plot.  Allowed settings are
     1036# -color, -brightness, -width, -linestyle, and -raise. Only
     1037# -brightness and -raise do anything.
     1038# ----------------------------------------------------------------------
     1039itcl::body Rappture::MolvisViewer::add { dataobj {settings ""}} {
     1040    #puts stderr "Rappture::MolvisViewer::add($dataobj)"
     1041
     1042    array set params {
     1043            -color auto
     1044                -brightness 0
     1045                -width 1
     1046                -raise 0
     1047                -linestyle solid
     1048                -description ""
     1049        }
     1050
     1051        foreach {opt val} $settings {
     1052            if {![info exists params($opt)]} {
     1053                    error "bad settings \"$opt\": should be [join [lsort [array names params]] {, }]"
     1054                }
     1055                set params($opt) $val
     1056        }
     1057 
     1058        set pos [lsearch -exact $dataobj $_dlist]
     1059
     1060        if {$pos < 0} {
     1061        if {![Rappture::library isvalid $dataobj]} {
     1062            error "bad value \"$dataobj\": should be Rappture::library object"
     1063        }
     1064       
     1065            if { $_labels == "default" } {
     1066            set emblem [$dataobj get components.molecule.about.emblems]
    8821067
    8831068            if {$emblem == "" || ![string is boolean $emblem] || !$emblem} {
    … …  
    8871072            }
    8881073        }
    889     }
     1074
     1075            lappend _dlist $dataobj
     1076                if { $params(-brightness) >= 0.5 } {
     1077                        set _dobj2transparency($dataobj) "ghost"
     1078                } else {
     1079                        set _dobj2transparency($dataobj) "normal"
     1080                }
     1081                set _dobj2raise($dataobj) $params(-raise)
     1082
     1083        $itk_component(3dview) configure -cursor watch
     1084        $_dispatcher event -idle !rebuild
     1085    }
     1086}
     1087
     1088# ----------------------------------------------------------------------
     1089# USAGE: get
     1090#
     1091# Clients use this to query the list of objects being plotted, in
     1092# order from bottom to top of this result.
     1093# ----------------------------------------------------------------------
     1094itcl::body Rappture::MolvisViewer::get {} {
     1095    #puts stderr "Rappture::MolvisViewer::get()"
     1096
     1097    # put the dataobj list in order according to -raise options
     1098        set dlist $_dlist
     1099        foreach obj $dlist {
     1100            if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
     1101                    set i [lsearch -exact $dlist $obj]
     1102                        if {$i >= 0} {
     1103                            set dlist [lreplace $dlist $i $i]
     1104                                lappend dlist $obj
     1105                        }
     1106                }
     1107        }
     1108        return $dlist
     1109}
     1110
     1111# ----------------------------------------------------------------------
     1112# USAGE: delete ?<dataobj> <dataobj> ...?
     1113#
     1114# Clients use this to delete a dataobj from the plot. If no dataobjs
     1115# are specified, then all dataobjs are deleted.
     1116# ----------------------------------------------------------------------
     1117itcl::body Rappture::MolvisViewer::delete {args} {
     1118    #puts stderr "Rappture::MolvisViewer::delete($args)"
     1119
     1120    if {[llength $args] == 0} {
     1121            set args $_dlist
     1122        }
     1123
     1124        # delete all specified dataobjs
     1125        set changed 0
     1126        foreach dataobj $args {
     1127            set pos [lsearch -exact $_dlist $dataobj]
     1128                if {$pos >= 0} {
     1129                    set _dlist [lreplace $_dlist $pos $pos]
     1130                        catch {unset _dobj2transparency($dataobj)}
     1131                        catch {unset _dobj2color($dataobj)}
     1132                        catch {unset _dobj2width($dataobj)}
     1133                        catch {unset _dobj2dashes($dataobj)}
     1134                        catch {unset _dobj2raise($dataobj)}
     1135            set changed 1
     1136                }
     1137        }
     1138
     1139        # if anything changed, then rebuild the plot
     1140        if {$changed} {
     1141        $itk_component(3dview) configure -cursor watch
     1142        $_dispatcher event -idle !rebuild
     1143        }
     1144}
     1145
     1146# ----------------------------------------------------------------------
     1147# OPTION: -device
     1148# ----------------------------------------------------------------------
     1149itcl::configbody Rappture::MolvisViewer::device {
     1150    #puts stderr "Rappture::MolvisViewer::device($itk_option(-device))"
     1151
     1152    if {$itk_option(-device) != "" } {
     1153
     1154        if {![Rappture::library isvalid $itk_option(-device)]} {
     1155            error "bad value \"$itk_option(-device)\": should be Rappture::library object"
     1156        }
     1157                $this delete
     1158                $this add $itk_option(-device)
     1159        } else {
     1160                $this delete
     1161        }
    8901162
    8911163    $_dispatcher event -idle !rebuild
Note: See TracChangeset for help on using the changeset viewer.