Skip to content

Instantly share code, notes, and snippets.

@odyssomay
Created October 15, 2012 15:30
Show Gist options
  • Save odyssomay/3893111 to your computer and use it in GitHub Desktop.
Save odyssomay/3893111 to your computer and use it in GitHub Desktop.
"Failed" dungeon generation
(defn rooms-intersect?
[{[x1 y1] :offset [sx1 sy1] :size} {[x2 y2] :offset [sx2 sy2] :size}]
(not (or (>= x1 (+ x2 sx2))
(>= y1 (+ y2 sy2))
(>= x2 (+ x1 sx1))
(>= y2 (+ y1 sy1)))))
(defn is-inside-room? [[x y] {[xr yr] :offset [sx sy] :size}]
(and (> x xr)
(< x (dec (+ xr sx)))
(> y yr)
(< y (dec (+ yr sy)))))
(defn is-inside-area? [[x y] {[dsx dsy] :dungeon-size}]
(and (>= x 0)
(>= y 0)
(< x dsx)
(< y dsy)))
(defn get-rand-edge-val [v s]
(+ v (rand-nth (range 1 (dec s)))))
(defn get-rand-edge [{[x y] :offset [sx sy] :size} direction]
(case direction
:up [(get-rand-edge-val x sx) y]
:down [(get-rand-edge-val x sx) (+ y (dec sy))]
:left [x (get-rand-edge-val y sy)]
:right [(+ x (dec sx)) (get-rand-edge-val y sy)]))
(defn get-openings [room opts room-openings]
(->>
(map #(vec [% (get-rand-edge room %)])
[:up :down :left :right])
(filter (fn [[direction position]]
(is-inside-area? (util/move-in-direction position direction)
opts)))
shuffle
(take (util/rand-val room-openings))))
(defn generate-room [{[x-range y-range] :room-size [dsx dsy] :dungeon-size
:keys [room-openings] :as opts}]
(let [[sx sy :as size] [(util/rand-val x-range odd?)
(util/rand-val y-range odd?)]
offset [(util/rand-val [0 (- dsx sx)] even?)
(util/rand-val [0 (- dsy sy)] even?)]
room {:size size :offset offset}
openings (get-openings room opts room-openings)
]
(assoc room :openings openings)))
(defn generate-rooms [{[x-range y-range] :room-size :keys [maximum-rooms] :as opts}]
(let [possible-rooms (repeatedly maximum-rooms #(generate-room opts))
rooms (reduce (fn [rooms test-room]
(if (not (some #(rooms-intersect? % test-room) rooms))
(conj rooms test-room)
rooms))
[]
possible-rooms)]
rooms))
(let [directions #{:up :down :left :right}]
(defn random-direction [direction]
(let [r (rand)]
(if (< r 0.4)
direction
(let [possible (disj directions direction (util/opposite-direction direction))]
(rand-nth possible)))))
(defn verified-direction [get-new-direction direction [x y :as position]]
(let [new-direction? (case direction
:up (odd? y)
:down (odd? y)
:left (odd? x)
:right (odd? x))]
(if new-direction?
(get-new-direction direction position)
direction)))
(defn generate-corridor [position direction
{:keys [floor walls rooms corridors] :as dungeon}
{[dsx dsy] :dungeon-size} get-new-direction]
(loop [direction direction
position position
corridor [position]
iteration 0
]
(let [direction (verified-direction get-new-direction direction position)
[nx ny :as next-position] (util/move-in-direction position direction)]
(if (or (contains? walls next-position)
(contains? corridors next-position)
(< nx 0)
(< ny 0)
(>= nx dsx)
(>= ny dsy))
corridor
(recur direction next-position (conj corridor next-position) (inc iteration))))))
(defn random-corridor [position direction dungeon opts]
(generate-corridor position direction dungeon
opts (fn [direction position] (random-direction direction))))
;(defn connect-rooms [dungeon room1 {[rx ry] :offset [rsx rsy] :size :as room2} opts]
; (generate-corridor dungeon room1 opts
; (fn [direction [x y]]
; (let [d (cond
; (< x (+ rx 1)) :right
; (> x (- (+ rx rsx) 1)) :left
; (< y (+ ry 1)) :down
; (> y (- (+ ry rsy) 1)) :up
; :else direction ;(do (log/info "rand") (random-direction direction))
; )]
; ;(log/info d)
; (if (= d (util/opposite-direction direction))
; (do ;(log/info "rand2")
; (random-direction direction))
; d)))))
)
(defn get-connected?-rooms [rooms corridors]
(for [room rooms]
(let [test-positions (for [[direction position] (:openings room)]
(util/move-in-direction position direction))
connected? (some #(contains? corridors %) test-positions)]
(assoc room :connected? connected?))))
(defn generate-corridors [{:keys [rooms corridors] :as dungeon} opts]
(loop [corridors corridors]
(let [connected?-rooms (get-connected?-rooms rooms corridors)
connected-rooms (filter :connected? connected?-rooms)
non-connected-rooms (remove :connected? connected?-rooms)
dungeon (assoc dungeon :corridors corridors)
]
;(log/info corridors)
(if (zero? (count non-connected-rooms))
(assoc dungeon :corridors corridors)
(recur (reduce #(conj %1 %2)
corridors
(let [[direction position] (rand-nth (:openings
(rand-nth non-connected-rooms)))]
(random-corridor position direction dungeon opts))))))))
(defn place-floor [{:keys [rooms] :as dungeon}]
(let [floor
(into #{}
(reduce concat
(for [{[x y] :offset [sx sy] :size} rooms]
(for [x-step (range 1 (dec sx))
y-step (range 1 (dec sy))]
[(+ x x-step) (+ y y-step)]))))]
(assoc dungeon :floor floor)))
(defn place-walls [{:keys [rooms] :as dungeon}]
(let [walls
(into #{}
(reduce concat (for [{[x y] :offset [sx sy] :size} rooms]
(concat (for [x-step (range 1 (dec sx))]
[(+ x x-step) y])
(for [x-step (range 1 (dec sx))]
[(+ x x-step) (+ y (dec sy))])
(for [y-step (range sy)]
[x (+ y y-step)])
(for [y-step (range sy)]
[(+ x (dec sx)) (+ y y-step)])
))))]
(assoc dungeon :walls walls)))
(defn place-openings [{:keys [rooms walls floor] :as dungeon}]
(let [openings (reduce concat (map (comp vals :openings) rooms))
walls (reduce #(disj %1 %2) walls openings)
;floor (reduce #(conj %1 %2) floor openings)
corridors (reduce #(conj %1 %2) #{} openings)
]
(assoc dungeon :walls walls ;:floor floor
:corridors corridors
)
))
(defn correct-walls [{:keys [walls corridors] :as dungeon}]
(assoc dungeon :walls (remove (fn [wall] (contains? corridors wall)) walls)))
(defn get-middle-pos [{[x y] :offset [sx sy] :size} modifier]
[(+ x (modifier (int (/ sx 2))))
(+ y (int (/ sy 2)))])
(defn place-stairs [{:keys [rooms] :as dungeon}]
(assoc dungeon
:start (get-middle-pos (rand-nth rooms) dec)
:end (get-middle-pos (rand-nth rooms) inc)))
(defn generate-dungeon [opts]
(let [rooms (generate-rooms opts)]
(->
{:rooms rooms
}
place-floor
place-walls
place-openings
place-stairs
(generate-corridors opts)
;correct-walls
)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment