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

Last change on this file since 4097 was 4097, checked in by gah, 7 years ago

added vmd render server. fixed visviewer.tcl to look for something that looks like the servername and version. vmd polutes stdout with lots of text. I think the ultimate solution is to dup file descriptors 3 and 4 (instead of 0, 1, and 2) to the opened socket.

File size: 15.9 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
11set ::tcl_interactive 0
12
13# parse command line args
14set Paradigm "socket"
15while {[llength $argv] > 0} {
16    set opt [lindex $argv 0]
17    set argv [lrange $argv 1 end]
18
19    switch -- $opt {
20        -socket { set Paradigm "socket" }
21        -stdio  { set Paradigm "stdio" }
22        default {
23            puts stderr "bad option \"$opt\": should be -socket or -stdio"
24        }
25    }
26}
27
28# use this to take snapshots to send to clients
29image create photo SnapShot
30
31# set the screen to a good size
32#display resize 300 300
33
34# initialize work queue and epoch counter (see server_send_image)
35set Epoch 0
36set Work(queue) ""
37set Sendqueue ""
38
39set parser [interp create -safe]
40
41foreach cmd {
42  vmdinfo
43  vmdbench
44  animate
45  color
46  axes
47  display
48  imd
49  vmdcollab
50  vmd_label
51  light
52  material
53  vmd_menu
54  stage
55  light
56  user
57  mol
58  molinfo
59  molecule
60  mouse
61  mobile
62  spaceball
63  plugin
64  render
65  tkrender
66  rock
67  rotate
68  rotmat
69  vmd_scale
70  translate
71  sleep
72  tool
73  measure
74  rawtimestep
75  gettimestep
76  vmdcon
77  volmap
78  parallel
79} {
80    $parser alias $cmd $cmd
81}
82
83# ----------------------------------------------------------------------
84# USAGE: tellme "command template with %v" command arg arg...
85#
86# Executes the "command arg arg..." string in the server and substitutes
87# the result into the template string in place of each "%v" field.
88# Sends the result back to the client.
89# ----------------------------------------------------------------------
90proc cmd_tellme {fmt args} {
91    global parser client
92
93    # evaluate args as a command and subst the result in the fmt string
94    if {[catch {$parser eval $args} result] == 0} {
95        server_send_result $client "nv>[string map [list %v $result] $fmt]"
96    } else {
97        server_oops $client $result
98    }
99}
100$parser alias tellme cmd_tellme
101
102# ----------------------------------------------------------------------
103# USAGE: reset
104#
105# Executes the "command arg arg..." string in the server and substitutes
106# the result into the template string in place of each "%v" field.
107# Sends the result back to the client.
108# ----------------------------------------------------------------------
109proc cmd_reset {} {
110    global client
111
112    # reset the view so we get a good scale matrix below
113    display resetview
114
115    # reset scale -- figure out size by querying molinfo for first molecule
116    set nmol [lindex [molinfo list] 0]
117    if {$nmol ne ""} {
118        set matrix [molinfo $nmol get scale_matrix]
119        set sf [lindex [lindex [lindex $matrix 0] 0] 0]
120        vmd_scale to $sf
121        server_send_result $client "nv>scale $sf"
122    }
123
124    axes location off
125}
126$parser alias reset cmd_reset
127
128# ----------------------------------------------------------------------
129# USAGE: resize <w> <h>
130#
131# Resizes the visualization window to the given width <w> and height
132# <h>.  The next image sent should be this size.
133# ----------------------------------------------------------------------
134proc cmd_resize {w h} {
135    display resize $w $h
136    display update
137}
138$parser alias resize cmd_resize
139
140# ----------------------------------------------------------------------
141# USAGE: load <file> <file>...
142#
143# Loads the molecule data from one or more files, which may be PDB,
144# DCD, PSF, etc.
145# ----------------------------------------------------------------------
146proc cmd_load {args} {
147    # clear all existing molecules
148    foreach nmol [molinfo list] {
149        mol delete $nmol
150    }
151
152    # clear any existing views
153    cmd_view forget
154
155    # load new files
156    set op "new"
157    foreach file $args {
158        mol $op $file waitfor all
159        set op "addfile"
160    }
161}
162$parser alias load cmd_load
163
164# ----------------------------------------------------------------------
165# USAGE: view define <name> <script>
166# USAGE: view show <name>
167# USAGE: view clear
168# USAGE: view forget ?<name> <name>...?
169#
170# Used to define and manipulate views of the trajectory information
171# loaded previously by the "load" command.  The "define" operation
172# defines the script that loads a view called <name>.  The "show"
173# operation executes that script to show the view.  The "clear"
174# operation clears the current view (usually in preparation for
175# showing another view).  The "forget" operation erases one or more
176# view definitions; if no names are specified, then all views are
177# forgotten.
178# ----------------------------------------------------------------------
179proc cmd_view {option args} {
180    global Views parser
181    switch -- $option {
182        define {
183            if {[llength $args] != 2} {
184                error "wrong # args: should be \"view define name script\""
185            }
186            set name [lindex $args 0]
187            set script [lindex $args 1]
188            set Views($name) $script
189        }
190        show {
191            if {[llength $args] != 1} {
192                error "wrong # args: should be \"view show name\""
193            }
194            set name [lindex $args 0]
195            if {![info exists Views($name)]} {
196                error "bad view name \"$name\": should be one of [join [array names Views] {, }]"
197            }
198
199            # clear the old view
200            cmd_view clear
201
202            # use a safe interp to keep things safe
203            if {[catch {$parser eval $Views($name)} result]} {
204                error "$result\nwhile loading view \"$name\""
205            }
206        }
207        clear {
208            set numOfRep [lindex [mol list top] 12]
209            for {set i 1} {$i <= $numOfRep} {incr i} {
210                mol delrep top 0
211            }
212            cmd_reset
213        }
214        forget {
215            if {[llength $args] == 0} {
216                set args [array names Views]
217            }
218            foreach name $args {
219                catch {unset Views($name)}
220            }
221        }
222        default {
223            error "bad option \"$option\": should be define, show, clear, forget"
224        }
225    }
226}
227$parser alias view cmd_view
228
229# ----------------------------------------------------------------------
230# USAGE: frames time <epochValue> <start> ?<finish>? ?<inc>?
231# USAGE: frames rotate <epochValue> <xa> <ya> <za> <number>
232# USAGE: frames max
233#
234# Used to request one or more frames for an animation.  A "time"
235# animation is a series of frames between two time points.  A "rotate"
236# animation is a series of frames that rotate the view 360 degrees.
237#
238# The <epochValue> is passed by the client to indicate the relevance of
239# the request.  Whenever the client enters a new epoch, it is no longer
240# concerned with any earlier epochs, so the server can ignore pending
241# images that are out of date.  The server sends back the epoch with
242# all frames so the client can understand if the frames are relevant.
243#
244# For a "time" animation, the <start> is a number of a requested frame.
245# The <finish> is the last frame in the series.  The <inc> is the step
246# by which the frames should be generated, which may be larger than 1.
247#
248# For a "rotate" animation, the <xa>,<ya>,<za> angles indicate the
249# direction of the rotation.  The <number> is the number of frames
250# requested for a full 360 degree rotation.
251#
252# The "frames max" query returns the maximum number of frames in the
253# trajectory.  The server uses this to figure out the limits of
254# animation.
255# ----------------------------------------------------------------------
256proc cmd_frames {what args} {
257    global client Epoch Work
258
259    # check incoming parameters
260    switch -- $what {
261      time {
262        set epochValue [lindex $args 0]
263        set start [lindex $args 1]
264        set finish [lindex $args 2]
265        if {$finish eq ""} { set finish $start }
266        set inc [lindex $args 3]
267        if {$inc eq ""} { set inc 1 }
268
269        if {![string is integer $finish]} {
270            server_oops $client "bad animation end \"$finish\" should be integer"
271            return
272        }
273        if {![string is integer $inc] || $inc == 0} {
274            server_oops $client "bad animation inc \"$inc\" should be non-zero integer"
275            return
276        }
277        if {($finish < $start && $inc > 0) || ($finish > $start && $inc < 0)} {
278            server_oops $client "bad animation limits: from $start to $finish by $inc"
279        }
280
281        # new epoch? then clean out work queue
282        if {$epochValue > $Epoch} {
283            catch {unset Work}
284            set Work(queue) ""
285            set Epoch $epochValue
286        }
287
288        # add these frames to the queue
289        if {$inc > 0} {
290            # generate frames in play>> direction
291            for {set n $start} {$n <= $finish} {incr n $inc} {
292                if {![info exists Work($n)]} {
293                    lappend Work(queue) [list epoch $epochValue frame $n num $n]
294                    set Work($n) 1
295                }
296            }
297        } else {
298            # generate frames in <<play direction
299            for {set n $start} {$n >= $finish} {incr n $inc} {
300                if {![info exists Work($n)]} {
301                    lappend Work(queue) [list epoch $epochValue frame $n num $n]
302                    set Work($n) 1
303                }
304            }
305        }
306      }
307      rotate {
308        set epochValue [lindex $args 0]
309        set mx [lindex $args 1]
310        if {![string is double -strict $mx]} {
311            server_oops $client "bad mx rotation value \"$mx\" should be double"
312            return
313        }
314        set my [lindex $args 2]
315        if {![string is double -strict $my]} {
316            server_oops $client "bad my rotation value \"$my\" should be double"
317            return
318        }
319        set mz [lindex $args 3]
320        if {![string is double -strict $mz]} {
321            server_oops $client "bad mz rotation value \"$mz\" should be double"
322            return
323        }
324        set num [lindex $args 4]
325        if {![string is integer -strict $num] || $num <= 0} {
326            server_oops $client "bad number of rotation frames \"$num\" should be integer > 0"
327            return
328        }
329
330        set rot [list $mx $my $mz]
331        for {set n 0} {$n < $num} {incr n} {
332            lappend Work(queue) [list epoch $epochValue rotate $rot num $n]
333            set Work($n) 1
334        }
335      }
336      max {
337        set nmol [lindex [molinfo list] 0]
338        if {$nmol ne ""} {
339            return [molinfo $nmol get numframes]
340        }
341        return 0
342      }
343      default {
344        error "bad option \"$what\": should be time, rotate, max"
345      }
346    }
347
348    # service the queue at some point
349    server_send_image -eventually
350}
351$parser alias frames cmd_frames
352
353# ----------------------------------------------------------------------
354# SERVER CORE
355# ----------------------------------------------------------------------
356proc server_accept {cid addr port} {
357    fileevent $cid readable [list server_handle $cid $cid]
358    fconfigure $cid -buffering none -blocking 0
359
360    # identify server type to this client
361    puts $cid "vmd 0.1"
362}
363
364proc server_handle {cin cout} {
365    global parser buffer client
366
367    if {[gets $cin request] < 0} {
368        # when client drops connection, we can exit
369        # nanoscale will spawn a new server next time we need it
370        server_exit $cin $cout
371    } else {
372        append buffer($cin) $request "\n"
373        if {[info complete $buffer($cin)]} {
374            set request $buffer($cin)
375            set buffer($cin) ""
376            set client $cout
377            if {[catch {$parser eval $request} result] == 0} {
378                server_send_image -eventually
379            } else {
380                server_oops $cout $result
381            }
382        }
383    }
384}
385
386proc server_send {cout} {
387    global Epoch Sendqueue
388
389    # grab the next chunk of output and send it along
390    # discard any chunks from an older epoch
391    while {[llength $Sendqueue] > 0} {
392        set chunk [lindex $Sendqueue 0]
393        set Sendqueue [lrange $Sendqueue 1 end]
394
395        catch {unset data}; array set data $chunk
396        if {$data(epoch) == $Epoch} {
397            catch {puts $cout $data(cmd)}
398
399            # if this command has a binary data block, send it specially
400            if {[string length $data(bytes)] > 0} {
401                fconfigure $cout -translation binary
402                catch {puts $cout $data(bytes)}
403                fconfigure $cout -translation auto
404            }
405            break
406        }
407    }
408
409    # nothing left? Then stop callbacks until we get more
410    if {[llength $Sendqueue] == 0} {
411        fileevent $cout writable ""
412        server_send_image -eventually
413    }
414}
415
416proc server_exit {cin cout} {
417    catch {close $cin}
418    catch {exit 0}
419}
420
421# ----------------------------------------------------------------------
422# SERVER RESPONSES
423# ----------------------------------------------------------------------
424#
425
426#set the screen to a good size
427display resize 300 300
428
429
430# turn off constant updates -- only need them during server_send_image
431display update off
432
433proc server_send_image {{when -now}} {
434    global client Epoch Work Sendqueue
435
436    if {$when eq "-eventually"} {
437        after cancel server_send_image
438        after 1 server_send_image
439        return
440    } elseif {$when ne "-now"} {
441        error "bad option \"$when\" for server_send_image: should be -now or -eventually"
442    }
443
444    # loop through requests in the work queue and skip any from an older epoch
445    while {1} {
446        if {[llength $Work(queue)] == 0} {
447            return
448        }
449
450        set rec [lindex $Work(queue) 0]
451        set Work(queue) [lrange $Work(queue) 1 end]
452
453        catch {unset item}; array set item $rec
454        if {$item(epoch) < $Epoch} {
455            catch {unset Work($item(num))}
456            continue
457        }
458
459        # set the frame characteristics and render this frame
460        if {[info exists item(frame)]} {
461            animate goto $item(frame)
462        } elseif {[info exists item(rotate)]} {
463            foreach {mx my mz} $item(rotate) break
464            rotate x by $mx
465            rotate y by $my
466            rotate z by $mz
467        } else {
468            puts "ERROR: bad work frame: [array get item]"
469        }
470        catch {unset Work($item(num))}
471        break
472    }
473
474    # force VMD to update and grab the screen
475    display update
476    tkrender SnapShot
477
478    set data [SnapShot data -format PPM]
479    server_send_result $client "nv>image epoch $item(epoch) frame $item(num) length [string length $data]" $data
480
481    # if there's more work in the queue, try again later
482    if {[llength $Work(queue)] > 0} {
483        after 1 server_send_image
484    }
485}
486
487proc server_send_result {cout cmd {data ""}} {
488    global Epoch Sendqueue
489
490    # add this result to the output queue
491    # wait until the client is ready, then send the output
492    lappend Sendqueue [list epoch $Epoch cmd $cmd bytes $data]
493    fileevent $cout writable [list server_send $cout]
494}
495
496proc server_oops {cout mesg} {
497    # remove newlines -- all lines must start with nv>
498    set mesg [string map {\n " "} $mesg]
499    server_send_result $cout "nv>oops [list $mesg]"
500}
501
502if {$Paradigm eq "socket"} {
503    socket -server server_accept 2018
504} else {
505    fileevent stdin readable [list server_handle stdin stdout]
506
507    # identify server type to this client
508    puts stdout "vmd 0.1"
509    flush stdout
510    fconfigure stdout -buffering none -blocking 0
511}
512
513# vmd automatically drops into an event loop at this point...
514set ::tcl_interactive 0
Note: See TracBrowser for help on using the repository browser.