Changeset 4252 for trunk/packages/vizservers

Timestamp:

Mar 19, 2014 9:43:25 AM (10 years ago)

Author:

mmc

Message:

Updated VMD server script from MD Showcase.

File:

• trunk/packages/vizservers/vmd/vmdserver.tcl (modified) (15 diffs)

trunk/packages/vizservers/vmd/vmdserver.tcl

@@ -41 +41 @@
 set DisplaySize(changed) 0
 
+# capture initial display settings for later reset
+display antialias on
+
+set DisplayProps(options) ""
+foreach key {
+    ambientocclusion antialias aoambient aodirect
+    backgroundgradient
+    culling cuestart cueend cuedensity cuemode
+    depthcue distance
+    eyesep
+    farclip focallength
+    height
+    nearclip
+    projection
+    shadows stereo
+} {
+    if {$key eq "nearclip" || $key eq "farclip"} {
+        append DisplayProps(options) [list display $key set [display get $key]] "\n"
+    } else {
+        append DisplayProps(options) [list display $key [display get $key]] "\n"
+    }
+}
+
 # initialize work queue and epoch counter (see server_send_image)
 set Epoch 0
@@ -54 +77 @@
   color
   axes
-  display
   imd
   vmdcollab
@@ -90 +112 @@
 
 # ----------------------------------------------------------------------
+# USAGE: display option ?arg arg...?
+#
+# Executes the "command arg arg..." string in the server and substitutes
+# the result into the template string in place of each "%v" field.
+# Sends the result back to the client.
+# ----------------------------------------------------------------------
+proc cmd_display {args} {
+    set option [lindex $args 0]
+    if {[lsearch {resize reposition rendermode update fps} $option] >= 0} {
+        # ignore these commands -- they cause trouble
+        return ""
+    }
+    eval display $args
+}
+$parser alias display cmd_display
+
+# ----------------------------------------------------------------------
 # USAGE: tellme "command template with %v" command arg arg...
 #
@@ -262 +301 @@
         set op "addfile"
     }
+
+    # BE CAREFUL -- force a "display update" here
+    # that triggers something in VMD that changes view matrices now,
+    # so if we change them later, the new values stick
+    display update
 }
 $parser alias load cmd_load
@@ -267 +311 @@
 # ----------------------------------------------------------------------
 # USAGE: scene define <name> <script>
-# USAGE: scene show <name> ?-send <initialViewCmd>?
+# USAGE: scene show <name> ?-before <viewCmd>? ?-after <viewCmd>?
 # USAGE: scene clear
 # USAGE: scene forget ?<name> <name>...?
@@ -293 +337 @@
         }
         show {
-            if {[llength $args] < 1 || [llength $args] > 3} {
-                error "wrong # args: should be \"scene show name ?-send cmd?\""
+            if {[llength $args] < 1 || [llength $args] > 5} {
+                error "wrong # args: should be \"scene show name ?-before cmd? ?-after cmd?\""
             }
             set name [lindex $args 0]
@@ -301 +345 @@
             }
 
-            set sendcmd ""
+            set triggers(before) ""
+            set triggers(after) ""
             foreach {key val} [lrange $args 1 end] {
                 switch -- $key {
-                    -send { set sendcmd $val }
-                    default { error "bad option \"$key\": should be -send" }
+                    -before { set triggers(before) $val }
+                    -after { set triggers(after) $val }
+                    default { error "bad option \"$key\": should be -before, -after" }
                 }
+            }
+
+            # if -before arg was given, send back the view right now
+            if {$triggers(before) ne "" && $Scenes(@CURRENT) ne ""} {
+                cmd_tellme $triggers(before) getview
             }
 
             # clear the old scene
             cmd_scene clear
+            display resetview
 
             # use a safe interp to keep things safe
-            display resetview
+            foreach val [$parser eval {info vars}] {
+                # clear all variables created by previous scripts
+                $parser eval [list catch [list unset $val]]
+            }
             if {[catch {$parser eval $Scenes($name)} result]} {
                 error "$result\nwhile loading scene \"$name\""
@@ -333 +388 @@
             set Scenes(@CURRENT) $name
 
-            # if -send arg was given, send back the view after the script
-            if {$sendcmd ne ""} {
-                cmd_tellme $sendcmd getview
+            # if -after arg was given, send back the view after the script
+            if {$triggers(after) ne ""} {
+                cmd_tellme $triggers(after) getview
             }
         }
@@ -351 +406 @@
             axes location off
             color Display Background black
-            display backgroundgradient off
+            eval $DisplayProps(options)
         }
         forget {
@@ -605 +660 @@
 # ----------------------------------------------------------------------
 proc server_accept {cid addr port} {
+    global env
+
     fileevent $cid readable [list server_handle $cid $cid]
     fconfigure $cid -buffering none -blocking 0
+
+    if {[info exists env(LOCAL)]} {
+        # identify server type to this client
+        # VMD on the hub has this built in, but stock versions can
+        # set the environment variable as a work-around
+        puts $cid "vmd 0.1"
+    }
 }
 
@@ -615 +679 @@
         # when client drops connection, we can exit
         # nanoscale will spawn a new server next time we need it
-        server_exit $cin $cout
+        if {[eof $cin]} {
+            server_exit $cin $cout
+        }
     } else {
         append buffer($cin) $line "\n"
@@ -645 +711 @@
 
         catch {unset data}; array set data $chunk
-        if {$data(epoch) == $Epoch} {
+        if {$data(epoch) < 0 || $data(epoch) == $Epoch} {
             catch {puts $cout $data(cmd)}
 
@@ -717 +783 @@
             molinfo top set rotate_matrix [list $item(rotate)]
             # send rotation matrix back to the client so we can pause later
-            server_send_result $client [list nv>rotatemtx $item(num) $item(rotate)]
+            server_send_latest $client [list nv>rotatemtx $item(num) $item(rotate)]
         } else {
             puts "ERROR: bad work frame: [array get item]"
@@ -737 +803 @@
 
     set data [SnapShot data -format PPM]
-    server_send_result $client "nv>image epoch $item(epoch) frame $item(num) length [string length $data]" $data
+    server_send_latest $client "nv>image epoch $item(epoch) frame $item(num) length [string length $data]" $data
 
     # if there's more work in the queue, try again later
@@ -746 +812 @@
 
 proc server_send_result {cout cmd {data ""}} {
+    global Sendqueue
+
+    # add this result to the output queue
+    # use the epoch -1 to force the send even if the epoch has changed
+    lappend Sendqueue [list epoch -1 cmd $cmd bytes $data]
+    fileevent $cout writable [list server_send $cout]
+}
+
+proc server_send_latest {cout cmd {data ""}} {
     global Epoch Sendqueue