Changeset 4252 for trunk/packages
- Timestamp:
- Mar 19, 2014, 9:43:25 AM (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/packages/vizservers/vmd/vmdserver.tcl
r4152 r4252 41 41 set DisplaySize(changed) 0 42 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 43 66 # initialize work queue and epoch counter (see server_send_image) 44 67 set Epoch 0 … … 54 77 color 55 78 axes 56 display57 79 imd 58 80 vmdcollab … … 90 112 91 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 # ---------------------------------------------------------------------- 92 131 # USAGE: tellme "command template with %v" command arg arg... 93 132 # … … 262 301 set op "addfile" 263 302 } 303 304 # BE CAREFUL -- force a "display update" here 305 # that triggers something in VMD that changes view matrices now, 306 # so if we change them later, the new values stick 307 display update 264 308 } 265 309 $parser alias load cmd_load … … 267 311 # ---------------------------------------------------------------------- 268 312 # USAGE: scene define <name> <script> 269 # USAGE: scene show <name> ?- send <initialViewCmd>?313 # USAGE: scene show <name> ?-before <viewCmd>? ?-after <viewCmd>? 270 314 # USAGE: scene clear 271 315 # USAGE: scene forget ?<name> <name>...? … … 293 337 } 294 338 show { 295 if {[llength $args] < 1 || [llength $args] > 3} {296 error "wrong # args: should be \"scene show name ?- sendcmd?\""339 if {[llength $args] < 1 || [llength $args] > 5} { 340 error "wrong # args: should be \"scene show name ?-before cmd? ?-after cmd?\"" 297 341 } 298 342 set name [lindex $args 0] … … 301 345 } 302 346 303 set sendcmd "" 347 set triggers(before) "" 348 set triggers(after) "" 304 349 foreach {key val} [lrange $args 1 end] { 305 350 switch -- $key { 306 -send { set sendcmd $val } 307 default { error "bad option \"$key\": should be -send" } 351 -before { set triggers(before) $val } 352 -after { set triggers(after) $val } 353 default { error "bad option \"$key\": should be -before, -after" } 308 354 } 355 } 356 357 # if -before arg was given, send back the view right now 358 if {$triggers(before) ne "" && $Scenes(@CURRENT) ne ""} { 359 cmd_tellme $triggers(before) getview 309 360 } 310 361 311 362 # clear the old scene 312 363 cmd_scene clear 364 display resetview 313 365 314 366 # use a safe interp to keep things safe 315 display resetview 367 foreach val [$parser eval {info vars}] { 368 # clear all variables created by previous scripts 369 $parser eval [list catch [list unset $val]] 370 } 316 371 if {[catch {$parser eval $Scenes($name)} result]} { 317 372 error "$result\nwhile loading scene \"$name\"" … … 333 388 set Scenes(@CURRENT) $name 334 389 335 # if - sendarg was given, send back the view after the script336 if {$ sendcmdne ""} {337 cmd_tellme $ sendcmdgetview390 # if -after arg was given, send back the view after the script 391 if {$triggers(after) ne ""} { 392 cmd_tellme $triggers(after) getview 338 393 } 339 394 } … … 351 406 axes location off 352 407 color Display Background black 353 display backgroundgradient off408 eval $DisplayProps(options) 354 409 } 355 410 forget { … … 605 660 # ---------------------------------------------------------------------- 606 661 proc server_accept {cid addr port} { 662 global env 663 607 664 fileevent $cid readable [list server_handle $cid $cid] 608 665 fconfigure $cid -buffering none -blocking 0 666 667 if {[info exists env(LOCAL)]} { 668 # identify server type to this client 669 # VMD on the hub has this built in, but stock versions can 670 # set the environment variable as a work-around 671 puts $cid "vmd 0.1" 672 } 609 673 } 610 674 … … 615 679 # when client drops connection, we can exit 616 680 # nanoscale will spawn a new server next time we need it 617 server_exit $cin $cout 681 if {[eof $cin]} { 682 server_exit $cin $cout 683 } 618 684 } else { 619 685 append buffer($cin) $line "\n" … … 645 711 646 712 catch {unset data}; array set data $chunk 647 if {$data(epoch) == $Epoch} {713 if {$data(epoch) < 0 || $data(epoch) == $Epoch} { 648 714 catch {puts $cout $data(cmd)} 649 715 … … 717 783 molinfo top set rotate_matrix [list $item(rotate)] 718 784 # send rotation matrix back to the client so we can pause later 719 server_send_ result $client [list nv>rotatemtx $item(num) $item(rotate)]785 server_send_latest $client [list nv>rotatemtx $item(num) $item(rotate)] 720 786 } else { 721 787 puts "ERROR: bad work frame: [array get item]" … … 737 803 738 804 set data [SnapShot data -format PPM] 739 server_send_ result $client "nv>image epoch $item(epoch) frame $item(num) length [string length $data]" $data805 server_send_latest $client "nv>image epoch $item(epoch) frame $item(num) length [string length $data]" $data 740 806 741 807 # if there's more work in the queue, try again later … … 746 812 747 813 proc server_send_result {cout cmd {data ""}} { 814 global Sendqueue 815 816 # add this result to the output queue 817 # use the epoch -1 to force the send even if the epoch has changed 818 lappend Sendqueue [list epoch -1 cmd $cmd bytes $data] 819 fileevent $cout writable [list server_send $cout] 820 } 821 822 proc server_send_latest {cout cmd {data ""}} { 748 823 global Epoch Sendqueue 749 824
Note: See TracChangeset
for help on using the changeset viewer.