Commits

Steve Losh committed b08b5fd

moar

Comments (0)

Files changed (2)

src/caves/core.clj

 (ns caves.core
-  (:use [caves.world :only [random-world]])
+  (:use [caves.world :only [random-world smooth-world]])
   (:require [lanterna.screen :as s]))
 
 
   (case input
     :enter     (assoc game :uis [(new UI :win)])
     :backspace (assoc game :uis [(new UI :lose)])
+    \s         (assoc game :world (smooth-world (:world game)))
     game))
 
 (defmethod process-input :win [game input]

src/caves/world.clj

 (ns caves.world)
 
 
+; Constants -------------------------------------------------------------------
 (def world-size [160 50])
 
+; Data structures -------------------------------------------------------------
 (defrecord World [tiles])
 (defrecord Tile [kind glyph color])
 
 (defn get-tile [tiles x y]
   (get-in tiles [y x] (:bound tiles)))
 
+
+; Debugging -------------------------------------------------------------------
+(defn print-row [row]
+  (println (apply str (map :glyph row))))
+
+(defn print-world [world]
+  (dorun (map print-row (:tiles world))))
+
+
+; World generation ------------------------------------------------------------
 (defn random-tiles []
   (let [[cols rows] world-size]
     (letfn [(random-tile []
               (vec (repeatedly cols random-tile)))]
       (vec (repeatedly rows random-row)))))
 
+
+(defn get-smoothed-tile [block]
+  (let [tile-counts (frequencies (map :kind block))
+        floor-threshold 5
+        floor-count (get tile-counts :floor 0)
+        result (if (>= floor-count floor-threshold)
+                 :floor
+                 :wall)]
+    (tiles result)))
+
+(defn block-coords [x y]
+  (for [dx [-1 0 1]
+        dy [-1 0 1]]
+    [(+ x dx) (+ y dy)]))
+
+(defn get-block [tiles x y]
+  (map (fn [[x y]]
+         (get-tile tiles x y))
+       (block-coords x y)))
+
+(defn get-smoothed-row [tiles y]
+  (mapv (fn [x]
+          (get-smoothed-tile (get-block tiles x y)))
+        (range (count (first tiles)))))
+
+(defn get-smoothed-tiles [tiles]
+  (mapv (fn [y]
+          (get-smoothed-row tiles y))
+        (range (count tiles))))
+
+(defn smooth-world [{:keys [tiles] :as world}]
+  (assoc world :tiles (get-smoothed-tiles tiles)))
+
+
 (defn random-world []
-  (new World (random-tiles)))
+  (let [world (new World (random-tiles))
+        world (nth (iterate smooth-world world) 0)]
+    world))
+