Created
March 5, 2019 23:40
-
-
Save bbqbaron/f04a7c4034a76222bcd76238fb3114d3 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
; 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