source: vmdshow/branches/0.1/vmdserver.tcl @ 5081

Last change on this file since 5081 was 5081, checked in by ldelgass, 6 years ago

merge from trunk

  • Property svn:eol-style set to native
File size: 30.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  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# ----------------------------------------------------------------------
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: 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# ----------------------------------------------------------------------
155proc 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# ----------------------------------------------------------------------
189proc 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# ----------------------------------------------------------------------
207proc 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# ----------------------------------------------------------------------
240proc 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# ----------------------------------------------------------------------
286proc 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# ----------------------------------------------------------------------
311proc 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# ----------------------------------------------------------------------
334proc cmd_animate {args} {
335    # do nothing
336}
337$parser alias animate cmd_animate
338
339proc 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# ----------------------------------------------------------------------
347proc 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# ----------------------------------------------------------------------
363proc 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# ----------------------------------------------------------------------
421proc 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# ----------------------------------------------------------------------
559proc 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# ----------------------------------------------------------------------
720proc 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#
745proc 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# ----------------------------------------------------------------------
758proc 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
772proc 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
800proc 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
830proc 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
840display update off
841
842proc 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
910proc 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
919proc 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
928proc 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
934if {$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.
949set ::tcl_interactive 0
Note: See TracBrowser for help on using the repository browser.