game2.clj

(ns clojure-2408.game2
  (:require [clojure.pprint :as ppr]))

;;;; Board ops
(defn initialise-board [width winning-num]
  {:rows       (vec (repeat width (vec (repeat width nil))))
   :winning-num winning-num
   :width       width
   :state       :playing})

(defn flip-board-x-y [board]
  (update board :rows (partial apply mapv vector)))

(defn flip-board-x [board]
  (update board :rows (partial mapv (comp vec reverse))))

(defn flip-board-y [board]
  (-> board
      (update :rows reverse)
      (update :rows vec)))

(defn rotate-board-anti-clockwise [board]
  (-> board
      flip-board-x
      flip-board-x-y))

(defn rotate-board-clockwise [board]
  (->> board
       flip-board-x-y
       flip-board-x))

;;;; Game ops
(defn- find-random-cell-containing-zero [{:keys [rows]}]
  (->> rows
       (map-indexed (fn [y r] (keep-indexed (fn [x v] (when (nil? v) [y x])) r)))
       (mapcat identity)
       rand-nth))

(defn add-cell [board]
  (let [num   (rand-nth [2 2 2 4])
        [y x] (find-random-cell-containing-zero board)]
    (if (and x y)
      (assoc-in board [:rows y x] num)
      board)))

(defn- collapse-row [row]
  (loop [[cur nxt :as r] row
         output          []]
    (if (seq r)
      (if (= cur nxt)
        (recur (next (next r)) (conj output (* 2 cur)))
        (recur (next r) (conj output cur)))
      output)))

(defn- move-cells [row]
  (-> row
      (->> (remove nil?))
      collapse-row
      (concat (repeat nil))
      (->> (mapv (fn [_ x] x) row))))

(defn move-left [board]
  (update board :rows (partial mapv move-cells)))

(defn move-up [board]
  (-> board
      rotate-board-anti-clockwise
      (update :rows (partial mapv move-cells))
      rotate-board-clockwise))

(defn move-down [board]
  (-> board
      rotate-board-clockwise
      (update :rows (partial mapv move-cells))
      rotate-board-anti-clockwise))

(defn move-right [board]
  (-> board
      flip-board-x
      (update :rows (partial mapv move-cells))
      flip-board-x))

(defn quit [board]
  (assoc board :state :quit))

(defn- no-duplicates-in-row? [row]
  (= row (dedupe row)))

(defn can-move? [{:keys [rows] :as board}]
  (and (every? no-duplicates-in-row? rows)
       (every? no-duplicates-in-row? (:rows (flip-board-x-y board)))
       (every? (complement nil?) (mapcat identity rows))))

(defn game-won? [{:keys [rows winning-num]}]
  (->> rows
       (mapcat identity)
       (some #(= winning-num %))))

(defn game-lost? [{:keys [rows] :as board}]
  (not
   (or (->> rows
            (mapcat identity)
            (some nil?))
       (can-move? board))))

(defn game-step [{old-state :state :as old-board} move]
  (if (= old-state :playing)
    (let [{new-state :state :as new-board} (move old-board)]
      (if (= new-state :playing)
        (cond-> new-board
          (not= (:rows old-board) (:rows new-board)) add-cell
          (game-won? new-board)                      (assoc :state :won)
          (game-lost? new-board)                     (assoc :state :lost))
        new-board))
    old-board))

;;;; players
(def game-keys {"c" #'move-up
                "h" #'move-left
                "t" #'move-down
                "n" #'move-right
                "q" #'quit})

(defn collect-user-input [_board]
  (println "Press \n " (mapcat (juxt key (comp #(.sym %) val)) game-keys))
  (or (game-keys (read-line))
      (println "Invalid choice")
      (recur _board)))

(defn generate-move [{:keys [rows] :as board}]
  (or (->> [move-down move-right move-left move-up]
           (filter #(not= rows (:rows (% board))))
           first)
      quit))

;;;; game mechanics
(defn print-board [{:keys [rows state width winning-num] :as board}]
  (ppr/print-table (map (partial zipmap (range)) rows))
  (println " Width" width "   Winning Number" winning-num "    State" (name state)))

(defn play-game [width winning-num player & {:keys [print-board-in-loop] :or {print-board-in-loop true}}]
  (loop [board (add-cell (initialise-board width winning-num))]
    (when print-board-in-loop
      (print-board board))
    (if (-> board :state (= :playing))
      (let [move (player board)]
        (-> board
            (game-step move)
            recur))
      (print-board board))))