Skip to content

Instantly share code, notes, and snippets.

@bbqbaron
Created March 5, 2019 23:40
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save bbqbaron/f04a7c4034a76222bcd76238fb3114d3 to your computer and use it in GitHub Desktop.
Save bbqbaron/f04a7c4034a76222bcd76238fb3114d3 to your computer and use it in GitHub Desktop.
; 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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment