fourteen/server.rkt: Updat serialized universe sent to clients.

Now, in the serialized universe sent to the players, all the waypoints
except the first one are removed from the serialized player struct for
all players except the player for which the serialized universe is
constructed.

1 files changed, 34 insertions, 1 deletions

diff --git a/net/ricketyspace/ror/fourteen/server.rkt b/net/ricketyspace/ror/fourteen/server.rkt
index 5ec8c0f..3a91788 100644
--- a/net/ricketyspace/ror/fourteen/server.rkt
+++ b/net/ricketyspace/ror/fourteen/server.rkt
@@ -450,7 +450,7 @@ The server is responsible for:
 ;; PlayUniverse -> [Bundle PlayUniverse [Listof [Mail StateMessage]]]
 ;; bundle this universe, serialize it, broadcast it, and drop noone
 (define (broadcast-universe p)
-  (define mails (broadcast (get-iws p) (serialize-universe p)))
+  (define mails (broadcast-for (get-ips p) p))
   (make-bundle p mails empty))
 
 ;; [Listof IWorlds] Message -> [Listof Mail]
@@ -464,6 +464,35 @@ The server is responsible for:
   (define serialized-players (map ip-player (play-players p)))
   (list SERIALIZE serialized-players (play-food p)))
 
+;; [Listof IPs] PlayUniverse -> [Listof Mail]
+;; generates mails for all clients
+(define (broadcast-for ips p)
+  (define (mk-mail-for pl)
+    (make-mail (ip-iw pl) (serialize-universe-for pl p)))
+  (foldl (lambda (pl mails) (cons (mk-mail-for pl) mails)) '() ips))
+
+;; IP PlayUniverse -> (list s [Listof SerializedPlayer] [ListOf SerializedFood])
+;; prepares message for an update world/ServerState state for a player
+(define (serialize-universe-for pl p)
+  (list SERIALIZE
+        (serialize-players-for pl (play-players p))
+        (play-food p)))
+
+;; IP IPs -> [ListOf SerializedPlayer]
+;; prepares serialized list of players for the SERIALIZE message for a
+;; player.
+(define (serialize-players-for pl pls)
+  (define (filter-out waypoints)
+    (if (empty? waypoints)
+        waypoints
+    (list (first waypoints))))
+  (define (mk-pl plyr)
+    (cond [(id=? (ip-id plyr) (ip-id pl)) (ip-player plyr)]
+          [else (player (ip-id plyr)
+                        (ip-body plyr)
+                        (filter-out (ip-waypoints plyr)))]))
+  (foldl (lambda (plyr srlzd-pls) (cons (mk-pl plyr) srlzd-pls)) '() pls))
+
 ;                                                                                  
 ;                                                                                  
 ;                                                                                  
@@ -520,6 +549,10 @@ The server is responsible for:
 (define (get-iws p)
   (map ip-iw (append (play-players p) (play-spectators p))))
 
+;; PlayUnivers -> [Listof IP]
+(define (get-ips p)
+  (append (play-players p) (play-spectators p)))
+
 ;; ServerState -> Bundle
 ;; makes a bundle that sends no messages and disconnects noone
 (define (empty-bundle s)