source: vmdshow/tags/0.1.2/vmdserver.tcl @ 6369

Last change on this file since 6369 was 6186, checked in by ldelgass, 8 years ago

merge from trunk

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