Changeset 4104


Ignore:
Timestamp:
Jan 8, 2014 7:42:53 AM (9 years ago)
Author:
gah
Message:

Change render server identifier

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/packages/vizservers/vmd/vmdserver.tcl

    r4097 r4104  
    99# ======================================================================
    1010
     11# The VMD TCL interpreter is by default interactive.  Turn this off
     12# so that unknown commands like "scene" don't get exec-ed.
    1113set ::tcl_interactive 0
     14
     15proc bgerror {mesg} {
     16    puts stderr "SERVER ERROR: $mesg"
     17}
    1218
    1319# parse command line args
     
    3036
    3137# set the screen to a good size
    32 #display resize 300 300
     38set DisplaySize(w) 300
     39set DisplaySize(h) 300
     40display resize $DisplaySize(w) $DisplaySize(h)
     41set DisplaySize(changed) 0
    3342
    3443# initialize work queue and epoch counter (see server_send_image)
     
    3645set Work(queue) ""
    3746set Sendqueue ""
     47set Scenes(@CURRENT) ""
    3848
    3949set parser [interp create -safe]
     
    4252  vmdinfo
    4353  vmdbench
    44   animate
    4554  color
    4655  axes
     
    6473  render
    6574  tkrender
    66   rock
    6775  rotate
    6876  rotmat
     
    101109
    102110# ----------------------------------------------------------------------
    103 # USAGE: reset
    104 #
    105 # Executes the "command arg arg..." string in the server and substitutes
    106 # the result into the template string in place of each "%v" field.
    107 # Sends the result back to the client.
    108 # ----------------------------------------------------------------------
    109 proc cmd_reset {} {
    110     global client
    111 
    112     # reset the view so we get a good scale matrix below
    113     display resetview
    114 
    115     # reset scale -- figure out size by querying molinfo for first molecule
    116     set nmol [lindex [molinfo list] 0]
    117     if {$nmol ne ""} {
    118         set matrix [molinfo $nmol get scale_matrix]
    119         set sf [lindex [lindex [lindex $matrix 0] 0] 0]
    120         vmd_scale to $sf
    121         server_send_result $client "nv>scale $sf"
    122     }
    123 
    124     axes location off
    125 }
    126 $parser alias reset cmd_reset
    127 
    128 # ----------------------------------------------------------------------
    129111# USAGE: resize <w> <h>
    130112#
     
    133115# ----------------------------------------------------------------------
    134116proc cmd_resize {w h} {
    135     display resize $w $h
    136     display update
     117    global DisplayProps
     118
     119    # store the desired size in case we downscale
     120    set DisplayProps(framew) $w
     121    set DisplayProps(frameh) $h
     122
     123    server_safe_resize $w $h
    137124}
    138125$parser alias resize cmd_resize
     126
     127# ----------------------------------------------------------------------
     128# USAGE: setview ?-rotate <mtx>? ?-scale <mtx>? ?-center <mtx>? ?-global <mtx>?
     129#
     130# Sets the view matrix for one or more components of the view.  This
     131# is a convenient way of getting a view for a particular frame just
     132# right in one shot.
     133# ----------------------------------------------------------------------
     134proc cmd_setview {args} {
     135    if {[llength $args] == 8} {
     136        # setting all matrices? then start clean
     137        display resetview
     138    }
     139    foreach {key val} $args {
     140        switch -- $key {
     141            -rotate {
     142                molinfo top set rotate_matrix [list $val]
     143            }
     144            -scale {
     145                molinfo top set scale_matrix [list $val]
     146            }
     147            -center {
     148                molinfo top set center_matrix [list $val]
     149            }
     150            -global {
     151                molinfo top set global_matrix [list $val]
     152            }
     153            default {
     154                error "bad option \"$key\": should be -rotate, -scale, -center, or -global"
     155            }
     156        }
     157    }
     158}
     159$parser alias setview cmd_setview
     160
     161# ----------------------------------------------------------------------
     162# USAGE: drag start|end
     163#
     164# Resizes the visualization window to the given width <w> and height
     165# <h>.  The next image sent should be this size.
     166# ----------------------------------------------------------------------
     167proc cmd_drag {action} {
     168    global DisplayProps
     169
     170    switch -- $action {
     171        start {
     172            # simplify rendering so it goes faster during drag operations
     173            set neww [expr {round($DisplayProps(framew)/2.0)}]
     174            set newh [expr {round($DisplayProps(frameh)/2.0)}]
     175            server_safe_resize $neww $newh
     176            display rendermode Normal
     177            display shadows off
     178
     179            foreach nmol [molinfo list] {
     180                set max [molinfo $nmol get numreps]
     181                for {set nrep 0} {$nrep < $max} {incr nrep} {
     182                    mol modstyle $nrep $nmol "Lines"
     183                }
     184            }
     185        }
     186        end {
     187            # put original rendering options back
     188            server_safe_resize $DisplayProps(framew) $DisplayProps(frameh)
     189            display rendermode $DisplayProps(rendermode)
     190            display shadows $DisplayProps(shadows)
     191
     192            # restore rendering methods for all representations
     193            foreach nmol [molinfo list] {
     194                set max [molinfo $nmol get numreps]
     195                for {set nrep 0} {$nrep < $max} {incr nrep} {
     196                    mol modstyle $nrep $nmol $DisplayProps(rep-$nmol-$nrep)
     197                }
     198            }
     199        }
     200        default {
     201            error "bad option \"$action\": should be start or end"
     202        }
     203    }
     204}
     205$parser alias drag cmd_drag
     206
     207# ----------------------------------------------------------------------
     208# USAGE: smoothreps <value>
     209#
     210# Changes the smoothing factor for all representations of the current
     211# molecule.
     212# ----------------------------------------------------------------------
     213proc cmd_smoothreps {val} {
     214    if {$val < 0} {
     215        error "bad smoothing value \"$val\": should be >= 0"
     216    }
     217    foreach nmol [molinfo list] {
     218        set max [molinfo $nmol get numreps]
     219        for {set nrep 0} {$nrep < $max} {incr nrep} {
     220            mol smoothrep $nmol $nrep $val
     221        }
     222    }
     223}
     224$parser alias smoothreps cmd_smoothreps
     225
     226# ----------------------------------------------------------------------
     227# USAGE: animate <option> <args>...
     228# USAGE: rock off
     229# USAGE: rock x|y|z by <step> ?<n>?
     230#
     231# The usual VMD "animate" and "rock" commands are problematic for this
     232# server.  If we're going to rock or play the animation, the client
     233# will do it.  Intercept any "animate" and "rock" commands in the scene
     234# scripts and do nothing.
     235# ----------------------------------------------------------------------
     236proc cmd_animate {args} {
     237    # do nothing
     238}
     239$parser alias animate cmd_animate
     240
     241proc cmd_rock {args} {
     242    # do nothing
     243}
     244$parser alias rock cmd_rock
    139245
    140246# ----------------------------------------------------------------------
     
    149255        mol delete $nmol
    150256    }
    151 
    152     # clear any existing views
    153     cmd_view forget
    154257
    155258    # load new files
     
    163266
    164267# ----------------------------------------------------------------------
    165 # USAGE: view define <name> <script>
    166 # USAGE: view show <name>
    167 # USAGE: view clear
    168 # USAGE: view forget ?<name> <name>...?
    169 #
    170 # Used to define and manipulate views of the trajectory information
     268# USAGE: scene define <name> <script>
     269# USAGE: scene show <name> ?-send <initialViewCmd>?
     270# USAGE: scene clear
     271# USAGE: scene forget ?<name> <name>...?
     272#
     273# Used to define and manipulate scenes of the trajectory information
    171274# loaded previously by the "load" command.  The "define" operation
    172 # defines the script that loads a view called <name>.  The "show"
    173 # operation executes that script to show the view.  The "clear"
    174 # operation clears the current view (usually in preparation for
    175 # showing another view).  The "forget" operation erases one or more
    176 # view definitions; if no names are specified, then all views are
     275# defines the script that loads a scene called <name>.  The "show"
     276# operation executes that script to show the scene.  The "clear"
     277# operation clears the current scene (usually in preparation for
     278# showing another scene).  The "forget" operation erases one or more
     279# scene definitions; if no names are specified, then all scenes are
    177280# forgotten.
    178281# ----------------------------------------------------------------------
    179 proc cmd_view {option args} {
    180     global Views parser
     282proc cmd_scene {option args} {
     283    global Scenes Views DisplayProps parser
     284
    181285    switch -- $option {
    182286        define {
    183287            if {[llength $args] != 2} {
    184                 error "wrong # args: should be \"view define name script\""
     288                error "wrong # args: should be \"scene define name script\""
    185289            }
    186290            set name [lindex $args 0]
    187291            set script [lindex $args 1]
    188             set Views($name) $script
     292            set Scenes($name) $script
    189293        }
    190294        show {
    191             if {[llength $args] != 1} {
    192                 error "wrong # args: should be \"view show name\""
    193             }
    194             set name [lindex $args 0]
    195             if {![info exists Views($name)]} {
    196                 error "bad view name \"$name\": should be one of [join [array names Views] {, }]"
    197             }
    198 
    199             # clear the old view
    200             cmd_view clear
     295            if {[llength $args] < 1 || [llength $args] > 3} {
     296                error "wrong # args: should be \"scene show name ?-send cmd?\""
     297            }
     298            set name [lindex $args 0]
     299            if {![info exists Scenes($name)]} {
     300                error "bad scene name \"$name\": should be one of [join [array names Scenes] {, }]"
     301            }
     302
     303            set sendcmd ""
     304            foreach {key val} [lrange $args 1 end] {
     305                switch -- $key {
     306                    -send { set sendcmd $val }
     307                    default { error "bad option \"$key\": should be -send" }
     308                }
     309            }
     310
     311            # clear the old scene
     312            cmd_scene clear
    201313
    202314            # use a safe interp to keep things safe
    203             if {[catch {$parser eval $Views($name)} result]} {
    204                 error "$result\nwhile loading view \"$name\""
     315            display resetview
     316            if {[catch {$parser eval $Scenes($name)} result]} {
     317                error "$result\nwhile loading scene \"$name\""
     318            }
     319
     320            # capture display characteristics in case we ever need to reset
     321            set DisplayProps(rendermode) [display get rendermode]
     322            set DisplayProps(shadows) [display get shadows]
     323
     324            foreach nmol [molinfo list] {
     325                set max [molinfo $nmol get numreps]
     326                for {set nrep 0} {$nrep < $max} {incr nrep} {
     327                    set style [lindex [molinfo $nmol get "{rep $nrep}"] 0]
     328                    set DisplayProps(rep-$nmol-$nrep) $style
     329                }
     330            }
     331
     332            # store the scene name for later
     333            set Scenes(@CURRENT) $name
     334
     335            # if -send arg was given, send back the view after the script
     336            if {$sendcmd ne ""} {
     337                cmd_tellme $sendcmd getview
    205338            }
    206339        }
    207340        clear {
    208             set numOfRep [lindex [mol list top] 12]
    209             for {set i 1} {$i <= $numOfRep} {incr i} {
    210                 mol delrep top 0
    211             }
    212             cmd_reset
     341            foreach mol [molinfo list] {
     342                set numOfRep [lindex [mol list $mol] 12]
     343                for {set i 1} {$i <= $numOfRep} {incr i} {
     344                    mol delrep 0 $mol
     345                }
     346            }
     347            set Scenes(@CURRENT) ""
     348            catch {unset Views}
     349
     350            # reset the server properties
     351            axes location off
     352            color Display Background black
     353            display backgroundgradient off
    213354        }
    214355        forget {
    215356            if {[llength $args] == 0} {
    216                 set args [array names Views]
     357                set args [array names Scenes]
    217358            }
    218359            foreach name $args {
    219                 catch {unset Views($name)}
     360                if {$name eq "@CURRENT"} continue
     361                catch {unset Scenes($name)}
     362                if {$name eq $Scenes(@CURRENT)} {
     363                    set Scenes(@CURRENT) ""
     364                }
    220365            }
    221366        }
     
    225370    }
    226371}
    227 $parser alias view cmd_view
    228 
    229 # ----------------------------------------------------------------------
    230 # USAGE: frames time <epochValue> <start> ?<finish>? ?<inc>?
     372$parser alias scene cmd_scene
     373
     374# ----------------------------------------------------------------------
     375# USAGE: frames defview <frame> {matrixNames...} {matrixValues...}
     376# USAGE: frames time <epochValue> <start> ?<finish>? ?<inc>? ?-defview?
    231377# USAGE: frames rotate <epochValue> <xa> <ya> <za> <number>
    232378# USAGE: frames max
     
    242388# all frames so the client can understand if the frames are relevant.
    243389#
     390# The "defview" operation sets the default view associated with each
     391# frame.  Animation scripts can change the default view to a series of
     392# fly-through views.  This operation provides a way of storing those
     393# views.
     394#
    244395# For a "time" animation, the <start> is a number of a requested frame.
    245396# The <finish> is the last frame in the series.  The <inc> is the step
     
    255406# ----------------------------------------------------------------------
    256407proc cmd_frames {what args} {
    257     global client Epoch Work
     408    global client Epoch Work Views
    258409
    259410    # check incoming parameters
     
    262413        set epochValue [lindex $args 0]
    263414        set start [lindex $args 1]
     415
     416        set i [lsearch $args -defview]
     417        if {$i >= 0} {
     418            set defview 1
     419            set args [lreplace $args $i $i]
     420        } else {
     421            set defview 0
     422        }
     423
    264424        set finish [lindex $args 2]
    265425        if {$finish eq ""} { set finish $start }
     
    291451            for {set n $start} {$n <= $finish} {incr n $inc} {
    292452                if {![info exists Work($n)]} {
    293                     lappend Work(queue) [list epoch $epochValue frame $n num $n]
     453                    lappend Work(queue) [list epoch $epochValue frame $n num $n defview $defview]
    294454                    set Work($n) 1
    295455                }
     
    299459            for {set n $start} {$n >= $finish} {incr n $inc} {
    300460                if {![info exists Work($n)]} {
    301                     lappend Work(queue) [list epoch $epochValue frame $n num $n]
     461                    lappend Work(queue) [list epoch $epochValue frame $n num $n defview $defview]
    302462                    set Work($n) 1
    303463                }
     
    323483        }
    324484        set num [lindex $args 4]
    325         if {![string is integer -strict $num] || $num <= 0} {
    326             server_oops $client "bad number of rotation frames \"$num\" should be integer > 0"
     485        if {![string is integer -strict $num] || $num < 2} {
     486            server_oops $client "bad number of rotation frames \"$num\" should be integer > 1"
    327487            return
    328488        }
    329489
    330         set rot [list $mx $my $mz]
     490        #
     491        # Compute the rotation matrix for each rotated view.
     492        # Start with the current rotation matrix.  Rotate that around
     493        # a vector perpendicular to the plane of rotation for the given
     494        # angles (mx,my,mz).  Find vector that by rotating some vector
     495        # such as (1,1,1) by the angles (mx,my,mz).  Do a couple of
     496        # times and compute the differences between those vectors.
     497        # Then, compute the cross product of the differences.  The
     498        # result is the axis of rotation.
     499        #
     500        set lastrotx [trans axis x $mx deg]
     501        set lastroty [trans axis y $my deg]
     502        set lastrotz [trans axis z $mz deg]
     503        set lastrot [transmult $lastrotx $lastroty $lastrotz]
     504
     505        set lastvec [list 1 1 1]
     506        foreach v {1 2} {
     507            foreach row $lastrot comp {x y z w} {
     508                # multiply each row by last vector
     509                set vec($comp) 0
     510                for {set i 0} {$i < 3} {incr i} {
     511                    set vec($comp) [expr {$vec($comp) + [lindex $row $i]}]
     512                }
     513            }
     514            set vec${v}(x) [expr {$vec(x)-[lindex $lastvec 0]}]
     515            set vec${v}(y) [expr {$vec(y)-[lindex $lastvec 1]}]
     516            set vec${v}(z) [expr {$vec(z)-[lindex $lastvec 2]}]
     517
     518            set lastvec [list $vec(x) $vec(y) $vec(z)]
     519            set lastrot [transmult $lastrot $lastrotx $lastroty $lastrotz]
     520        }
     521
     522        set crx [expr {$vec1(y)*$vec2(z)-$vec1(z)*$vec2(y)}]
     523        set cry [expr {$vec1(z)*$vec2(x)-$vec1(x)*$vec2(z)}]
     524        set crz [expr {$vec1(x)*$vec2(y)-$vec1(y)*$vec2(x)}]
     525
     526        set angle [expr {360.0/$num}]
     527        set rotby [transabout [list $crx $cry $crz] $angle deg]
     528        set rotm [lindex [molinfo top get rotate_matrix] 0]
     529
     530        # compute cross product of (1,1,1,0) and rotated vector from above
     531
    331532        for {set n 0} {$n < $num} {incr n} {
    332             lappend Work(queue) [list epoch $epochValue rotate $rot num $n]
     533            lappend Work(queue) [list epoch $epochValue rotate $rotm num $n defview 0]
     534            set rotm [transmult $rotby $rotm]
    333535            set Work($n) 1
    334536        }
     537      }
     538      defview {
     539          if {[llength $args] != 3} { error "wrong # args: should be \"defview matrixNameList matrixValueList\"" }
     540          set n [lindex $args 0]
     541          if {![string is int $n]} { error "bad frame value \"$n\"" }
     542          set Views($n) [lrange $args 1 end]
    335543      }
    336544      max {
     
    342550      }
    343551      default {
    344         error "bad option \"$what\": should be time, rotate, max"
     552        error "bad option \"$what\": should be defview, time, rotate, max"
    345553      }
    346554    }
     
    350558}
    351559$parser alias frames cmd_frames
     560
     561# ----------------------------------------------------------------------
     562# USAGE: getview
     563#
     564# Used to query the scaling and centering of the initial view set
     565# by VMD after a molecule is loaded.  Returns the following:
     566#   <viewName> -rotate <mtx> -global <mtx> -scale <mtx> -center <mtx>
     567# ----------------------------------------------------------------------
     568proc cmd_getview {} {
     569    global Scenes
     570
     571    if {[llength [molinfo list]] == 0} { return "" }
     572    if {$Scenes(@CURRENT) eq ""} { return "" }
     573
     574    set rval [list $Scenes(@CURRENT)]  ;# start with the scene name
     575
     576    lappend rval -rotate [lindex [molinfo top get rotate_matrix] 0] \
     577                 -scale [lindex [molinfo top get scale_matrix] 0] \
     578                 -center [lindex [molinfo top get center_matrix] 0] \
     579                 -global [lindex [molinfo top get global_matrix] 0]
     580
     581    return $rval
     582}
     583$parser alias getview cmd_getview
     584
     585#
     586# USAGE: server_safe_resize <width> <height>
     587#
     588# Use this version instead of "display resize" whenever possible.
     589# The VMD "display resize" goes into the event loop, so calling that
     590# causes things to execute out of order.  Use this method instead to
     591# store the change and actually resize later.
     592#
     593proc server_safe_resize {w h} {
     594    global DisplaySize
     595
     596    if {$w != $DisplaySize(w) || $h != $DisplaySize(h)} {
     597        set DisplaySize(w) $w
     598        set DisplaySize(h) $h
     599        set DisplaySize(changed) yes
     600    }
     601}
    352602
    353603# ----------------------------------------------------------------------
     
    359609
    360610    # identify server type to this client
     611    # The server identifier must be in the form <name> <version>.  The
     612    # base connect method will ignore characters until it finds this line.
    361613    puts $cid "vmd 0.1"
    362614}
    363615
    364616proc server_handle {cin cout} {
    365     global parser buffer client
    366 
    367     if {[gets $cin request] < 0} {
     617    global parser buffer client 
     618
     619    if {[gets $cin line] < 0} {
    368620        # when client drops connection, we can exit
    369621        # nanoscale will spawn a new server next time we need it
    370622        server_exit $cin $cout
    371623    } else {
    372         append buffer($cin) $request "\n"
     624        append buffer($cin) $line "\n"
    373625        if {[info complete $buffer($cin)]} {
     626            #puts stdout "command is ($buffer($cin))"
    374627            set request $buffer($cin)
    375628            set buffer($cin) ""
     
    378631                server_send_image -eventually
    379632            } else {
     633                puts stdout "last gets is ($line) cmd=($request) result=($result)"
    380634                server_oops $cout $result
     635                if { [string match "invalid command*" $result] } {
     636                    bgerror $result
     637                    exit 1
     638                }
    381639            }
    382640        }
     
    422680# SERVER RESPONSES
    423681# ----------------------------------------------------------------------
    424 #
    425 
    426 #set the screen to a good size
    427 display resize 300 300
    428 
    429682
    430683# turn off constant updates -- only need them during server_send_image
     
    432685
    433686proc server_send_image {{when -now}} {
    434     global client Epoch Work Sendqueue
     687    global client Epoch Work Views Sendqueue DisplaySize
    435688
    436689    if {$when eq "-eventually"} {
     
    442695    }
    443696
     697    # is there a display resize pending? then resize and try again later
     698    if {$DisplaySize(changed)} {
     699        set DisplaySize(changed) 0
     700        after idle [list display resize $DisplaySize(w) $DisplaySize(h)]
     701        after 20 server_send_image
     702        return
     703    }
     704
    444705    # loop through requests in the work queue and skip any from an older epoch
    445706    while {1} {
     
    461722            animate goto $item(frame)
    462723        } elseif {[info exists item(rotate)]} {
    463             foreach {mx my mz} $item(rotate) break
    464             rotate x by $mx
    465             rotate y by $my
    466             rotate z by $mz
     724            molinfo top set rotate_matrix [list $item(rotate)]
     725            # send rotation matrix back to the client so we can pause later
     726            server_send_result $client [list nv>rotatemtx $item(num) $item(rotate)]
    467727        } else {
    468728            puts "ERROR: bad work frame: [array get item]"
     729        }
     730
     731        # flag to use the stored default view? then set that
     732        if {[info exists item(defview)] && $item(defview)} {
     733            if {[info exists Views($item(frame))]} {
     734                eval molinfo top set $Views($item(frame))
     735            }
    469736        }
    470737        catch {unset Work($item(num))}
     
    512779
    513780# vmd automatically drops into an event loop at this point...
     781#
     782# The VMD TCL interpreter is by default interactive.  Their version
     783# of tkconsole always turns this on.  Turn this off
     784# so that unknown commands like "scene" don't get exec-ed.
    514785set ::tcl_interactive 0
Note: See TracChangeset for help on using the changeset viewer.