2048.clj

(ns p2048.core)

(def size 4)

(defn empty-line []
  (vec (replicate size 0)))

(defn gen-stage []
  (vec (for [x (range size)]
         (empty-line))))

(def stage (atom (gen-stage)))

(defn at [stage x y]
  (-> stage
      (nth y)
      (nth x)))

(defn index->position [i]
  {:x (int (Math/floor (/ i size)))
   :y (mod i size)})

(def positions (for [x (range size)
                     y (range size)]
                 {:x x :y y}))

(defn empty-positions [stage]
  (into () 
        (filter (fn [{:keys [x y]}]
                  (= (at stage x y) 0)))
        positions))

(defn change [stage x y val]
  (assoc-in stage [y x] val))

(defn append [stage]
  (if-let [positions (empty-positions stage)]
    (let [{:keys [x y]} (rand-nth positions)]
      (change stage x y (inc (rand-int 2))))))

(defn growth [line]
  (let [line
        (->> line
             (remove #(= 0 %))
             (partition-by identity)
             (map #(partition-all 2 %))
             (apply concat)
             (map
              (fn [[v :as items]]
                (if (and (not= v 0)
                         (> (count items) 1))
                  (* v 2)
                  v))))]
    (vec (concat line (take (- size (count line)) (repeat 0))))))

(defn direction->positions [{:keys [direction-fn init-positions]}]
  (for [init-pos init-positions]
    (reduce (fn [positions i]
              (let [{:keys [x y]} (last positions)
                    [x y] (direction-fn x y)]
                (conj positions {:x x :y y})))
            [init-pos]
            (range (dec size)))))

(def actions #{:up :down :right :left})

(def directions
  {:up
   (direction->positions {:direction-fn (fn [x y] [x (inc y)])
                          :init-positions [{:x 0, :y 0}
                                           {:x 1, :y 0}
                                           {:x 2, :y 0}
                                           {:x 3, :y 0}]})
   :down
   (direction->positions {:direction-fn (fn [x y] [x (dec y)])
                          :init-positions [{:x 0, :y 3}
                                           {:x 1, :y 3}
                                           {:x 2, :y 3}
                                           {:x 3, :y 3}]})

   :right
   (direction->positions {:direction-fn (fn [x y] [(dec x) y])
                          :init-positions [{:x 3, :y 0}
                                           {:x 3, :y 1}
                                           {:x 3, :y 2}
                                           {:x 3, :y 3}]})

   :left
   (direction->positions {:direction-fn (fn [x y] [(inc x) y])
                          :init-positions [{:x 0, :y 0}
                                           {:x 0, :y 1}
                                           {:x 0, :y 2}
                                           {:x 0, :y 3}]})})

(defn show [stage]
  (doseq [line stage]
    (println line))
  (println))

(defn update-by-direction [stage direction]
  (reduce (fn [stage positions]
            (let [line (map (fn [{:keys [x y]}]
                              (at stage x y))
                            positions)
                  line-with-pos (map (fn [v pos] (assoc pos :v v))
                                     (growth line)
                                     positions)]
              (reduce (fn [stage {:keys [x y v]}]
                        (change stage x y v))
                      stage
                      line-with-pos)))
          stage
          (directions direction)))

(defn next! [stage action]
  (swap! stage
         #(-> %
              (update-by-direction action)
              append)))

(defn game-over? [stage]
  (and (= (count (empty-positions stage)) 0)
       (every? (fn [action] (= (update-by-direction stage action)
                               stage))
               actions)))

(defn -main []
  (do
    (reset! stage (gen-stage))
    (while (not (game-over? @stage))
      (next! stage (rand-nth (seq actions)))
      (show @stage))))