diff options
| -rw-r--r-- | net/ricketyspace/ror/fourteen/server.rkt | 35 |
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) |