| 1 | # ---------------------------------------------------------------------- |
|---|
| 2 | # HUBZERO: server for VMD |
|---|
| 3 | # |
|---|
| 4 | # This program runs VMD and acts as a server for client applications. |
|---|
| 5 | # ---------------------------------------------------------------------- |
|---|
| 6 | # Michael McLennan (mmclennan@purdue.edu) |
|---|
| 7 | # ====================================================================== |
|---|
| 8 | # Copyright (c) 2013 - HUBzero Foundation, LLC |
|---|
| 9 | # ====================================================================== |
|---|
| 10 | |
|---|
| 11 | # The VMD TCL interpreter is by default interactive. Turn this off |
|---|
| 12 | # so that unknown commands like "scene" don't get exec-ed. |
|---|
| 13 | set ::tcl_interactive 0 |
|---|
| 14 | |
|---|
| 15 | proc bgerror {mesg} { |
|---|
| 16 | puts stderr "SERVER ERROR: $mesg" |
|---|
| 17 | } |
|---|
| 18 | |
|---|
| 19 | # parse command line args |
|---|
| 20 | set Paradigm "socket" |
|---|
| 21 | while {[llength $argv] > 0} { |
|---|
| 22 | set opt [lindex $argv 0] |
|---|
| 23 | set argv [lrange $argv 1 end] |
|---|
| 24 | |
|---|
| 25 | switch -- $opt { |
|---|
| 26 | -socket { set Paradigm "socket" } |
|---|
| 27 | -stdio { set Paradigm "stdio" } |
|---|
| 28 | default { |
|---|
| 29 | puts stderr "bad option \"$opt\": should be -socket or -stdio" |
|---|
| 30 | } |
|---|
| 31 | } |
|---|
| 32 | } |
|---|
| 33 | |
|---|
| 34 | # use this to take snapshots to send to clients |
|---|
| 35 | image create photo SnapShot |
|---|
| 36 | |
|---|
| 37 | # set the screen to a good size |
|---|
| 38 | set DisplaySize(w) 300 |
|---|
| 39 | set DisplaySize(h) 300 |
|---|
| 40 | display resize $DisplaySize(w) $DisplaySize(h) |
|---|
| 41 | set DisplaySize(changed) 0 |
|---|
| 42 | |
|---|
| 43 | # capture initial display settings for later reset |
|---|
| 44 | display antialias on |
|---|
| 45 | |
|---|
| 46 | set DisplayProps(options) "" |
|---|
| 47 | foreach key { |
|---|
| 48 | ambientocclusion antialias aoambient aodirect |
|---|
| 49 | backgroundgradient |
|---|
| 50 | culling cuestart cueend cuedensity cuemode |
|---|
| 51 | depthcue distance |
|---|
| 52 | eyesep |
|---|
| 53 | farclip focallength |
|---|
| 54 | height |
|---|
| 55 | nearclip |
|---|
| 56 | projection |
|---|
| 57 | shadows stereo |
|---|
| 58 | } { |
|---|
| 59 | if {$key eq "nearclip" || $key eq "farclip"} { |
|---|
| 60 | append DisplayProps(options) [list display $key set [display get $key]] "\n" |
|---|
| 61 | } else { |
|---|
| 62 | append DisplayProps(options) [list display $key [display get $key]] "\n" |
|---|
| 63 | } |
|---|
| 64 | } |
|---|
| 65 | |
|---|
| 66 | # initialize work queue and epoch counter (see server_send_image) |
|---|
| 67 | set Epoch 0 |
|---|
| 68 | set Work(queue) "" |
|---|
| 69 | set Sendqueue "" |
|---|
| 70 | set Scenes(@CURRENT) "" |
|---|
| 71 | |
|---|
| 72 | set parser [interp create -safe] |
|---|
| 73 | |
|---|
| 74 | foreach cmd { |
|---|
| 75 | axes |
|---|
| 76 | color |
|---|
| 77 | gettimestep |
|---|
| 78 | graphics |
|---|
| 79 | imd |
|---|
| 80 | label |
|---|
| 81 | vmd_label |
|---|
| 82 | light |
|---|
| 83 | material |
|---|
| 84 | measure |
|---|
| 85 | mobile |
|---|
| 86 | mol |
|---|
| 87 | molinfo |
|---|
| 88 | molecule |
|---|
| 89 | mouse |
|---|
| 90 | parallel |
|---|
| 91 | plugin |
|---|
| 92 | rawtimestep |
|---|
| 93 | render |
|---|
| 94 | rotate |
|---|
| 95 | rotmat |
|---|
| 96 | scale |
|---|
| 97 | vmd_scale |
|---|
| 98 | spaceball |
|---|
| 99 | stage |
|---|
| 100 | tkrender |
|---|
| 101 | tool |
|---|
| 102 | translate |
|---|
| 103 | user |
|---|
| 104 | vmdcollab |
|---|
| 105 | vmdcon |
|---|
| 106 | vmdinfo |
|---|
| 107 | vmdbench |
|---|
| 108 | volmap |
|---|
| 109 | } { |
|---|
| 110 | $parser alias $cmd $cmd |
|---|
| 111 | } |
|---|
| 112 | |
|---|
| 113 | # ---------------------------------------------------------------------- |
|---|
| 114 | # USAGE: display option ?arg arg...? |
|---|
| 115 | # |
|---|
| 116 | # Executes the "command arg arg..." string in the server and substitutes |
|---|
| 117 | # the result into the template string in place of each "%v" field. |
|---|
| 118 | # Sends the result back to the client. |
|---|
| 119 | # ---------------------------------------------------------------------- |
|---|
| 120 | proc cmd_display {args} { |
|---|
| 121 | set option [lindex $args 0] |
|---|
| 122 | if {[lsearch {resize reposition rendermode update fps} $option] >= 0} { |
|---|
| 123 | # ignore these commands -- they cause trouble |
|---|
| 124 | return "" |
|---|
| 125 | } |
|---|
| 126 | eval display $args |
|---|
| 127 | } |
|---|
| 128 | $parser alias display cmd_display |
|---|
| 129 | |
|---|
| 130 | # ---------------------------------------------------------------------- |
|---|
| 131 | # USAGE: tellme "command template with %v" command arg arg... |
|---|
| 132 | # |
|---|
| 133 | # Executes the "command arg arg..." string in the server and substitutes |
|---|
| 134 | # the result into the template string in place of each "%v" field. |
|---|
| 135 | # Sends the result back to the client. |
|---|
| 136 | # ---------------------------------------------------------------------- |
|---|
| 137 | proc cmd_tellme {fmt args} { |
|---|
| 138 | global parser client |
|---|
| 139 | |
|---|
| 140 | # evaluate args as a command and subst the result in the fmt string |
|---|
| 141 | if {[catch {$parser eval $args} result] == 0} { |
|---|
| 142 | server_send_result $client "nv>[string map [list %v $result] $fmt]" |
|---|
| 143 | } else { |
|---|
| 144 | server_oops $client $result |
|---|
| 145 | } |
|---|
| 146 | } |
|---|
| 147 | $parser alias tellme cmd_tellme |
|---|
| 148 | |
|---|
| 149 | # ---------------------------------------------------------------------- |
|---|
| 150 | # USAGE: queryinfo <x> <y> ?-add? |
|---|
| 151 | # |
|---|
| 152 | # Resizes the visualization window to the given width <w> and height |
|---|
| 153 | # <h>. The next image sent should be this size. |
|---|
| 154 | # ---------------------------------------------------------------------- |
|---|
| 155 | proc cmd_queryinfo {x y args} { |
|---|
| 156 | global DisplayProps MolNames MolInfo |
|---|
| 157 | |
|---|
| 158 | # be careful -- VMD uses coordinates from LOWER-left corner of window |
|---|
| 159 | set vmdy [expr {$DisplayProps(frameh)-$y}] |
|---|
| 160 | |
|---|
| 161 | set vals [pick $x $vmdy] |
|---|
| 162 | if {$vals ne ""} { |
|---|
| 163 | array set data $vals |
|---|
| 164 | |
|---|
| 165 | # map the molecule ID back to the name used within MD Showcase |
|---|
| 166 | foreach molname $MolNames { |
|---|
| 167 | if {$MolInfo($molname) == $data(mol)} { |
|---|
| 168 | set data(molname) $molname |
|---|
| 169 | break |
|---|
| 170 | } |
|---|
| 171 | } |
|---|
| 172 | |
|---|
| 173 | # pass back the click coord on screen so we know where this came from |
|---|
| 174 | set data(screenx) $x |
|---|
| 175 | set data(screeny) $y |
|---|
| 176 | |
|---|
| 177 | set vals [array get data] |
|---|
| 178 | } |
|---|
| 179 | return $vals |
|---|
| 180 | } |
|---|
| 181 | $parser alias queryinfo cmd_queryinfo |
|---|
| 182 | |
|---|
| 183 | # ---------------------------------------------------------------------- |
|---|
| 184 | # USAGE: resize <w> <h> |
|---|
| 185 | # |
|---|
| 186 | # Resizes the visualization window to the given width <w> and height |
|---|
| 187 | # <h>. The next image sent should be this size. |
|---|
| 188 | # ---------------------------------------------------------------------- |
|---|
| 189 | proc cmd_resize {w h} { |
|---|
| 190 | global DisplayProps |
|---|
| 191 | |
|---|
| 192 | # store the desired size in case we downscale |
|---|
| 193 | set DisplayProps(framew) $w |
|---|
| 194 | set DisplayProps(frameh) $h |
|---|
| 195 | |
|---|
| 196 | server_safe_resize $w $h |
|---|
| 197 | } |
|---|
| 198 | $parser alias resize cmd_resize |
|---|
| 199 | |
|---|
| 200 | # ---------------------------------------------------------------------- |
|---|
| 201 | # USAGE: setview ?-rotate <mtx>? ?-scale <mtx>? ?-center <mtx>? ?-global <mtx>? |
|---|
| 202 | # |
|---|
| 203 | # Sets the view matrix for one or more components of the view. This |
|---|
| 204 | # is a convenient way of getting a view for a particular frame just |
|---|
| 205 | # right in one shot. |
|---|
| 206 | # ---------------------------------------------------------------------- |
|---|
| 207 | proc cmd_setview {args} { |
|---|
| 208 | if {[llength $args] == 8} { |
|---|
| 209 | # setting all matrices? then start clean |
|---|
| 210 | display resetview |
|---|
| 211 | } |
|---|
| 212 | foreach {key val} $args { |
|---|
| 213 | switch -- $key { |
|---|
| 214 | -rotate { |
|---|
| 215 | molinfo top set rotate_matrix [list $val] |
|---|
| 216 | } |
|---|
| 217 | -scale { |
|---|
| 218 | molinfo top set scale_matrix [list $val] |
|---|
| 219 | } |
|---|
| 220 | -center { |
|---|
| 221 | molinfo top set center_matrix [list $val] |
|---|
| 222 | } |
|---|
| 223 | -global { |
|---|
| 224 | molinfo top set global_matrix [list $val] |
|---|
| 225 | } |
|---|
| 226 | default { |
|---|
| 227 | error "bad option \"$key\": should be -rotate, -scale, -center, or -global" |
|---|
| 228 | } |
|---|
| 229 | } |
|---|
| 230 | } |
|---|
| 231 | } |
|---|
| 232 | $parser alias setview cmd_setview |
|---|
| 233 | |
|---|
| 234 | # ---------------------------------------------------------------------- |
|---|
| 235 | # USAGE: drag start|end |
|---|
| 236 | # |
|---|
| 237 | # Resizes the visualization window to the given width <w> and height |
|---|
| 238 | # <h>. The next image sent should be this size. |
|---|
| 239 | # ---------------------------------------------------------------------- |
|---|
| 240 | proc cmd_drag {action} { |
|---|
| 241 | global DisplayProps |
|---|
| 242 | |
|---|
| 243 | switch -- $action { |
|---|
| 244 | start { |
|---|
| 245 | # simplify rendering so it goes faster during drag operations |
|---|
| 246 | set neww [expr {round($DisplayProps(framew)/2.0)}] |
|---|
| 247 | set newh [expr {round($DisplayProps(frameh)/2.0)}] |
|---|
| 248 | server_safe_resize $neww $newh |
|---|
| 249 | display rendermode Normal |
|---|
| 250 | display shadows off |
|---|
| 251 | |
|---|
| 252 | foreach nmol [molinfo list] { |
|---|
| 253 | set max [molinfo $nmol get numreps] |
|---|
| 254 | for {set nrep 0} {$nrep < $max} {incr nrep} { |
|---|
| 255 | mol modstyle $nrep $nmol "Lines" |
|---|
| 256 | } |
|---|
| 257 | } |
|---|
| 258 | } |
|---|
| 259 | end { |
|---|
| 260 | # put original rendering options back |
|---|
| 261 | server_safe_resize $DisplayProps(framew) $DisplayProps(frameh) |
|---|
| 262 | display rendermode $DisplayProps(rendermode) |
|---|
| 263 | display shadows $DisplayProps(shadows) |
|---|
| 264 | |
|---|
| 265 | # restore rendering methods for all representations |
|---|
| 266 | foreach nmol [molinfo list] { |
|---|
| 267 | set max [molinfo $nmol get numreps] |
|---|
| 268 | for {set nrep 0} {$nrep < $max} {incr nrep} { |
|---|
| 269 | mol modstyle $nrep $nmol $DisplayProps(rep-$nmol-$nrep) |
|---|
| 270 | } |
|---|
| 271 | } |
|---|
| 272 | } |
|---|
| 273 | default { |
|---|
| 274 | error "bad option \"$action\": should be start or end" |
|---|
| 275 | } |
|---|
| 276 | } |
|---|
| 277 | } |
|---|
| 278 | $parser alias drag cmd_drag |
|---|
| 279 | |
|---|
| 280 | # ---------------------------------------------------------------------- |
|---|
| 281 | # USAGE: setquality normal|high |
|---|
| 282 | # |
|---|
| 283 | # Sets the rendering quality for the scene--either "high" (GLSL) or |
|---|
| 284 | # normal. |
|---|
| 285 | # ---------------------------------------------------------------------- |
|---|
| 286 | proc cmd_setquality {newval} { |
|---|
| 287 | global DisplayProps |
|---|
| 288 | |
|---|
| 289 | switch -- $newval { |
|---|
| 290 | high { |
|---|
| 291 | display rendermode GLSL |
|---|
| 292 | set DisplayProps(rendermode) "GLSL" |
|---|
| 293 | } |
|---|
| 294 | normal { |
|---|
| 295 | display rendermode Normal |
|---|
| 296 | set DisplayProps(rendermode) "Normal" |
|---|
| 297 | } |
|---|
| 298 | default { |
|---|
| 299 | error "bad quality value \"$newval\": should be normal or high" |
|---|
| 300 | } |
|---|
| 301 | } |
|---|
| 302 | } |
|---|
| 303 | $parser alias setquality cmd_setquality |
|---|
| 304 | |
|---|
| 305 | # ---------------------------------------------------------------------- |
|---|
| 306 | # USAGE: smoothreps <value> |
|---|
| 307 | # |
|---|
| 308 | # Changes the smoothing factor for all representations of the current |
|---|
| 309 | # molecule. |
|---|
| 310 | # ---------------------------------------------------------------------- |
|---|
| 311 | proc cmd_smoothreps {val} { |
|---|
| 312 | if {$val < 0} { |
|---|
| 313 | error "bad smoothing value \"$val\": should be >= 0" |
|---|
| 314 | } |
|---|
| 315 | foreach nmol [molinfo list] { |
|---|
| 316 | set max [molinfo $nmol get numreps] |
|---|
| 317 | for {set nrep 0} {$nrep < $max} {incr nrep} { |
|---|
| 318 | mol smoothrep $nmol $nrep $val |
|---|
| 319 | } |
|---|
| 320 | } |
|---|
| 321 | } |
|---|
| 322 | $parser alias smoothreps cmd_smoothreps |
|---|
| 323 | |
|---|
| 324 | # ---------------------------------------------------------------------- |
|---|
| 325 | # USAGE: animate <option> <args>... |
|---|
| 326 | # USAGE: rock off |
|---|
| 327 | # USAGE: rock x|y|z by <step> ?<n>? |
|---|
| 328 | # |
|---|
| 329 | # The usual VMD "animate" and "rock" commands are problematic for this |
|---|
| 330 | # server. If we're going to rock or play the animation, the client |
|---|
| 331 | # will do it. Intercept any "animate" and "rock" commands in the scene |
|---|
| 332 | # scripts and do nothing. |
|---|
| 333 | # ---------------------------------------------------------------------- |
|---|
| 334 | proc cmd_animate {args} { |
|---|
| 335 | # do nothing |
|---|
| 336 | } |
|---|
| 337 | $parser alias animate cmd_animate |
|---|
| 338 | |
|---|
| 339 | proc cmd_rock {args} { |
|---|
| 340 | # do nothing |
|---|
| 341 | } |
|---|
| 342 | $parser alias rock cmd_rock |
|---|
| 343 | |
|---|
| 344 | # ---------------------------------------------------------------------- |
|---|
| 345 | # These commands just confuse things, so ignore them silently. |
|---|
| 346 | # ---------------------------------------------------------------------- |
|---|
| 347 | proc cmd_noop {args} { |
|---|
| 348 | # do nothing |
|---|
| 349 | } |
|---|
| 350 | |
|---|
| 351 | $parser alias sleep cmd_noop |
|---|
| 352 | $parser alias menu cmd_noop |
|---|
| 353 | $parser alias vmd_menu cmd_noop |
|---|
| 354 | $parser alias play cmd_noop |
|---|
| 355 | $parser alias quit cmd_noop |
|---|
| 356 | |
|---|
| 357 | # ---------------------------------------------------------------------- |
|---|
| 358 | # USAGE: load <file> <file>... |
|---|
| 359 | # |
|---|
| 360 | # Loads the molecule data from one or more files, which may be PDB, |
|---|
| 361 | # DCD, PSF, etc. |
|---|
| 362 | # ---------------------------------------------------------------------- |
|---|
| 363 | proc cmd_load {args} { |
|---|
| 364 | global MolInfo MolNames |
|---|
| 365 | |
|---|
| 366 | # clear all existing molecules |
|---|
| 367 | foreach nmol [molinfo list] { |
|---|
| 368 | mol delete $nmol |
|---|
| 369 | } |
|---|
| 370 | catch {unset MolInfo} |
|---|
| 371 | set MolNames "" |
|---|
| 372 | |
|---|
| 373 | # load new files |
|---|
| 374 | if {![regexp {^@name:} $args]} { |
|---|
| 375 | # make sure that there is at least one name in the list |
|---|
| 376 | set args [linsert $args 0 "@name:0"] |
|---|
| 377 | } |
|---|
| 378 | |
|---|
| 379 | set slot 0 |
|---|
| 380 | foreach file $args { |
|---|
| 381 | if {[regexp {^@name:(.+)} $file match name]} { |
|---|
| 382 | set op "new" |
|---|
| 383 | continue |
|---|
| 384 | } |
|---|
| 385 | mol $op $file waitfor all |
|---|
| 386 | |
|---|
| 387 | if {$op eq "new"} { |
|---|
| 388 | set newnum [lindex [molinfo list] end] |
|---|
| 389 | if {[lsearch -exact MolNames $name] < 0} { |
|---|
| 390 | lappend MolNames $name |
|---|
| 391 | } |
|---|
| 392 | set MolInfo($name) $newnum |
|---|
| 393 | set MolInfo($slot) $newnum |
|---|
| 394 | incr slot |
|---|
| 395 | set op "addfile" |
|---|
| 396 | } |
|---|
| 397 | } |
|---|
| 398 | |
|---|
| 399 | # BE CAREFUL -- force a "display update" here |
|---|
| 400 | # that triggers something in VMD that changes view matrices now, |
|---|
| 401 | # so if we change them later, the new values stick |
|---|
| 402 | display update |
|---|
| 403 | } |
|---|
| 404 | $parser alias load cmd_load |
|---|
| 405 | |
|---|
| 406 | # ---------------------------------------------------------------------- |
|---|
| 407 | # USAGE: scene define <name> <script> |
|---|
| 408 | # USAGE: scene show <name> ?-before <viewCmd>? ?-after <viewCmd>? |
|---|
| 409 | # USAGE: scene clear |
|---|
| 410 | # USAGE: scene forget ?<name> <name>...? |
|---|
| 411 | # |
|---|
| 412 | # Used to define and manipulate scenes of the trajectory information |
|---|
| 413 | # loaded previously by the "load" command. The "define" operation |
|---|
| 414 | # defines the script that loads a scene called <name>. The "show" |
|---|
| 415 | # operation executes that script to show the scene. The "clear" |
|---|
| 416 | # operation clears the current scene (usually in preparation for |
|---|
| 417 | # showing another scene). The "forget" operation erases one or more |
|---|
| 418 | # scene definitions; if no names are specified, then all scenes are |
|---|
| 419 | # forgotten. |
|---|
| 420 | # ---------------------------------------------------------------------- |
|---|
| 421 | proc cmd_scene {option args} { |
|---|
| 422 | global Scenes Views MolInfo DisplayProps parser |
|---|
| 423 | |
|---|
| 424 | switch -- $option { |
|---|
| 425 | define { |
|---|
| 426 | if {[llength $args] != 2} { |
|---|
| 427 | error "wrong # args: should be \"scene define name script\"" |
|---|
| 428 | } |
|---|
| 429 | set name [lindex $args 0] |
|---|
| 430 | set script [lindex $args 1] |
|---|
| 431 | set Scenes($name) $script |
|---|
| 432 | } |
|---|
| 433 | show { |
|---|
| 434 | if {[llength $args] < 1 || [llength $args] > 5} { |
|---|
| 435 | error "wrong # args: should be \"scene show name ?-before cmd? ?-after cmd?\"" |
|---|
| 436 | } |
|---|
| 437 | set name [lindex $args 0] |
|---|
| 438 | if {![info exists Scenes($name)]} { |
|---|
| 439 | error "bad scene name \"$name\": should be one of [join [array names Scenes] {, }]" |
|---|
| 440 | } |
|---|
| 441 | |
|---|
| 442 | set triggers(before) "" |
|---|
| 443 | set triggers(after) "" |
|---|
| 444 | foreach {key val} [lrange $args 1 end] { |
|---|
| 445 | switch -- $key { |
|---|
| 446 | -before { set triggers(before) $val } |
|---|
| 447 | -after { set triggers(after) $val } |
|---|
| 448 | default { error "bad option \"$key\": should be -before, -after" } |
|---|
| 449 | } |
|---|
| 450 | } |
|---|
| 451 | |
|---|
| 452 | # if -before arg was given, send back the view right now |
|---|
| 453 | if {$triggers(before) ne "" && $Scenes(@CURRENT) ne ""} { |
|---|
| 454 | cmd_tellme $triggers(before) getview |
|---|
| 455 | } |
|---|
| 456 | |
|---|
| 457 | # clear the old scene |
|---|
| 458 | cmd_scene clear |
|---|
| 459 | display resetview |
|---|
| 460 | |
|---|
| 461 | # use a safe interp to keep things safe |
|---|
| 462 | foreach val [$parser eval {info vars}] { |
|---|
| 463 | # clear all variables created by previous scripts |
|---|
| 464 | $parser eval [list catch [list unset $val]] |
|---|
| 465 | } |
|---|
| 466 | $parser eval [list array set mol [array get MolInfo]] |
|---|
| 467 | |
|---|
| 468 | if {[catch {$parser eval $Scenes($name)} result]} { |
|---|
| 469 | error "$result\nwhile loading scene \"$name\"" |
|---|
| 470 | } |
|---|
| 471 | |
|---|
| 472 | # capture display characteristics in case we ever need to reset |
|---|
| 473 | set DisplayProps(rendermode) "Normal" |
|---|
| 474 | set DisplayProps(shadows) [display get shadows] |
|---|
| 475 | |
|---|
| 476 | foreach nmol [molinfo list] { |
|---|
| 477 | set max [molinfo $nmol get numreps] |
|---|
| 478 | for {set nrep 0} {$nrep < $max} {incr nrep} { |
|---|
| 479 | set style [lindex [molinfo $nmol get "{rep $nrep}"] 0] |
|---|
| 480 | set DisplayProps(rep-$nmol-$nrep) $style |
|---|
| 481 | } |
|---|
| 482 | } |
|---|
| 483 | |
|---|
| 484 | # store the scene name for later |
|---|
| 485 | set Scenes(@CURRENT) $name |
|---|
| 486 | |
|---|
| 487 | # if -after arg was given, send back the view after the script |
|---|
| 488 | if {$triggers(after) ne ""} { |
|---|
| 489 | cmd_tellme $triggers(after) getview |
|---|
| 490 | } |
|---|
| 491 | } |
|---|
| 492 | clear { |
|---|
| 493 | foreach mol [molinfo list] { |
|---|
| 494 | set numOfRep [lindex [mol list $mol] 12] |
|---|
| 495 | for {set i 1} {$i <= $numOfRep} {incr i} { |
|---|
| 496 | mol delrep 0 $mol |
|---|
| 497 | } |
|---|
| 498 | } |
|---|
| 499 | set Scenes(@CURRENT) "" |
|---|
| 500 | catch {unset Views} |
|---|
| 501 | |
|---|
| 502 | # reset the server properties |
|---|
| 503 | axes location off |
|---|
| 504 | color Display Background black |
|---|
| 505 | eval $DisplayProps(options) |
|---|
| 506 | } |
|---|
| 507 | forget { |
|---|
| 508 | if {[llength $args] == 0} { |
|---|
| 509 | set args [array names Scenes] |
|---|
| 510 | } |
|---|
| 511 | foreach name $args { |
|---|
| 512 | if {$name eq "@CURRENT"} continue |
|---|
| 513 | catch {unset Scenes($name)} |
|---|
| 514 | if {$name eq $Scenes(@CURRENT)} { |
|---|
| 515 | set Scenes(@CURRENT) "" |
|---|
| 516 | } |
|---|
| 517 | } |
|---|
| 518 | } |
|---|
| 519 | default { |
|---|
| 520 | error "bad option \"$option\": should be define, show, clear, forget" |
|---|
| 521 | } |
|---|
| 522 | } |
|---|
| 523 | } |
|---|
| 524 | $parser alias scene cmd_scene |
|---|
| 525 | |
|---|
| 526 | # ---------------------------------------------------------------------- |
|---|
| 527 | # USAGE: frames defview <frame> {matrixNames...} {matrixValues...} |
|---|
| 528 | # USAGE: frames time <epochValue> <start> ?<finish>? ?<inc>? ?-defview? |
|---|
| 529 | # USAGE: frames rotate <epochValue> <xa> <ya> <za> <number> |
|---|
| 530 | # USAGE: frames max |
|---|
| 531 | # |
|---|
| 532 | # Used to request one or more frames for an animation. A "time" |
|---|
| 533 | # animation is a series of frames between two time points. A "rotate" |
|---|
| 534 | # animation is a series of frames that rotate the view 360 degrees. |
|---|
| 535 | # |
|---|
| 536 | # The <epochValue> is passed by the client to indicate the relevance of |
|---|
| 537 | # the request. Whenever the client enters a new epoch, it is no longer |
|---|
| 538 | # concerned with any earlier epochs, so the server can ignore pending |
|---|
| 539 | # images that are out of date. The server sends back the epoch with |
|---|
| 540 | # all frames so the client can understand if the frames are relevant. |
|---|
| 541 | # |
|---|
| 542 | # The "defview" operation sets the default view associated with each |
|---|
| 543 | # frame. Animation scripts can change the default view to a series of |
|---|
| 544 | # fly-through views. This operation provides a way of storing those |
|---|
| 545 | # views. |
|---|
| 546 | # |
|---|
| 547 | # For a "time" animation, the <start> is a number of a requested frame. |
|---|
| 548 | # The <finish> is the last frame in the series. The <inc> is the step |
|---|
| 549 | # by which the frames should be generated, which may be larger than 1. |
|---|
| 550 | # |
|---|
| 551 | # For a "rotate" animation, the <xa>,<ya>,<za> angles indicate the |
|---|
| 552 | # direction of the rotation. The <number> is the number of frames |
|---|
| 553 | # requested for a full 360 degree rotation. |
|---|
| 554 | # |
|---|
| 555 | # The "frames max" query returns the maximum number of frames in the |
|---|
| 556 | # trajectory. The server uses this to figure out the limits of |
|---|
| 557 | # animation. |
|---|
| 558 | # ---------------------------------------------------------------------- |
|---|
| 559 | proc cmd_frames {what args} { |
|---|
| 560 | global client Epoch Work Views |
|---|
| 561 | |
|---|
| 562 | # check incoming parameters |
|---|
| 563 | switch -- $what { |
|---|
| 564 | time { |
|---|
| 565 | set epochValue [lindex $args 0] |
|---|
| 566 | set start [lindex $args 1] |
|---|
| 567 | |
|---|
| 568 | set i [lsearch $args -defview] |
|---|
| 569 | if {$i >= 0} { |
|---|
| 570 | set defview 1 |
|---|
| 571 | set args [lreplace $args $i $i] |
|---|
| 572 | } else { |
|---|
| 573 | set defview 0 |
|---|
| 574 | } |
|---|
| 575 | |
|---|
| 576 | set finish [lindex $args 2] |
|---|
| 577 | if {$finish eq ""} { set finish $start } |
|---|
| 578 | set inc [lindex $args 3] |
|---|
| 579 | if {$inc eq ""} { set inc 1 } |
|---|
| 580 | |
|---|
| 581 | if {![string is integer $finish]} { |
|---|
| 582 | server_oops $client "bad animation end \"$finish\" should be integer" |
|---|
| 583 | return |
|---|
| 584 | } |
|---|
| 585 | if {![string is integer $inc] || $inc == 0} { |
|---|
| 586 | server_oops $client "bad animation inc \"$inc\" should be non-zero integer" |
|---|
| 587 | return |
|---|
| 588 | } |
|---|
| 589 | if {($finish < $start && $inc > 0) || ($finish > $start && $inc < 0)} { |
|---|
| 590 | server_oops $client "bad animation limits: from $start to $finish by $inc" |
|---|
| 591 | } |
|---|
| 592 | |
|---|
| 593 | # new epoch? then clean out work queue |
|---|
| 594 | if {$epochValue > $Epoch} { |
|---|
| 595 | catch {unset Work} |
|---|
| 596 | set Work(queue) "" |
|---|
| 597 | set Epoch $epochValue |
|---|
| 598 | } |
|---|
| 599 | |
|---|
| 600 | # add these frames to the queue |
|---|
| 601 | if {$inc > 0} { |
|---|
| 602 | # generate frames in play>> direction |
|---|
| 603 | for {set n $start} {$n <= $finish} {incr n $inc} { |
|---|
| 604 | if {![info exists Work($n)]} { |
|---|
| 605 | lappend Work(queue) [list epoch $epochValue frame $n num $n defview $defview] |
|---|
| 606 | set Work($n) 1 |
|---|
| 607 | } |
|---|
| 608 | } |
|---|
| 609 | } else { |
|---|
| 610 | # generate frames in <<play direction |
|---|
| 611 | for {set n $start} {$n >= $finish} {incr n $inc} { |
|---|
| 612 | if {![info exists Work($n)]} { |
|---|
| 613 | lappend Work(queue) [list epoch $epochValue frame $n num $n defview $defview] |
|---|
| 614 | set Work($n) 1 |
|---|
| 615 | } |
|---|
| 616 | } |
|---|
| 617 | } |
|---|
| 618 | } |
|---|
| 619 | rotate { |
|---|
| 620 | set epochValue [lindex $args 0] |
|---|
| 621 | set mx [lindex $args 1] |
|---|
| 622 | if {![string is double -strict $mx]} { |
|---|
| 623 | server_oops $client "bad mx rotation value \"$mx\" should be double" |
|---|
| 624 | return |
|---|
| 625 | } |
|---|
| 626 | set my [lindex $args 2] |
|---|
| 627 | if {![string is double -strict $my]} { |
|---|
| 628 | server_oops $client "bad my rotation value \"$my\" should be double" |
|---|
| 629 | return |
|---|
| 630 | } |
|---|
| 631 | set mz [lindex $args 3] |
|---|
| 632 | if {![string is double -strict $mz]} { |
|---|
| 633 | server_oops $client "bad mz rotation value \"$mz\" should be double" |
|---|
| 634 | return |
|---|
| 635 | } |
|---|
| 636 | set num [lindex $args 4] |
|---|
| 637 | if {![string is integer -strict $num] || $num < 2} { |
|---|
| 638 | server_oops $client "bad number of rotation frames \"$num\" should be integer > 1" |
|---|
| 639 | return |
|---|
| 640 | } |
|---|
| 641 | |
|---|
| 642 | # |
|---|
| 643 | # Compute the rotation matrix for each rotated view. |
|---|
| 644 | # Start with the current rotation matrix. Rotate that around |
|---|
| 645 | # a vector perpendicular to the plane of rotation for the given |
|---|
| 646 | # angles (mx,my,mz). Find vector that by rotating some vector |
|---|
| 647 | # such as (1,1,1) by the angles (mx,my,mz). Do a couple of |
|---|
| 648 | # times and compute the differences between those vectors. |
|---|
| 649 | # Then, compute the cross product of the differences. The |
|---|
| 650 | # result is the axis of rotation. |
|---|
| 651 | # |
|---|
| 652 | set lastrotx [trans axis x $mx deg] |
|---|
| 653 | set lastroty [trans axis y $my deg] |
|---|
| 654 | set lastrotz [trans axis z $mz deg] |
|---|
| 655 | set lastrot [transmult $lastrotx $lastroty $lastrotz] |
|---|
| 656 | |
|---|
| 657 | set lastvec [list 1 1 1] |
|---|
| 658 | foreach v {1 2} { |
|---|
| 659 | foreach row $lastrot comp {x y z w} { |
|---|
| 660 | # multiply each row by last vector |
|---|
| 661 | set vec($comp) 0 |
|---|
| 662 | for {set i 0} {$i < 3} {incr i} { |
|---|
| 663 | set vec($comp) [expr {$vec($comp) + [lindex $row $i]}] |
|---|
| 664 | } |
|---|
| 665 | } |
|---|
| 666 | set vec${v}(x) [expr {$vec(x)-[lindex $lastvec 0]}] |
|---|
| 667 | set vec${v}(y) [expr {$vec(y)-[lindex $lastvec 1]}] |
|---|
| 668 | set vec${v}(z) [expr {$vec(z)-[lindex $lastvec 2]}] |
|---|
| 669 | |
|---|
| 670 | set lastvec [list $vec(x) $vec(y) $vec(z)] |
|---|
| 671 | set lastrot [transmult $lastrot $lastrotx $lastroty $lastrotz] |
|---|
| 672 | } |
|---|
| 673 | |
|---|
| 674 | set crx [expr {$vec1(y)*$vec2(z)-$vec1(z)*$vec2(y)}] |
|---|
| 675 | set cry [expr {$vec1(z)*$vec2(x)-$vec1(x)*$vec2(z)}] |
|---|
| 676 | set crz [expr {$vec1(x)*$vec2(y)-$vec1(y)*$vec2(x)}] |
|---|
| 677 | |
|---|
| 678 | set angle [expr {360.0/$num}] |
|---|
| 679 | set rotby [transabout [list $crx $cry $crz] $angle deg] |
|---|
| 680 | set rotm [lindex [molinfo top get rotate_matrix] 0] |
|---|
| 681 | |
|---|
| 682 | # compute cross product of (1,1,1,0) and rotated vector from above |
|---|
| 683 | |
|---|
| 684 | for {set n 0} {$n < $num} {incr n} { |
|---|
| 685 | lappend Work(queue) [list epoch $epochValue rotate $rotm num $n defview 0] |
|---|
| 686 | set rotm [transmult $rotby $rotm] |
|---|
| 687 | set Work($n) 1 |
|---|
| 688 | } |
|---|
| 689 | } |
|---|
| 690 | defview { |
|---|
| 691 | if {[llength $args] != 3} { error "wrong # args: should be \"defview matrixNameList matrixValueList\"" } |
|---|
| 692 | set n [lindex $args 0] |
|---|
| 693 | if {![string is int $n]} { error "bad frame value \"$n\"" } |
|---|
| 694 | set Views($n) [lrange $args 1 end] |
|---|
| 695 | } |
|---|
| 696 | max { |
|---|
| 697 | set nmol [lindex [molinfo list] 0] |
|---|
| 698 | if {$nmol ne ""} { |
|---|
| 699 | return [molinfo $nmol get numframes] |
|---|
| 700 | } |
|---|
| 701 | return 0 |
|---|
| 702 | } |
|---|
| 703 | default { |
|---|
| 704 | error "bad option \"$what\": should be defview, time, rotate, max" |
|---|
| 705 | } |
|---|
| 706 | } |
|---|
| 707 | |
|---|
| 708 | # service the queue at some point |
|---|
| 709 | server_send_image -eventually |
|---|
| 710 | } |
|---|
| 711 | $parser alias frames cmd_frames |
|---|
| 712 | |
|---|
| 713 | # ---------------------------------------------------------------------- |
|---|
| 714 | # USAGE: getview |
|---|
| 715 | # |
|---|
| 716 | # Used to query the scaling and centering of the initial view set |
|---|
| 717 | # by VMD after a molecule is loaded. Returns the following: |
|---|
| 718 | # <viewName> -rotate <mtx> -global <mtx> -scale <mtx> -center <mtx> |
|---|
| 719 | # ---------------------------------------------------------------------- |
|---|
| 720 | proc cmd_getview {} { |
|---|
| 721 | global Scenes |
|---|
| 722 | |
|---|
| 723 | if {[llength [molinfo list]] == 0} { return "" } |
|---|
| 724 | if {$Scenes(@CURRENT) eq ""} { return "" } |
|---|
| 725 | |
|---|
| 726 | set rval [list $Scenes(@CURRENT)] ;# start with the scene name |
|---|
| 727 | |
|---|
| 728 | lappend rval -rotate [lindex [molinfo top get rotate_matrix] 0] \ |
|---|
| 729 | -scale [lindex [molinfo top get scale_matrix] 0] \ |
|---|
| 730 | -center [lindex [molinfo top get center_matrix] 0] \ |
|---|
| 731 | -global [lindex [molinfo top get global_matrix] 0] |
|---|
| 732 | |
|---|
| 733 | return $rval |
|---|
| 734 | } |
|---|
| 735 | $parser alias getview cmd_getview |
|---|
| 736 | |
|---|
| 737 | # |
|---|
| 738 | # USAGE: server_safe_resize <width> <height> |
|---|
| 739 | # |
|---|
| 740 | # Use this version instead of "display resize" whenever possible. |
|---|
| 741 | # The VMD "display resize" goes into the event loop, so calling that |
|---|
| 742 | # causes things to execute out of order. Use this method instead to |
|---|
| 743 | # store the change and actually resize later. |
|---|
| 744 | # |
|---|
| 745 | proc server_safe_resize {w h} { |
|---|
| 746 | global DisplaySize |
|---|
| 747 | |
|---|
| 748 | if {$w != $DisplaySize(w) || $h != $DisplaySize(h)} { |
|---|
| 749 | set DisplaySize(w) $w |
|---|
| 750 | set DisplaySize(h) $h |
|---|
| 751 | set DisplaySize(changed) yes |
|---|
| 752 | } |
|---|
| 753 | } |
|---|
| 754 | |
|---|
| 755 | # ---------------------------------------------------------------------- |
|---|
| 756 | # SERVER CORE |
|---|
| 757 | # ---------------------------------------------------------------------- |
|---|
| 758 | proc server_accept {cid addr port} { |
|---|
| 759 | global env |
|---|
| 760 | |
|---|
| 761 | fileevent $cid readable [list server_handle $cid $cid] |
|---|
| 762 | fconfigure $cid -buffering none -blocking 0 |
|---|
| 763 | |
|---|
| 764 | if {[info exists env(LOCAL)]} { |
|---|
| 765 | # identify server type to this client |
|---|
| 766 | # VMD on the hub has this built in, but stock versions can |
|---|
| 767 | # set the environment variable as a work-around |
|---|
| 768 | puts $cid "vmd 0.1" |
|---|
| 769 | } |
|---|
| 770 | } |
|---|
| 771 | |
|---|
| 772 | proc server_handle {cin cout} { |
|---|
| 773 | global parser buffer client |
|---|
| 774 | |
|---|
| 775 | if {[gets $cin line] < 0} { |
|---|
| 776 | # when client drops connection, we can exit |
|---|
| 777 | # nanoscale will spawn a new server next time we need it |
|---|
| 778 | if {[eof $cin]} { |
|---|
| 779 | server_exit $cin $cout |
|---|
| 780 | } |
|---|
| 781 | } else { |
|---|
| 782 | append buffer($cin) $line "\n" |
|---|
| 783 | if {[info complete $buffer($cin)]} { |
|---|
| 784 | set request $buffer($cin) |
|---|
| 785 | set buffer($cin) "" |
|---|
| 786 | set client $cout |
|---|
| 787 | if {[catch {$parser eval $request} result] == 0} { |
|---|
| 788 | server_send_image -eventually |
|---|
| 789 | } else { |
|---|
| 790 | server_oops $cout $result |
|---|
| 791 | if { [string match "invalid command*" $result] } { |
|---|
| 792 | bgerror "server received invalid command: $result" |
|---|
| 793 | exit 1 |
|---|
| 794 | } |
|---|
| 795 | } |
|---|
| 796 | } |
|---|
| 797 | } |
|---|
| 798 | } |
|---|
| 799 | |
|---|
| 800 | proc server_send {cout} { |
|---|
| 801 | global Epoch Sendqueue |
|---|
| 802 | |
|---|
| 803 | # grab the next chunk of output and send it along |
|---|
| 804 | # discard any chunks from an older epoch |
|---|
| 805 | while {[llength $Sendqueue] > 0} { |
|---|
| 806 | set chunk [lindex $Sendqueue 0] |
|---|
| 807 | set Sendqueue [lrange $Sendqueue 1 end] |
|---|
| 808 | |
|---|
| 809 | catch {unset data}; array set data $chunk |
|---|
| 810 | if {$data(epoch) < 0 || $data(epoch) == $Epoch} { |
|---|
| 811 | catch {puts $cout $data(cmd)} |
|---|
| 812 | |
|---|
| 813 | # if this command has a binary data block, send it specially |
|---|
| 814 | if {[string length $data(bytes)] > 0} { |
|---|
| 815 | fconfigure $cout -translation binary |
|---|
| 816 | catch {puts $cout $data(bytes)} |
|---|
| 817 | fconfigure $cout -translation auto |
|---|
| 818 | } |
|---|
| 819 | break |
|---|
| 820 | } |
|---|
| 821 | } |
|---|
| 822 | |
|---|
| 823 | # nothing left? Then stop callbacks until we get more |
|---|
| 824 | if {[llength $Sendqueue] == 0} { |
|---|
| 825 | fileevent $cout writable "" |
|---|
| 826 | server_send_image -eventually |
|---|
| 827 | } |
|---|
| 828 | } |
|---|
| 829 | |
|---|
| 830 | proc server_exit {cin cout} { |
|---|
| 831 | catch {close $cin} |
|---|
| 832 | catch {exit 0} |
|---|
| 833 | } |
|---|
| 834 | |
|---|
| 835 | # ---------------------------------------------------------------------- |
|---|
| 836 | # SERVER RESPONSES |
|---|
| 837 | # ---------------------------------------------------------------------- |
|---|
| 838 | |
|---|
| 839 | # turn off constant updates -- only need them during server_send_image |
|---|
| 840 | display update off |
|---|
| 841 | |
|---|
| 842 | proc server_send_image {{when -now}} { |
|---|
| 843 | global client Epoch Work Views Sendqueue DisplaySize |
|---|
| 844 | |
|---|
| 845 | if {$when eq "-eventually"} { |
|---|
| 846 | after cancel server_send_image |
|---|
| 847 | after 1 server_send_image |
|---|
| 848 | return |
|---|
| 849 | } elseif {$when ne "-now"} { |
|---|
| 850 | error "bad option \"$when\" for server_send_image: should be -now or -eventually" |
|---|
| 851 | } |
|---|
| 852 | |
|---|
| 853 | # is there a display resize pending? then resize and try again later |
|---|
| 854 | if {$DisplaySize(changed)} { |
|---|
| 855 | set DisplaySize(changed) 0 |
|---|
| 856 | after idle [list display resize $DisplaySize(w) $DisplaySize(h)] |
|---|
| 857 | after 20 server_send_image |
|---|
| 858 | return |
|---|
| 859 | } |
|---|
| 860 | |
|---|
| 861 | # loop through requests in the work queue and skip any from an older epoch |
|---|
| 862 | while {1} { |
|---|
| 863 | if {[llength $Work(queue)] == 0} { |
|---|
| 864 | return |
|---|
| 865 | } |
|---|
| 866 | |
|---|
| 867 | set rec [lindex $Work(queue) 0] |
|---|
| 868 | set Work(queue) [lrange $Work(queue) 1 end] |
|---|
| 869 | |
|---|
| 870 | catch {unset item}; array set item $rec |
|---|
| 871 | if {$item(epoch) < $Epoch} { |
|---|
| 872 | catch {unset Work($item(num))} |
|---|
| 873 | continue |
|---|
| 874 | } |
|---|
| 875 | |
|---|
| 876 | # set the frame characteristics and render this frame |
|---|
| 877 | if {[info exists item(frame)]} { |
|---|
| 878 | animate goto $item(frame) |
|---|
| 879 | } elseif {[info exists item(rotate)]} { |
|---|
| 880 | molinfo top set rotate_matrix [list $item(rotate)] |
|---|
| 881 | # send rotation matrix back to the client so we can pause later |
|---|
| 882 | server_send_latest $client [list nv>rotatemtx $item(num) $item(rotate)] |
|---|
| 883 | } else { |
|---|
| 884 | puts "ERROR: bad work frame: [array get item]" |
|---|
| 885 | } |
|---|
| 886 | |
|---|
| 887 | # flag to use the stored default view? then set that |
|---|
| 888 | if {[info exists item(defview)] && $item(defview)} { |
|---|
| 889 | if {[info exists Views($item(frame))]} { |
|---|
| 890 | eval molinfo top set $Views($item(frame)) |
|---|
| 891 | } |
|---|
| 892 | } |
|---|
| 893 | catch {unset Work($item(num))} |
|---|
| 894 | break |
|---|
| 895 | } |
|---|
| 896 | |
|---|
| 897 | # force VMD to update and grab the screen |
|---|
| 898 | display update |
|---|
| 899 | tkrender SnapShot |
|---|
| 900 | |
|---|
| 901 | set data [SnapShot data -format PPM] |
|---|
| 902 | server_send_latest $client "nv>image epoch $item(epoch) frame $item(num) length [string length $data]" $data |
|---|
| 903 | |
|---|
| 904 | # if there's more work in the queue, try again later |
|---|
| 905 | if {[llength $Work(queue)] > 0} { |
|---|
| 906 | after 1 server_send_image |
|---|
| 907 | } |
|---|
| 908 | } |
|---|
| 909 | |
|---|
| 910 | proc server_send_result {cout cmd {data ""}} { |
|---|
| 911 | global Sendqueue |
|---|
| 912 | |
|---|
| 913 | # add this result to the output queue |
|---|
| 914 | # use the epoch -1 to force the send even if the epoch has changed |
|---|
| 915 | lappend Sendqueue [list epoch -1 cmd $cmd bytes $data] |
|---|
| 916 | fileevent $cout writable [list server_send $cout] |
|---|
| 917 | } |
|---|
| 918 | |
|---|
| 919 | proc server_send_latest {cout cmd {data ""}} { |
|---|
| 920 | global Epoch Sendqueue |
|---|
| 921 | |
|---|
| 922 | # add this result to the output queue |
|---|
| 923 | # wait until the client is ready, then send the output |
|---|
| 924 | lappend Sendqueue [list epoch $Epoch cmd $cmd bytes $data] |
|---|
| 925 | fileevent $cout writable [list server_send $cout] |
|---|
| 926 | } |
|---|
| 927 | |
|---|
| 928 | proc server_oops {cout mesg} { |
|---|
| 929 | # remove newlines -- all lines must start with nv> |
|---|
| 930 | set mesg [string map {\n " "} $mesg] |
|---|
| 931 | server_send_result $cout "nv>oops [list $mesg]" |
|---|
| 932 | } |
|---|
| 933 | |
|---|
| 934 | if {$Paradigm eq "socket"} { |
|---|
| 935 | socket -server server_accept 2018 |
|---|
| 936 | } else { |
|---|
| 937 | set cin $vmd_client(read) |
|---|
| 938 | set cout $vmd_client(write) |
|---|
| 939 | |
|---|
| 940 | fileevent $cin readable [list server_handle $cin $cout] |
|---|
| 941 | fconfigure $cout -buffering none -blocking 0 |
|---|
| 942 | } |
|---|
| 943 | |
|---|
| 944 | # vmd automatically drops into an event loop at this point... |
|---|
| 945 | # |
|---|
| 946 | # The VMD TCL interpreter is by default interactive. Their version |
|---|
| 947 | # of tkconsole always turns this on. Turn this off |
|---|
| 948 | # so that unknown commands like "scene" don't get exec-ed. |
|---|
| 949 | set ::tcl_interactive 0 |
|---|
