source: vmdshow/trunk/vmdserver.tcl @ 6373

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

Update from render07, whitespace

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