Refactor (server)

src/junebot/server.clj

@@ -1,77 +1,98 @@
 (ns junebot.server)
 (use 'lamina.core 'aleph.object 'gloss.core)
 
-(def world
-  (remove nil?
-          (for [x (range 50) y (range 30)]
-            (when (or (= x 0)
-                      (= x 49)
-                      (= y 0)
-                      (= y 29)
-                      (= 0 (rand-int 5)))
-              {:type :wall, :name "wall", :coord [x y]}))))
-
-(def players (atom {}))
-
-(def shots (atom []))
-
-(def player-serial (atom 0))
-
-(defn new-player-serial []
-  (swap! player-serial inc))
+(defn init-walls []
+  (for [x (range 50)
+        y (range 30)
+        :when (or (= x 0)
+                  (= x 49)
+                  (= y 0)
+                  (= y 29)
+                  (= 0 (rand-int 5)))]
+    {:type :wall, :name "wall", :coord [x y]}))
 
 (def directions
   {"N" [0 -1], "S" [0 1], "E" [1 0], "W" [-1 0]})
 
 (defn positions-taken [state]
-  (set (map :coord (concat world (vals state)))))
+  (set (map :coord state)))
 
 (defn free-position? [state pos]
   (not (get (positions-taken state) pos)))
 
 (defn calculate-position
-  [state id movement]
-  (mapv + (get-in state [id :coord]) movement))
-
-(defn move [state id movement]
-  (let [new-pos (calculate-position state id movement)]
-    (if (free-position? state new-pos)
-      (-> state
-        (assoc-in [id :coord] new-pos)
-        (assoc-in [id :direction] movement))
+  [player movement]
+  (mapv + (:coord player) movement))
+
+(defn move [{:keys [players walls] :as state} id movement]
+  (let [player (players id)
+        new-pos (calculate-position player movement)]
+    (if (free-position? (concat (vals players) walls) new-pos)
+      (assoc-in state [:players id]
+                (-> player
+                    (assoc :coord new-pos)
+                    (assoc :direction movement)))
       state)))
 
 (defmulti process-message
-  (fn [id [message-type]]
+  (fn [state id [message-type]]
     message-type))
 
+(defn add-shot
+  [{:keys [walls players shots] :as state} position]
+  (if (free-position? (concat walls (vals players)) position)
+    (assoc state :shots (conj shots {:position position}))
+    state))
+
 (defmethod process-message :fire
-  [id _]
-  (let [position (calculate-position @players id (get-in @players [id :direction]))]
-    (when (free-position? @players position)
-      (swap! shots conj {:position position}))
-    [:update-shots @shots]))
+  [{:keys [players] :as state} id _]
+  (let [players (:players state)
+        position (calculate-position (players id) (get-in players [id :direction]))
+        new-state (add-shot state position)]
+    {:new-state new-state
+     :send-back [:update-shots (:shots new-state)]}))
 
 (defmethod process-message :move
-  [id [_ message]]
-  (let [movement (get directions message)]
-    [:update-players (vals (swap! players move id movement))]))
-
-(def broadcast-channel (channel))
-
-(defn disconnect-client [id]
-  (swap! players dissoc id))
-
-(defn new-client [ch message]
-  (let [id (new-player-serial)]
-    (on-closed ch (fn [] (disconnect-client id)))
-    (swap! players assoc id {:type :client, :name (message :name), :coord [1 1]})
-    (siphon (map* #(process-message id %) ch) broadcast-channel)
+  [{:keys [players walls] :as state} id [_ message]]
+  (let [movement (get directions message)
+        new-state (move state id movement)]
+    {:new-state new-state
+     :send-back [:update-players (vals (:players new-state))]}))
+
+(defrecord Server [world-state broadcast-channel])
+
+(defn create-server []
+  (map->Server
+   {:broadcast-channel (channel),
+    :world-state (atom {:id-counter 0
+                        :walls (init-walls),
+                        :players {},
+                        :shots []})}))
+
+(def ^:dynamic *send-to-client* nil)
+
+(defn update-and-send [{:keys [broadcast-channel world-state]} id client-message]
+  (binding [*send-to-client* nil]
+    (swap! world-state
+           (fn [state]
+             (let [{:keys [send-back new-state]}
+                   (process-message state id client-message)]
+               (set! *send-to-client* send-back)
+               new-state)))
+    (enqueue broadcast-channel *send-to-client*)))
+
+(defn new-client [{:keys [world-state broadcast-channel] :as server} ch message]
+  (let [id (swap! world-state update-in [:id-counter] inc)]
+    (on-closed ch (fn [] (swap! world-state update-in [:players] dissoc id)))
+    (swap! (:world-state server) assoc-in [:players id]
+           {:type :client, :name (message :name), :coord [1 1]})
+    (map* (partial update-and-send server id) ch)
     (siphon broadcast-channel ch)
-    (enqueue ch [:new-world world])))
+    (enqueue ch [:new-world (:walls @world-state)])))
 
 (defn junehandler [ch info]
-  (receive ch #(new-client ch %)))
+  (let [server (create-server)]
+    (receive ch #(new-client server ch %))))
 
 (defn -main []
   (start-object-server junehandler {:port 5000}))