Changeset 772 for trunk/gui


Ignore:
Timestamp:
Jun 14, 2007, 6:55:08 PM (17 years ago)
Author:
mmc
Message:

Fixed up the rendering controls for the MolvisViewer?.

Location:
trunk/gui/scripts
Files:
1 added
4 edited

Legend:

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

    r770 r772  
    3636
    3737    public method emblems {option}
     38    public method rock {option}
    3839    public method representation {option {model "all"} }
    3940
     
    4243    public method isconnected {}
    4344    public method download {option args}
    44     protected method _rock {option}
    4545    protected method _sendit {args}
    4646    protected method _send {args}
     
    4949    protected method _rebuild { }
    5050    protected method _zoom {option}
    51         protected method _configure {w h}
    52         protected method _unmap {}
    53         protected method _map {}
     51    protected method _configure {w h}
     52    protected method _unmap {}
     53    protected method _map {}
    5454    protected method _vmouse2 {option b m x y}
    5555    protected method _vmouse  {option b m x y}
     
    7272    private variable _model
    7373    private variable _mlist
     74    private variable _mrepresentation "ball_and_stick"
    7475
    7576    private variable _imagecache
     
    7879    private variable _cacheid ""
    7980    private variable _hostlist ""
    80     private variable _mrepresentation "spheres"
    8181    private variable _cacheimage ""
    82         private variable _busy 0
    83         private variable _mapped 0
     82    private variable _busy 0
     83    private variable _mapped 0
     84
     85    common settings  ;# array of settings for all known widgets
    8486}
    8587
     
    99101    set _rocker(on) 0
    100102    set _state(server) 1
    101         set _state(client) 1
     103    set _state(client) 1
     104
     105    array set settings [list \
     106        $this-model $_mrepresentation \
     107        $this-modelimg [image create photo -width 64 -height 64] \
     108        $this-emblems 0 \
     109        $this-rock 0 \
     110    ]
     111    $settings($this-modelimg) copy [Rappture::icon ballnstick]
    102112
    103113    Rappture::dispatcher _dispatcher
     
    119129    pack $itk_component(controls) -side right -fill y
    120130
     131    itk_component add zoom {
     132        frame $itk_component(controls).zoom
     133    } {
     134        usual
     135        rename -background -controlbackground controlBackground Background
     136    }
     137    pack $itk_component(zoom) -side top
     138
    121139    itk_component add reset {
    122         button $itk_component(controls).reset \
     140        button $itk_component(zoom).reset \
    123141            -borderwidth 1 -padx 1 -pady 1 \
    124142            -bitmap [Rappture::icon reset] \
     
    129147        rename -highlightbackground -controlbackground controlBackground Background
    130148    }
    131     pack $itk_component(reset) -padx 4 -pady 4
     149    pack $itk_component(reset) -side left -padx {4 1} -pady 4
    132150    Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
    133151
    134152    itk_component add zoomin {
    135         button $itk_component(controls).zin \
     153        button $itk_component(zoom).zin \
    136154            -borderwidth 1 -padx 1 -pady 1 \
    137155            -bitmap [Rappture::icon zoomin] \
     
    142160        rename -highlightbackground -controlbackground controlBackground Background
    143161    }
    144     pack $itk_component(zoomin) -padx 4 -pady 4
     162    pack $itk_component(zoomin) -side left -padx 1 -pady 4
    145163    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
    146164
    147165    itk_component add zoomout {
    148         button $itk_component(controls).zout \
     166        button $itk_component(zoom).zout \
    149167            -borderwidth 1 -padx 1 -pady 1 \
    150168            -bitmap [Rappture::icon zoomout] \
     
    155173        rename -highlightbackground -controlbackground controlBackground Background
    156174    }
    157     pack $itk_component(zoomout) -padx 4 -pady 4
     175    pack $itk_component(zoomout) -side left -padx {1 4} -pady 4
    158176
    159177    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
    160178
     179    #
     180    # Settings panel...
     181    #
     182    itk_component add settings {
     183        button $itk_component(controls).settings -text "Settings..." \
     184            -borderwidth 1 -relief flat -overrelief raised \
     185            -padx 2 -pady 1 \
     186            -command [list $itk_component(controls).panel activate $itk_component(controls).settings left]
     187    } {
     188        usual
     189        ignore -borderwidth
     190        rename -background -controlbackground controlBackground Background
     191        rename -highlightbackground -controlbackground controlBackground Background
     192    }
     193    pack $itk_component(settings) -side top -pady {8 2}
     194
     195    Rappture::Balloon $itk_component(controls).panel -title "Rendering Options"
     196    set inner [$itk_component(controls).panel component inner]
     197    frame $inner.model
     198    pack $inner.model -side top -fill x
     199    set fg [option get $itk_component(hull) font Font]
     200
     201    label $inner.model.pict -image $settings($this-modelimg)
     202    pack $inner.model.pict -side left -anchor n
     203    label $inner.model.heading -text "Method for drawing atoms:"
     204    pack $inner.model.heading -side top -anchor w
     205    radiobutton $inner.model.bstick -text "Balls and sticks" \
     206        -command [itcl::code $this representation ball_and_stick all] \
     207        -variable Rappture::MolvisViewer::settings($this-model) -value ball_and_stick
     208    pack $inner.model.bstick -side top -anchor w
     209    radiobutton $inner.model.spheres -text "Spheres" \
     210        -command [itcl::code $this representation spheres all] \
     211        -variable Rappture::MolvisViewer::settings($this-model) -value spheres
     212    pack $inner.model.spheres -side top -anchor w
     213    radiobutton $inner.model.lines -text "Lines" \
     214        -command [itcl::code $this representation lines all] \
     215        -variable Rappture::MolvisViewer::settings($this-model) -value lines
     216    pack $inner.model.lines -side top -anchor w
     217
     218    checkbutton $inner.labels -text "Show labels on atoms" \
     219        -command [itcl::code $this emblems update] \
     220        -variable Rappture::MolvisViewer::settings($this-emblems)
     221    pack $inner.labels -side top -anchor w -pady {4 1}
     222
     223    checkbutton $inner.rock -text "Rock model back and forth" \
     224        -command [itcl::code $this rock toggle] \
     225        -variable Rappture::MolvisViewer::settings($this-rock)
     226    pack $inner.rock -side top -anchor w -pady {1 4}
     227
     228    #
     229    # Shortcuts
     230    #
     231    itk_component add shortcuts {
     232        frame $itk_component(controls).shortcuts
     233    } {
     234        usual
     235        rename -background -controlbackground controlBackground Background
     236    }
     237    pack $itk_component(shortcuts) -side top
     238
    161239    itk_component add labels {
    162         label $itk_component(controls).labels \
     240        label $itk_component(shortcuts).labels \
    163241            -borderwidth 1 -padx 1 -pady 1 \
    164242            -relief "raised" -bitmap [Rappture::icon atoms]
     
    168246        rename -highlightbackground -controlbackground controlBackground Background
    169247    }
    170     pack $itk_component(labels) -padx 4 -pady 4 -ipadx 1 -ipady 1
     248    pack $itk_component(labels) -side left -padx {4 1} -pady 4 -ipadx 1 -ipady 1
    171249    Rappture::Tooltip::for $itk_component(labels) "Show/hide the labels on atoms"
    172250    bind $itk_component(labels) <ButtonPress> \
     
    174252
    175253    itk_component add rock {
    176         label $itk_component(controls).rock \
     254        label $itk_component(shortcuts).rock \
    177255            -borderwidth 1 -padx 1 -pady 1 \
    178             -relief "raised" -text "R" \
     256            -relief "raised" -bitmap [Rappture::icon rocker]
    179257    } {
    180258        usual
     
    182260        rename -highlightbackground -controlbackground controlBackground Background
    183261    }
    184     pack $itk_component(rock) -padx 4 -pady 4 -ipadx 1 -ipady 1
    185     Rappture::Tooltip::for $itk_component(rock) "Rock model +/- 10 degrees"
    186 
    187     itk_component add show_lines {
    188             label $itk_component(controls).show_lines \
    189             -borderwidth 1 -padx 1 -pady 1 \
    190             -relief "raised" -text "/" \
    191     } {
    192         usual
    193         ignore -borderwidth
    194         rename -highlightbackground -controlbackground controlBackground Background
    195     }
    196     pack $itk_component(show_lines) -padx 4 -pady 4
    197     bind $itk_component(show_lines) <ButtonPress> \
    198         [itcl::code $this representation lines all]
    199 
    200         itk_component add show_spheres {
    201             label $itk_component(controls).show_spheres \
    202             -borderwidth 1 -padx 1 -pady 1 \
    203             -relief "sunken" -text "O" \
    204     } {
    205         usual
    206         ignore -borderwidth
    207         rename -highlightbackground -controlbackground controlBackground Background
    208     }
    209     pack $itk_component(show_spheres) -padx 4 -pady 4
    210     bind $itk_component(show_spheres) <ButtonPress> \
    211         [itcl::code $this representation spheres all]
    212 
    213     itk_component add show_ball_and_stick {
    214             label $itk_component(controls).show_ball_and_stick \
    215             -borderwidth 1 -padx 1 -pady 1 \
    216             -relief "raised" -text "%" \
    217     } {
    218         usual
    219         ignore -borderwidth
    220         rename -highlightbackground -controlbackground controlBackground Background
    221     }
    222     pack $itk_component(show_ball_and_stick) -padx 4 -pady 4
    223     bind $itk_component(show_ball_and_stick) <ButtonPress> \
    224         [itcl::code $this representation ball_and_stick all]
    225    
     262    pack $itk_component(rock) -side left -padx 1 -pady 4 -ipadx 1 -ipady 1
     263    Rappture::Tooltip::for $itk_component(rock) "Rock model back and forth"
     264
    226265    bind $itk_component(rock) <ButtonPress> \
    227         [itcl::code $this _rock toggle]
     266        [itcl::code $this rock toggle]
    228267
    229268    #
     
    270309    #    [itcl::code $this _vmouse2 move 0 %s %x %y]
    271310
    272         connect $hostlist
     311    connect $hostlist
    273312
    274313    bind $itk_component(3dview) <Configure> \
     
    290329itcl::body Rappture::MolvisViewer::destructor {} {
    291330    #puts stderr "MolvisViewer::destructor()"
     331    disconnect
     332
    292333    image delete $_image(plot)
    293         disconnect
     334    image delete $settings($this-modelimg)
     335    unset settings($this-emblems)
     336    unset settings($this-rock)
     337    unset settings($this-model)
     338    unset settings($this-modelimg)
    294339}
    295340
     
    356401
    357402    set hosts [lrange $hosts 1 end]
    358         set result 0
     403    set result 0
    359404
    360405    while {1} {
     
    387432        if {[string equal $hostname "0.0.0.0"]} {
    388433            set _sid $sid
    389                         set _rocker(server) 0
    390                         set _cacheid 0
     434            set _rocker(server) 0
     435            set _cacheid 0
    391436
    392437            fileevent $_sid readable [itcl::code $this _receive $_sid]
     
    396441
    397442            set result 1
    398                         break
     443            break
    399444        }
    400445    }
     
    414459    #puts stderr "MolvisViewer::disconnect()"
    415460
    416         catch { fileevent $_sid readable {} }
     461    catch { fileevent $_sid readable {} }
    417462    catch { after cancel $_rocker(afterid) }
    418         catch { after cancel $_mevent(afterid) }
     463    catch { after cancel $_mevent(afterid) }
    419464    catch { close $_sid }
    420465    catch { unset _dataobjs }
    421         catch { unset _model }
    422         catch { unset _mlist }
     466    catch { unset _model }
     467    catch { unset _mlist }
    423468    catch { unset _imagecache }
    424469
    425470    set _sid ""
    426         set _state(server) 1
    427         set _state(client) 1
     471    set _state(server) 1
     472    set _state(client) 1
    428473}
    429474
     
    449494    if { $_sid != "" } {
    450495        if { ![catch { puts $_sid $args }] } {
    451                     flush $_sid
    452                         return 0
    453                 } else {
     496            flush $_sid
     497            return 0
     498        } else {
    454499            catch { close $_sid }
    455500            set _sid ""
    456                 }
    457         }
     501        }
     502    }
    458503
    459504    $_dispatcher event -after 1 !rebuild
    460505
    461         return 1
     506    return 1
    462507}
    463508
     
    469514            set _state(server) $_state(client)
    470515        }
    471         }
     516    }
    472517
    473518    if { $_rocker(server) != $_rocker(client) } {
    474519        if { [_sendit "rock -defer $_rocker(client)"]  == 0 } {
    475520            set _rocker(server) $_rocker(client)
    476             }
    477         }
     521        }
     522    }
    478523
    479524    eval _sendit $args
     
    491536
    492537    if { $sid == "" } {
    493             return
    494         }
    495 
    496         fileevent $sid readable {}
     538        return
     539    }
     540
     541    fileevent $sid readable {}
    497542
    498543    if { $sid != $_sid } {
    499             return
    500         }
     544        return
     545    }
    501546
    502547    fconfigure $_sid -buffering line -blocking 0
     
    505550
    506551        if { ![fblocked $_sid] } {
    507                     catch { close $_sid }
    508                         set _sid ""
     552            catch { close $_sid }
     553            set _sid ""
    509554            $_dispatcher event -after 750 !serverDown
    510                 }
     555        }
    511556
    512557    }  elseif {[regexp {^\s*nv>\s*image\s+(\d+)\s*(\d+)\s*,\s*(\d+)\s*,\s*(-{0,1}\d+)} $line whole match cacheid frame rock]} {
    513558
    514559        set tag "$frame,$rock"
    515                
     560           
    516561        if { $cacheid != $_cacheid } {
    517562            catch { unset _imagecache }
     
    521566        fconfigure $_sid -buffering none -blocking 1
    522567        set _imagecache($tag) [read $_sid $match]
    523             #puts stderr "CACHED: $tag,$cacheid"
     568        #puts stderr "CACHED: $tag,$cacheid"
    524569        $_image(plot) put $_imagecache($tag)
    525570        set _image(id) $tag
    526571
    527                 if { $_busy } {
     572        if { $_busy } {
    528573            $itk_component(3dview) configure -cursor ""
    529                     set _busy 0
    530                 }
     574            set _busy 0
     575        }
    531576
    532577    } else {
     
    535580    }
    536581   
    537         if { $_sid != "" } {
     582    if { $_sid != "" } {
    538583        fileevent $_sid readable [itcl::code $this _receive $_sid]
    539584    }
     
    551596
    552597    if { $_inrebuild } {
    553                 # don't allow overlapping rebuild calls
    554             return
    555         }
    556 
    557         set _inrebuild 1
     598        # don't allow overlapping rebuild calls
     599        return
     600    }
     601
     602    set _inrebuild 1
    558603
    559604    if {"" == $_sid} {
     
    573618        } else {
    574619            Rappture::Tooltip::cue @$x,$y "Can't connect to visualization server.  This may be a network problem.  Wait a few moments and try resetting the view."
    575                     set _inrebuild 0
    576                 set _busy 1
     620            set _inrebuild 0
     621            set _busy 1
    577622            return
    578                 }
    579     }
    580 
    581         set changed 0
    582         set _busy 1
     623        }
     624    }
     625
     626    set changed 0
     627    set _busy 1
    583628
    584629    $itk_component(3dview) configure -cursor watch
    585630
    586         # refresh GUI (primarily to make pending cursor changes visible)
     631    # refresh GUI (primarily to make pending cursor changes visible)
    587632    update idletasks
    588633
     
    596641            set model "molecule"
    597642            scan $dev "::libraryObj%d" suffix
    598             set model $model$suffix     
     643            set model $model$suffix
    599644        }
    600645
    601646        if {"" == $state} { set state $_state(server) }
    602647
    603                 if { ![info exists _mlist($model)] } { # new, turn on
    604                     set _mlist($model) 2
    605                 } elseif { $_mlist($model) == 1 } { # on, leave on
    606                     set _mlist($model) 3
    607                 } elseif { $_mlist($model) == 0 } { # off, turn on
    608                     set _mlist($model) 2
    609                 }
     648        if { ![info exists _mlist($model)] } { # new, turn on
     649            set _mlist($model) 2
     650        } elseif { $_mlist($model) == 1 } { # on, leave on
     651            set _mlist($model) 3
     652        } elseif { $_mlist($model) == 0 } { # off, turn on
     653            set _mlist($model) 2
     654        }
    610655
    611656        if { ![info exists _dataobjs($model-$state)] } {
    612                 set data1      ""
    613                 set serial   0
     657            set data1      ""
     658            set serial   0
    614659
    615660            foreach _atom [$dev children -type atom components.molecule] {
     
    618663                regsub {,} $xyz {} xyz
    619664                scan $xyz "%f %f %f" x y z
    620                         set recname  "ATOM  "
    621                         set altLoc   ""
    622                         set resName  ""
    623                         set chainID  ""
    624                         set Seqno    ""
    625                         set occupancy  1
    626                         set tempFactor 0
    627                         set recID      ""
    628                         set segID      ""
    629                         set element    ""
    630                         set charge     ""
     665                set recname  "ATOM  "
     666                set altLoc   ""
     667                set resName  ""
     668                set chainID  ""
     669                set Seqno    ""
     670                set occupancy  1
     671                set tempFactor 0
     672                set recID      ""
     673                set segID      ""
     674                set element    ""
     675                set charge     ""
    631676                set atom $symbol
    632677                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]
     
    650695        }
    651696
    652                 if { ![info exists _model($model-transparency)] } {
    653                         set _model($model-transparency) "undefined"
    654                 }
    655 
    656                 if { ![info exists _model($model-representation)] } {
    657                         set _model($model-representation) "undefined"
    658                         set _model($model-newrepresentation) $_mrepresentation
    659                 }
    660 
    661 
    662                 if { $_model($model-transparency) != $_dobj2transparency($dev) } {
    663                         set  _model($model-newtransparency) $_dobj2transparency($dev)
    664                 }
     697        if { ![info exists _model($model-transparency)] } {
     698            set _model($model-transparency) "undefined"
     699        }
     700
     701        if { ![info exists _model($model-representation)] } {
     702            set _model($model-representation) "undefined"
     703            set _model($model-newrepresentation) $_mrepresentation
     704        }
     705
     706
     707        if { $_model($model-transparency) != $_dobj2transparency($dev) } {
     708            set  _model($model-newtransparency) $_dobj2transparency($dev)
     709        }
    665710    }
    666711
     
    670715        if { $_mlist($obj) == 1 } {
    671716            _send disable -defer $obj
    672                         set _mlist($obj) 0
    673                 set changed 1
    674                 } elseif { $_mlist($obj) == 2 } {
    675                         set _mlist($obj) 1
    676                         _send enable -defer $obj
    677                     if { $_labels } {
    678                                 _send label -defer on
    679                         } else {
    680                                 _send label -defer off
    681                         }
    682                 set changed 1
    683                 } elseif { $_mlist($obj) == 3 } {
    684                     set _mlist($obj) 1
    685                 }
    686 
    687 
    688                 if { $_mlist($obj) == 1 } {
    689                         if {  [info exists _model($obj-newtransparency)] || [info exists _model($obj-newrepresentation)] } {
    690                                 if { ![info exists _model($obj-newrepresentation)] } {
    691                                         set _model($obj-newrepresentation) $_model($obj-representation)
    692                                 }
    693                                 if { ![info exists _model($obj-newtransparency)] } {
    694                                         set _model($obj-newtransparency) $_model($obj-transparency)
    695                                 }
    696                                 _send $_model($obj-newrepresentation) -defer -model $obj -$_model($obj-newtransparency)
    697                                 set changed 1
    698                             set _model($obj-transparency) $_model($obj-newtransparency)
    699                             set _model($obj-representation) $_model($obj-newrepresentation)
    700                             catch {
    701                                     unset _model($obj-newtransparency)
    702                                 unset _model($obj-newrepresentation)
    703                                 }
    704                         }
    705                 }
    706 
    707         }
    708 
    709         if { $changed } {
     717            set _mlist($obj) 0
     718            set changed 1
     719        } elseif { $_mlist($obj) == 2 } {
     720            set _mlist($obj) 1
     721            _send enable -defer $obj
     722            if { $_labels } {
     723                _send label -defer on
     724            } else {
     725                _send label -defer off
     726            }
     727            set changed 1
     728        } elseif { $_mlist($obj) == 3 } {
     729            set _mlist($obj) 1
     730        }
     731
     732
     733        if { $_mlist($obj) == 1 } {
     734            if {  [info exists _model($obj-newtransparency)] || [info exists _model($obj-newrepresentation)] } {
     735                if { ![info exists _model($obj-newrepresentation)] } {
     736                    set _model($obj-newrepresentation) $_model($obj-representation)
     737                }
     738                if { ![info exists _model($obj-newtransparency)] } {
     739                    set _model($obj-newtransparency) $_model($obj-transparency)
     740                }
     741                _send $_model($obj-newrepresentation) -defer -model $obj -$_model($obj-newtransparency)
     742                set changed 1
     743                set _model($obj-transparency) $_model($obj-newtransparency)
     744                set _model($obj-representation) $_model($obj-newrepresentation)
     745                catch {
     746                    unset _model($obj-newtransparency)
     747                    unset _model($obj-newrepresentation)
     748                }
     749            }
     750        }
     751
     752    }
     753
     754    if { $changed } {
    710755        catch { unset _imagecache }
    711         }
     756    }
    712757
    713758    if { $dlist == "" } {
    714                 set _state(server) 1
    715                 set _state(client) 1
    716                 _send frame -push 1
    717         } elseif { ![info exists _imagecache($state,$_rocker(client))] } {
    718                 set _state(server) $state
    719                 set _state(client) $state
     759        set _state(server) 1
     760        set _state(client) 1
     761        _send frame -push 1
     762    } elseif { ![info exists _imagecache($state,$_rocker(client))] } {
     763        set _state(server) $state
     764        set _state(client) $state
    720765        _send frame -push $state
    721766    } else {
    722                 set _state(client) $state
    723                 _update
    724         }
    725 
    726         set _inrebuild 0
    727 
    728         if { $_sid == "" } {
    729             # connection failed during rebuild, don't attempt to reconnect/rebuild
    730                 # until user initiates some action
    731 
    732                 disconnect
     767        set _state(client) $state
     768        _update
     769    }
     770
     771    set _inrebuild 0
     772
     773    if { $_sid == "" } {
     774        # connection failed during rebuild, don't attempt to reconnect/rebuild
     775        # until user initiates some action
     776
     777        disconnect
    733778        $_dispatcher cancel !rebuild
    734779        $_dispatcher event -after 750 !serverDown
    735         }
     780    }
     781    $itk_component(3dview) configure -cursor ""
    736782}
    737783
     
    740786
    741787    #pause rocking loop while unmapped (saves CPU time)
    742         _rock pause
    743 
    744         # blank image, mark current image dirty
    745         # this will force reload from cache, or remain blank if cache is cleared
    746         # this prevents old image from briefly appearing when a new result is added
    747         # by result viewer
     788    rock pause
     789
     790    # blank image, mark current image dirty
     791    # this will force reload from cache, or remain blank if cache is cleared
     792    # this prevents old image from briefly appearing when a new result is added
     793    # by result viewer
    748794
    749795    set _mapped 0
    750796    $_image(plot) blank
    751         set _image(id) ""
     797    set _image(id) ""
    752798}
    753799
     
    757803    set _mapped 1
    758804
    759         # resume rocking loop if it was on
    760         _rock unpause
    761 
    762         # rebuild image if modified, or redisplay cached image if not
     805    # resume rocking loop if it was on
     806    rock unpause
     807
     808    # rebuild image if modified, or redisplay cached image if not
    763809    $_dispatcher event -idle !rebuild
    764810}
     
    769815    $_image(plot) configure -width $w -height $h
    770816   
    771         # immediately invalidate cache, defer update until mapped
    772        
    773         catch { unset _imagecache }
     817    # immediately invalidate cache, defer update until mapped
     818   
     819    catch { unset _imagecache }
    774820
    775821    if { $_mapped } {
    776822        _send screen $w $h
    777         } else {
     823    } else {
    778824        _send screen -defer $w $h
    779         }
     825    }
    780826}
    781827
     
    808854    if { $_image(id) != "$_state(client),$_rocker(client)" } {
    809855        if { [info exists _imagecache($_state(client),$_rocker(client))] } {
    810                 #puts stderr "DISPLAYING CACHED IMAGE"
     856            #puts stderr "DISPLAYING CACHED IMAGE"
    811857            $_image(plot) put $_imagecache($_state(client),$_rocker(client))
    812                 set _image(id) "$_state(client),$_rocker(client)"
    813         }
    814         }
    815 }
    816 
    817 # ----------------------------------------------------------------------
    818 # USAGE: _vmouse click <x> <y>
    819 # USAGE: _vmouse drag <x> <y>
    820 # USAGE: _vmouse release <x> <y>
    821 #
    822 # Called automatically when the user clicks/drags/releases in the
    823 # plot area.  Moves the plot according to the user's actions.
    824 # ----------------------------------------------------------------------
    825 
    826 itcl::body Rappture::MolvisViewer::_rock { option } {
     858            set _image(id) "$_state(client),$_rocker(client)"
     859        }
     860    }
     861}
     862
     863# ----------------------------------------------------------------------
     864# USAGE: rock on|off|toggle
     865# USAGE: rock pause|unpause|step
     866#
     867# Used to control the "rocking" model for the molecule being displayed.
     868# Clients should use only the on/off/toggle options; the rest are for
     869# internal control of the rocking motion.
     870# ----------------------------------------------------------------------
     871itcl::body Rappture::MolvisViewer::rock { option } {
    827872    #puts "MolvisViewer::_rock($option,$_rocker(client))"
    828873   
     
    841886    }
    842887
    843     if { $option == "on" || $option == "toggle" && !$_rocker(on) } {
     888    if { $option == "on" || ($option == "toggle" && !$_rocker(on)) } {
    844889        set _rocker(on) 1
     890        set settings($this-rock) 1
    845891        $itk_component(rock) configure -relief sunken
    846     } elseif { $option == "off" || $option == "toggle" && $_rocker(on) } {
     892    } elseif { $option == "off" || ($option == "toggle" && $_rocker(on)) } {
    847893        set _rocker(on) 0
     894        set settings($this-rock) 0
    848895        $itk_component(rock) configure -relief raised
    849896    } elseif { $option == "step"} {
     
    852899            set _rocker(dir) -1
    853900        } elseif { $_rocker(client) <= -10 } {
    854                     set _rocker(dir) 1
    855         }
    856 
    857             set _rocker(client) [expr $_rocker(client) + $_rocker(dir)]
     901            set _rocker(dir) 1
     902        }
     903
     904        set _rocker(client) [expr {$_rocker(client) + $_rocker(dir)}]
    858905   
    859906        if { ![info exists _imagecache($_state(server),$_rocker(client))] } {
    860                 set _rocker(server) $_rocker(client)
     907            set _rocker(server) $_rocker(client)
    861908            _send rock $_rocker(client)
    862909        }
    863            
    864             _update
    865     }
    866 
    867         if { $_rocker(on) && $option != "pause" } {
    868                  set _rocker(afterid) [after 200 [itcl::code $this _rock step]]
    869         }
     910        _update
     911    }
     912
     913    if { $_rocker(on) && $option != "pause" } {
     914         set _rocker(afterid) [after 200 [itcl::code $this rock step]]
     915    }
    870916}
    871917
     
    911957    }
    912958
    913         if { ![info exists _mevent(x)] } {
    914                 set option "click"
    915         }
     959    if { ![info exists _mevent(x)] } {
     960        set option "click"
     961    }
    916962
    917963    if { $option == "click" } {
     
    920966
    921967    if { $option == "drag" || $option == "release" } {
    922             set diff 0
     968        set diff 0
    923969        catch { set diff [expr $now - $_mevent(time) ] }
    924970
     
    948994            set mz $dy
    949995        } elseif { $_mevent(x) < $x2 } {
    950             set mx $dy 
     996            set mx $dy
    951997        } else {
    952998            set mz [expr -$dy]
     
    9561002            set mz [expr -$dx]
    9571003        } elseif { $_mevent(y) < $y2 } {
    958             set my $dx 
     1004            set my $dx
    9591005        } else {
    9601006            set mz $dx
     
    9871033    set y [expr {[winfo rooty $itk_component(area)]+10}]
    9881034
    989         if { $_busy } {
     1035    if { $_busy } {
    9901036        $itk_component(3dview) configure -cursor ""
    9911037        set _busy 0
    992         }
     1038    }
    9931039
    9941040    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."
     
    10101056    switch -- $option {
    10111057        spheres {
    1012              $itk_component(show_spheres) configure -relief sunken
    1013              $itk_component(show_lines) configure -relief raised
    1014              $itk_component(show_ball_and_stick) configure -relief raised
     1058            $settings($this-modelimg) copy [Rappture::icon spheres]
    10151059        }
    10161060        ball_and_stick {
    1017              $itk_component(show_spheres) configure -relief raised
    1018              $itk_component(show_lines) configure -relief raised
    1019              $itk_component(show_ball_and_stick) configure -relief sunken
     1061            $settings($this-modelimg) copy [Rappture::icon ballnstick]
    10201062        }
    10211063        lines {
    1022             $itk_component(show_spheres) configure -relief raised
    1023             $itk_component(show_lines) configure -relief sunken
    1024             $itk_component(show_ball_and_stick) configure -relief raised
    1025         }
    1026                 default {
    1027                         return
    1028                 }
    1029         }
     1064            $settings($this-modelimg) copy [Rappture::icon lines]
     1065        }
     1066        default {
     1067            return
     1068        }
     1069    }
     1070
     1071    # save the current option to set all radiobuttons -- just in case
     1072    # this method gets called without the user clicking on a radiobutton
     1073    set settings($this-model) $option
    10301074
    10311075    set _mrepresentation $option
     
    10331077    if { $model == "all" } {
    10341078        set models [array names _mlist]
    1035         } else {
    1036             set models $model
    1037         }
     1079    } else {
     1080        set models $model
     1081    }
    10381082
    10391083    foreach obj $models {
    1040                 if { [info exists _model($obj-representation)] } {
    1041                         if { $_model($obj-representation) != $option } {
    1042                         set _model($obj-newrepresentation) $option
    1043                         } else {
    1044                                 catch { unset _model($obj-newrepresentation) }
    1045                         }
    1046                 }
    1047         }
     1084        if { [info exists _model($obj-representation)] } {
     1085            if { $_model($obj-representation) != $option } {
     1086                set _model($obj-newrepresentation) $option
     1087            } else {
     1088                catch { unset _model($obj-newrepresentation) }
     1089            }
     1090        }
     1091    }
    10481092
    10491093    $_dispatcher event -idle !rebuild
     
    10511095
    10521096# ----------------------------------------------------------------------
    1053 # USAGE: emblems on
    1054 # USAGE: emblems off
    1055 # USAGE: emblems toggle
     1097# USAGE: emblems on|off|toggle
     1098# USAGE: emblems update
    10561099#
    10571100# Used internally to turn labels associated with atoms on/off, and to
     
    10601103itcl::body Rappture::MolvisViewer::emblems {option} {
    10611104    #puts stderr "MolvisViewer::emblems($option)"
    1062 
    1063     if {[$itk_component(labels) cget -relief] == "sunken"} {
    1064         set current_emblem 1
    1065     } else {
    1066         set current_emblem 0
    1067     }
    10681105
    10691106    switch -- $option {
     
    10751112        }
    10761113        toggle {
    1077             if { $current_emblem == 1 } {
     1114            if {$settings($this-emblems)} {
    10781115                set emblem 0
    10791116            } else {
     
    10811118            }
    10821119        }
     1120        update {
     1121            set emblem $settings($this-emblems)
     1122        }
    10831123        default {
    1084             error "bad option \"$option\": should be on, off, toggle"
     1124            error "bad option \"$option\": should be on, off, toggle, update"
    10851125        }
    10861126    }
     
    10881128    set _labels $emblem
    10891129
    1090     if {$emblem == $current_emblem} { return }
     1130    if {$emblem == $settings($this-emblems) && $option != "update"} {
     1131        # nothing to do
     1132        return
     1133    }
    10911134
    10921135    if {$emblem} {
    10931136        $itk_component(labels) configure -relief sunken
     1137        set settings($this-emblems) 1
    10941138        _send label on
    10951139    } else {
    10961140        $itk_component(labels) configure -relief raised
     1141        set settings($this-emblems) 0
    10971142        _send label off
    10981143    }
     
    11111156
    11121157    array set params {
    1113             -color auto
    1114                 -brightness 0
    1115                 -width 1
    1116                 -raise 0
    1117                 -linestyle solid
    1118                 -description ""
    1119                 -param ""
    1120         }
    1121 
    1122         foreach {opt val} $settings {
    1123             if {![info exists params($opt)]} {
    1124                     error "bad settings \"$opt\": should be [join [lsort [array names params]] {, }]"
    1125                 }
    1126                 set params($opt) $val
    1127         }
     1158        -color auto
     1159        -brightness 0
     1160        -width 1
     1161        -raise 0
     1162        -linestyle solid
     1163        -description ""
     1164        -param ""
     1165    }
     1166
     1167    foreach {opt val} $settings {
     1168        if {![info exists params($opt)]} {
     1169            error "bad settings \"$opt\": should be [join [lsort [array names params]] {, }]"
     1170        }
     1171        set params($opt) $val
     1172    }
    11281173 
    1129         set pos [lsearch -exact $dataobj $_dlist]
    1130 
    1131         if {$pos < 0} {
     1174    set pos [lsearch -exact $dataobj $_dlist]
     1175
     1176    if {$pos < 0} {
    11321177        if {![Rappture::library isvalid $dataobj]} {
    11331178            error "bad value \"$dataobj\": should be Rappture::library object"
    11341179        }
    1135        
    1136             if { $_labels == "default" } {
     1180   
     1181        if { $_labels == "default" } {
    11371182            set emblem [$dataobj get components.molecule.about.emblems]
    11381183
     
    11441189        }
    11451190
    1146             lappend _dlist $dataobj
    1147                 if { $params(-brightness) >= 0.5 } {
    1148                         set _dobj2transparency($dataobj) "ghost"
    1149                 } else {
    1150                         set _dobj2transparency($dataobj) "normal"
    1151                 }
    1152                 set _dobj2raise($dataobj) $params(-raise)
     1191        lappend _dlist $dataobj
     1192        if { $params(-brightness) >= 0.5 } {
     1193            set _dobj2transparency($dataobj) "ghost"
     1194        } else {
     1195            set _dobj2transparency($dataobj) "normal"
     1196        }
     1197        set _dobj2raise($dataobj) $params(-raise)
    11531198
    11541199        $_dispatcher event -idle !rebuild
     
    11661211
    11671212    # put the dataobj list in order according to -raise options
    1168         set dlist $_dlist
    1169         foreach obj $dlist {
    1170             if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
    1171                     set i [lsearch -exact $dlist $obj]
    1172                         if {$i >= 0} {
    1173                             set dlist [lreplace $dlist $i $i]
    1174                                 lappend dlist $obj
    1175                         }
    1176                 }
    1177         }
    1178         return $dlist
     1213    set dlist $_dlist
     1214    foreach obj $dlist {
     1215        if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
     1216            set i [lsearch -exact $dlist $obj]
     1217            if {$i >= 0} {
     1218                set dlist [lreplace $dlist $i $i]
     1219                lappend dlist $obj
     1220            }
     1221        }
     1222    }
     1223    return $dlist
    11791224}
    11801225
     
    11891234
    11901235    if {[llength $args] == 0} {
    1191             set args $_dlist
    1192         }
    1193 
    1194         # delete all specified dataobjs
    1195         set changed 0
    1196         foreach dataobj $args {
    1197             set pos [lsearch -exact $_dlist $dataobj]
    1198                 if {$pos >= 0} {
    1199                     set _dlist [lreplace $_dlist $pos $pos]
    1200                         catch {unset _dobj2transparency($dataobj)}
    1201                         catch {unset _dobj2color($dataobj)}
    1202                         catch {unset _dobj2width($dataobj)}
    1203                         catch {unset _dobj2dashes($dataobj)}
    1204                         catch {unset _dobj2raise($dataobj)}
     1236        set args $_dlist
     1237    }
     1238
     1239    # delete all specified dataobjs
     1240    set changed 0
     1241    foreach dataobj $args {
     1242        set pos [lsearch -exact $_dlist $dataobj]
     1243        if {$pos >= 0} {
     1244            set _dlist [lreplace $_dlist $pos $pos]
     1245            catch {unset _dobj2transparency($dataobj)}
     1246            catch {unset _dobj2color($dataobj)}
     1247            catch {unset _dobj2width($dataobj)}
     1248            catch {unset _dobj2dashes($dataobj)}
     1249            catch {unset _dobj2raise($dataobj)}
    12051250            set changed 1
    1206                 }
    1207         }
    1208 
    1209         # if anything changed, then rebuild the plot
    1210         if {$changed} {
     1251        }
     1252    }
     1253
     1254    # if anything changed, then rebuild the plot
     1255    if {$changed} {
    12111256        $_dispatcher event -idle !rebuild
    1212         }
     1257    }
    12131258}
    12141259
     
    12241269            error "bad value \"$itk_option(-device)\": should be Rappture::library object"
    12251270        }
    1226                 $this delete
    1227                 $this add $itk_option(-device)
    1228         } else {
    1229                 $this delete
    1230         }
     1271        $this delete
     1272        $this add $itk_option(-device)
     1273    } else {
     1274        $this delete
     1275    }
    12311276
    12321277    $_dispatcher event -idle !rebuild
    12331278}
    1234 
Note: See TracChangeset for help on using the changeset viewer.