bombnet/src/bombnet/game.clj

(ns bombnet.game
  (:require [clojure.test :refer [is with-test]])
  (:require [clojure.set :refer :all]))

(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 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 [players]
  (let [w 21 h 17
        colors ["red" "blue" "green" "yellow"]
        positions [[1 1] [1 (- h 2)] [(- w 2) 1] [(- w 2) (- h 2)]]
        positioned-players (mapv #(assoc % :pos %2 :color %3) players positions colors)]
    {:board (new-board 21 17)
     :players positioned-players
     :bombs []
     :explosion #{}}))

(defn with-action [typ]
  (fn [p] (= typ (get-in p [:action :type]))))

(defn ^:private mapv-if [pred f coll]
  (mapv (fn [e] (if (pred e) (f e) e)) coll))

(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
          to-move (mapv-if
                    (with-action "move")
                    (fn [p] (-> p
                                (assoc :prev-pos (:pos p))
                                (move-player (get-in p [:action :dir]))
                                (dissoc :action)))
                    players)
          proposed-state (assoc state :players to-move)
          valid-moves (check-positions proposed-state)
          valid-players (mapv-if
                          #(and
                             (not (valid-moves (:id %)))
                             ((with-action "move") %))
                          #(dissoc % :action)
                          players)]
      (if (= players valid-players)
        proposed-state
        (recur (assoc state :players valid-players))))))

(def ^:const min-bomb-timer 1)
(def ^:const max-bomb-timer 5)
(def ^:const bomb-power 99)

(defn ^:private clamp [a lbound ubound]
  (max lbound (min ubound a)))

(defn ^:private merge-by-key [k coll1 coll2]
  (->> (merge
         (group-by k coll1)
         (group-by k coll2))
       vals
       (apply concat)))

(defn perform-bomb-placement [state]
  (let [{bombs :bombs players :players} state
        get-bomb (fn [p]
                   (let [pos (:pos p)
                         power bomb-power
                         params (:action p)
                         timer (clamp
                                 (:timer params)
                                 min-bomb-timer
                                 max-bomb-timer)
                         diagonal? (boolean (:diagonal? params))]
                     {:pos pos :power power :counter timer :diagonal? diagonal?}))
        bombs-to-place (->> players
                            (filter (with-action "bomb"))
                            (map get-bomb))
        new-bombs (merge-by-key :pos bombs-to-place bombs)
        new-players (mapv-if
                      (with-action "bomb")
                      #(dissoc % :action)
                      players)]
    (-> state
        (assoc :bombs new-bombs)
        (assoc :players new-players))))

(let [state {:board (new-board 5 5)
             :players [{:pos [1 1] :action {:type "bomb" :timer 5}}]
             :bombs []}]
  (perform-bomb-placement state))

(defn ^:private offset [pos dir] (mapv + pos dir))

(with-test
  (defn explode-bomb-helper [board start dir power acc]
    (let [pos (offset start dir)]
      (if (or (zero? power) (= (get-cell board pos) "#"))
        acc
        (recur board pos dir (- power 1) (conj acc pos)))))
  (let [board (new-board 7 7)]
    (is (= #{[1 2] [1 3]}
           (explode-bomb-helper board [1 1] [0 1] 2 #{})))
    (is (= #{[1 2] [1 3] [1 4] [1 5]}
           (explode-bomb-helper board [1 1] [0 1] 99 #{})))))

(defn explode-bomb [board bomb]
  (let [{:keys [power pos]} bomb
        dirs (if (:diagonal? bomb)
               [[1 1] [-1 -1] [1 -1] [-1 1]]
               [[1 0] [0 1] [-1 0] [0 -1]])]
    (reduce #(explode-bomb-helper board pos %2 power %) #{pos} dirs)))

(defn explode-bombs
  ([state] (explode-bombs state #{}))
  ([state prev-explosion]
   (if-let [exploding (seq (filter #(zero? (:counter %)) (:bombs state)))]
     (let [{:keys [board players bombs]} state
           bomb (first exploding)
           other-bombs (filter #(not= bomb %) bombs)
           explosion (explode-bomb board bomb)
           new-bombs (mapv-if
                       #(explosion (:pos %))
                       #(assoc % :counter 0)
                       other-bombs)
           new-players (mapv-if
                         #(explosion (:pos %))
                         #(assoc % :dead? true)
                         players)]
       (recur
         (-> state
             (assoc :players new-players)
             (assoc :bombs new-bombs))
         (union prev-explosion explosion)))
     (assoc state :explosion prev-explosion))))

(defn perform-bomb-tick [state]
  (let [{bombs :bombs} state
        new-bombs (mapv #(update-in % [:counter] dec) bombs)]
    (assoc state :bombs new-bombs)))

(defn queue-action [state id action]
  (update-in state [:players]
             (partial
               mapv-if
               #(= id (:id %))
               #(assoc % :action action))))

(defn update-state [state]
  (-> state
      perform-bomb-tick
      perform-bomb-placement
      perform-movement
      explode-bombs))

(defn finished? [state]
  (let [alive (remove :dead? (:players state))]
    (<= (count alive) 1)))