brisfunctional-sokoban.clj

(ns sokoban.core)

(def moves {:n [0 1] :s [0 -1] :e [1 0] :w [-1 0]})

(def start-world
  {:person [3 1]
   :targets #{[1 3]}
   :crates #{[1 2]}
   :blanks #{[1 3] [2 3] [3 3]
             [1 2] [2 2] [3 2]
             [1 1] [2 1] [3 1]}})

(defn printable-char [world pos]
  (cond
   (= pos (world :person)) "&"
   (and ((world :crates) pos)
        ((world :targets) pos)) "0"
        ((world :crates) pos) "O"
        ((world :targets) pos) "."
        ((world :blanks) pos) " "
        :else "#"))

(defn read-user-input []
  (let [c (read-line)]
    (condp = c
      "w" :n
      "a" :w
      "s" :s
      "d" :e
      (recur))))

(defn print-the-world [world]
  (let [extents (apply (partial map max) (world :blanks))]
    (doseq [x (range 0 (+ 2 (first extents)))]
      (do (doseq [y (range 0 (+ 2 (second extents)))]
            (print (printable-char world [x y])))
          (println)))))

(defn whats-there? [world position]
  (cond (contains? (:crates world) position) :crate
        (contains? (:blanks world) position) :blank
        :else :wall))

(defn is-crate? [world position]
  (= :crate (whats-there? world position)))

(defn is-blank? [world position]
  (= :blank (whats-there? world position)))

(defn move-crate [world old-pos new-pos]
  (conj (disj (:crates world) old-pos) new-pos))

(defn move [position bearing]
  (map + position (moves bearing)))

(defn move-person [world bearing]
  (assoc world :person (move (:person world) bearing)))

(defn move-person-and-crate [world bearing]
  (let [next-pos (move (:person world) bearing)
        next-crate-pos (move next-pos bearing)]
    (-> world
        (assoc :person next-pos)
        (assoc :crates (move-crate world next-pos next-crate-pos)))))

(defn generate-next-world [world bearing]
  (let [next-pos (move (:person world) bearing)]
    (cond (is-blank? world next-pos)
          (move-person world bearing)
          (and (is-crate? world next-pos)
               (is-blank? world (move next-pos bearing)))
          (move-person-and-crate world bearing)
          :else
          world)))

(defn print-win [world]
  (print-the-world world)
  (prn "Yey"))

(defn won? [world]
  (= (world :targets) (world :crates)))

(defn do-turn [world]
  (print-the-world world)
  (let [input (read-user-input)]
    (generate-next-world world input)))

(defn game-loop [world]
  (if (won? world)
    (print-win world)
    (recur (do-turn world))))