Implement movement logic

src/bombnet/game.clj

@@ -0,0 +1,85 @@
+(ns bombnet.game
+  (:require [clojure.test :refer [is with-test]]))
+
+(defn new-board [w h]
+  (let [should-wall (fn [row col]
+                      (or
+                        (= row 0)
+                        (= row (- h 1))
+                        (= col 0)
+                        (= col (- w 1))
+                        (= 0 (mod row 2) (mod col 2))))]
+    (vec (map (fn [row]
+                (vec (map (fn [col]
+                            (if (should-wall row col) "#" " "))
+                          (range 0 w))))
+              (range 0 h )))))
+
+(with-test
+  (defn get-pos [entity]
+    (cond
+      (vector? entity) entity
+      (:pos entity) (:pos entity)))
+  (is [2 3] (get-pos [2 3]))
+  (is [2 3] (get-pos {:pos [2 3]})))
+
+(defn get-cell [board entity]
+  (let [[x y] (get-pos entity)] (get-in board [y x])))
+
+(defn new-player [id] {:id id :pos [1 1] :color "red"})
+
+(defn move-player
+  ([p x y] (assoc p :pos [x y]))
+  ([p dir]
+   (let [[x y] (:pos p)]
+     (condp = dir
+       "up" (move-player p x (- y 1))
+       "down" (move-player p x (+ y 1))
+       "left" (move-player p (- x 1) y)
+       "right" (move-player p (+ x 1) y)))))
+
+(defn new-game []
+  {:board (new-board 21 17)
+   :players []
+   :bombs []})
+
+(defn check-positions [state]
+  "Returns a vector of valid new player positions"
+  (let [{:keys [board players bombs]} state
+        wall-clear (fn [p] (= " " (get-cell board p)))
+        collides (fn [a b] (and (not= a b) (= (get-pos a) (get-pos b))))
+        swap-clear (fn [p] (every? (fn [e]
+                                     (not (and
+                                            (= (:prev-pos p) (:pos e))
+                                            (= (:prev-pos e) (:pos p)))))
+                                   players))
+        entity-clear (fn [entities] (fn [p] (every? #(not (collides p %)) entities)))
+        xf (comp
+             (filter wall-clear)
+             (filter (entity-clear players))
+             (filter (entity-clear bombs))
+             (filter swap-clear)
+             (map :id))]
+    (into #{} xf players)))
+
+(defn perform-movement [initial-state]
+  (loop [state initial-state]
+    (let [{players :players} state
+          wants-to-move (fn [p] (= "move" (get-in p [:action :type])))
+          to-move (vec (map (fn [p]
+                              (let [p2 (assoc p :prev-pos (get p :pos))]
+                                (if (wants-to-move p2)
+                                  (dissoc (move-player p2 (get-in p2 [:action :dir])) :action)
+                                  p)))
+                            players))
+          proposed-state (assoc state :players to-move)
+          valid-moves (check-positions proposed-state)
+          valid-players (map (fn [p]
+                               (if (and
+                                     (not (valid-moves (:id p)))
+                                     (wants-to-move p))
+                                 (dissoc p :action)
+                                 p)) players)]
+      (if (= players valid-players)
+        proposed-state
+        (recur (assoc state :players valid-players))))))

test/bombnet/game_test.clj

@@ -0,0 +1,98 @@
+(ns bombnet.game-test
+  (:require [clojure.test :refer :all]
+            [bombnet.game :refer :all]))
+
+(deftest board-test
+  (testing "Board size is correct"
+    (let [board (new-board 5 7)]
+      (is (= (count board) 7) "Check height")
+      (is (= (count (get board 0)) 5) "Check width")))
+  (testing "Can get cells"
+    (let [board [["0" "1" "2"] ["3" "4" "5"]]]
+      (is (= (get-cell board [0 0]) "0"))
+      (is (= (get-cell board [1 0]) "1"))
+      (is (= (get-cell board [1 1]) "4"))
+      (is (= (get-cell board [2 1]) "5")))))
+
+(deftest player-test
+  (testing "Player can move"
+    (let [p (new-player "p1")
+          check (fn [p pos]
+                  (is (= (:pos p) pos)))]
+      (check (move-player p 3 3) [3 3])
+      (check (move-player p 2 4) [2 4])
+      (check (move-player p "up") [1 0])
+      (check (move-player p "down") [1 2])
+      (check (move-player p "left") [0 1])
+      (check (move-player p "right") [2 1]))))
+
+(deftest check-test
+  (testing "Check valid positions"
+    (let [state {:board (new-board 5 5)
+                 :players [{:id 1 :pos [1 1]}
+                           {:id 2 :pos [2 2]}
+                           {:id 3 :pos [1 2]}
+                           {:id 4 :pos [1 2]}
+                           {:id 5 :pos [1 3]}]
+                 :bombs [{:pos [1 3]}]}]
+      (is (= #{1} (check-positions state))))))
+
+(deftest move-test
+  (testing "Can walk normally #>  #"
+    (let [state {:board (new-board 5 5)
+                 :players [{:id 1 :pos [1 1] :action {:type "move" :dir "right"}}]
+                 :bombs []}
+          new-state (perform-movement state)]
+      (is (= [2 1] (get-in new-state [:players 0 :pos])))))
+  (testing "Cannot walk through walls #<  #"
+    (let [state {:board (new-board 5 5)
+                 :players [{:id 1 :pos [1 1] :action {:type "move" :dir "left"}}]
+                 :bombs []}
+          new-state (perform-movement state)]
+      (is (= [1 1] (get-in new-state [:players 0 :pos])))))
+  (testing "Cannot walk through bombs #>Q #"
+    (let [state {:board (new-board 5 5)
+                 :players [{:id 1 :pos [1 1] :action {:type "move" :dir "right"}}]
+                 :bombs [{:pos [2 1]}]}
+          new-state (perform-movement state)]
+      (is (= [1 1] (get-in new-state [:players 0 :pos])))))
+  (testing "Cannot walk through people #>@ "
+    (let [state {:board (new-board 5 5)
+                 :players [{:id 1 :pos [1 1] :action {:type "move" :dir "right"}}
+                           {:id 2 :pos [2 1]}]
+                 :bombs []}
+          new-state (perform-movement state)]
+      (is (= [1 1] (get-in new-state [:players 0 :pos])))))
+  (testing "Allow simultaneous movement #>> #"
+    (let [state {:board (new-board 5 5)
+                 :players [{:id 1 :pos [1 1] :action {:type "move" :dir "right"}}
+                           {:id 2 :pos [2 1] :action {:type "move" :dir "right"}}]
+                 :bombs []}
+          new-state (perform-movement state)]
+      (is (= [2 1] (get-in new-state [:players 0 :pos])))
+      (is (= [3 1] (get-in new-state [:players 1 :pos])))))
+  (testing "Cannot swap people #>< #"
+    (let [state {:board (new-board 5 5)
+                 :players [{:id 1 :pos [1 1] :action {:type "move" :dir "right"}}
+                           {:id 2 :pos [2 1] :action {:type "move" :dir "left"}}]
+                 :bombs []}
+          new-state (perform-movement state)]
+      (is (= [1 1] (get-in new-state [:players 0 :pos])))
+      (is (= [2 1] (get-in new-state [:players 1 :pos])))))
+  (testing "Cannot contest the same square #> <#"
+    (let [state {:board (new-board 5 5)
+                 :players [{:id 1 :pos [1 1] :action {:type "move" :dir "right"}}
+                           {:id 2 :pos [3 1] :action {:type "move" :dir "left"}}]
+                 :bombs []}
+          new-state (perform-movement state)]
+      (is (= [1 1] (get-in new-state [:players 0 :pos])))
+      (is (= [3 1] (get-in new-state [:players 1 :pos])))))
+  (testing "Resolves recursively #>>@#"
+    (let [state {:board (new-board 5 5)
+                 :players [{:id 1 :pos [1 1] :action {:type "move" :dir "right"}}
+                           {:id 2 :pos [2 1] :action {:type "move" :dir "right"}}
+                           {:id 3 :pos [3 1]}]
+                 :bombs []}
+          new-state (perform-movement state)]
+      (is (= [1 1] (get-in new-state [:players 0 :pos])))
+      (is (= [2 1] (get-in new-state [:players 1 :pos]))))))