caves.clj

; https://gist.github.com/munificent/b1bcd969063da3e6c298be070a22b604
(ns dgn)

(def H 40)
(def W 80)
(def TV " ")
(def TF ".")
(def TW "#")
(def TC "!")
(def TOD "\\")
(def TCD "+")
(def TP "@")

(defn box [w h l t]
  (for [y (range (dec t) (+ t h 2))
        x (range (dec l) (+ l w 2))]
    [y x]))

(def empty-row
  (into {}
        (vec (map #(vector % TV) (range (inc W))))))

(def empty-dungeon
  (into {}
        (vec (map #(vector % empty-row)
                  (range (inc H))))))

(defonce dungeon
         (atom empty-dungeon))

(defn new-dungeon! []
  (reset! dungeon empty-dungeon))

(defn on-vwall? [x w l]
  (not (<= l x (+ l w))))

(defn on-hwall? [y h t]
  (not (<= t y (+ t h))))

(defn corner? [[y x] w h l t]
  (and (on-hwall? y h t) (on-vwall? x w l)))

(defn sans-corners [w h l t]
  (filter
    #(not (corner? % w h l t))
    (box w h l t)))

(defn taken? [w h l t]
  (some
    #(not= % TV)
    (map #(get-in @dungeon %)
         (box (dec w) (dec h) (inc l) (inc t)))))

(defn non-empty? [coords]
  (-> dungeon (get-in coords) (= TV)))

(defn door [w h l t]
  (let [candidates
        (filter
          non-empty?
          (sans-corners w h l t))]
    (when (seq candidates)
      (rand-nth candidates))))

(defn draw-cave [w h l t]
  (swap!
    dungeon
    #(reduce
       (fn [acc coords]
         (let [[y x] coords]
           (assoc-in acc coords
                     (cond
                       (corner? coords w h l t)
                       TC
                       (or
                         (on-vwall? x w l)
                         (on-hwall? y h t))
                       TW
                       true TF))))
       %
       (box w h l t))))

(defn cave [with-player]
  (let [[w h] [(+ 5 (rand-int 10))
               (+ 3 (rand-int 6))]
        [l t]
        [(inc (rand-int
                (- W w 2)))
         (inc (rand-int
                (- H h 2)))]
        door-coords
        (door w h l t)]
    (when (not (taken? w h l t))
      (do
        (draw-cave w h l t)
        (when door-coords
          (swap! dungeon assoc-in door-coords (rand-nth [TCD TOD])))
        (if with-player
          (swap! dungeon assoc-in [(+ t (rand-int h))
                                   (+ l (rand-int w))]
                 TP)
          (dotimes [_ (rand-int 6)]
            (swap! dungeon assoc-in [(+ t (rand-int h)) (+ l (rand-int w))]
                   (rand-nth (rand-nth
                               (cons ["$"]
                                     (repeat 3 (map char (range 65 91)))))))))))))

(defn print-dgn []
  (clojure.string/join
    "\n"
    (map
      #(apply str (map second (sort-by first %)))
      (map second (sort-by first @dungeon)))))

(defn run []
  (new-dungeon!)
  (doseq [x (range 1000)]
    (cave (= x 0)))
  (println (print-dgn)))

(run)