source: trunk/packages/vizservers/vmd/vmdserver.tcl @ 4252

Last change on this file since 4252 was 4252, checked in by mmc, 6 years ago

Updated VMD server script from MD Showcase.

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