"Failed" dungeon generation

gistfile1.clj

(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
      )))