--- a/src/caves/core.clj Sat Sep 01 22:19:29 2012 -0400
+++ b/src/caves/core.clj Sat Sep 01 23:18:31 2012 -0400
@@ -7,7 +7,7 @@
; Data Structures -------------------------------------------------------------
-(defrecord Game [world uis input])
+(defrecord Game [world uis input debug-flags])
; Main ------------------------------------------------------------------------
(defn tick-entity [world entity]
@@ -31,7 +31,7 @@
(recur (process-input (dissoc game :input) input))))))
(defn new-game []
- (->Game nil [(->UI :start)] nil))
+ (->Game nil [(->UI :start)] nil {:show-regions false}))
(defn main
([] (main :swing false))
--- a/src/caves/ui/drawing.clj Sat Sep 01 22:19:29 2012 -0400
+++ b/src/caves/ui/drawing.clj Sat Sep 01 23:18:31 2012 -0400
@@ -85,7 +85,8 @@
{:keys [location hp max-hp]} player
[x y] location
info (str "hp [" hp "/" max-hp "]")
- info (str info " loc: [" x "-" y "]")]
+ info (str info " loc: [" x "-" y "]")
+ info (str info " region: [" (get-in game [:world :regions location]) "]")]
(s/put-string screen 0 hud-row info)))
@@ -105,6 +106,19 @@
sheet (map2d render-tile tiles)]
(s/put-sheet screen 0 0 sheet))))
+(defn draw-regions [screen region-map vrows vcols [ox oy]]
+ (letfn [(get-region-glyph [region-number]
+ (str
+ (nth
+ "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ region-number)))]
+ (doseq [x (range ox (+ ox vcols))
+ y (range oy (+ oy vrows))]
+ (let [region-number (region-map [x y])]
+ (when region-number
+ (s/put-string screen (- x ox) (- y oy)
+ (get-region-glyph region-number)
+ {:fg :blue}))))))
(defn highlight-player [screen origin player]
(let [[x y] (get-viewport-coords-of origin (:location player))]
@@ -118,13 +132,15 @@
(defmethod draw-ui :play [ui game screen]
(let [world (:world game)
- {:keys [tiles entities]} world
+ {:keys [tiles entities regions]} world
player (:player entities)
[cols rows] (s/get-size screen)
vcols cols
vrows (dec rows)
origin (get-viewport-coords game (:location player) vcols vrows)]
(draw-world screen vrows vcols origin tiles)
+ (when (get-in game [:debug-flags :show-regions])
+ (draw-regions screen regions vrows vcols origin))
(doseq [entity (vals entities)]
(draw-entity screen origin vrows vcols entity))
(draw-hud screen game)
--- a/src/caves/ui/input.clj Sat Sep 01 22:19:29 2012 -0400
+++ b/src/caves/ui/input.clj Sat Sep 01 23:18:31 2012 -0400
@@ -57,6 +57,8 @@
\b (update-in game [:world] move-player :sw)
\n (update-in game [:world] move-player :se)
+ \R (update-in game [:debug-flags :show-regions] not)
+
game))
(defmethod process-input :win [game input]
--- a/src/caves/world/core.clj Sat Sep 01 22:19:29 2012 -0400
+++ b/src/caves/world/core.clj Sat Sep 01 23:18:31 2012 -0400
@@ -3,7 +3,7 @@
; Constants -------------------------------------------------------------------
-(def world-size [160 50])
+(def world-size [120 50])
; Data structures -------------------------------------------------------------
(defrecord World [tiles entities])
@@ -25,6 +25,11 @@
(let [[cols rows] world-size]
[(rand-int cols) (rand-int rows)]))
+(defn tile-walkable?
+ "Return whether a (normal) entity can walk over this type of tile."
+ [tile]
+ (#{:floor :up :down} (:kind tile)))
+
; Querying a world ------------------------------------------------------------
(defn get-tile [world coord]
@@ -55,7 +60,7 @@
(vals (:entities world)))))
(defn is-empty? [world coord]
- (and (#{:floor} (get-tile-kind world coord))
+ (and (tile-walkable? (get-tile world coord))
(not (get-entity-at world coord))))
(defn find-empty-tile [world]
--- a/src/caves/world/generation.clj Sat Sep 01 22:19:29 2012 -0400
+++ b/src/caves/world/generation.clj Sat Sep 01 23:18:31 2012 -0400
@@ -1,9 +1,82 @@
(ns caves.world.generation
- (:use [caves.world.core :only [tiles get-tile-from-tiles random-coordinate
- world-size ->World]]))
+ (:use [clojure.set :only (union difference)]
+ [caves.world.core :only [tiles get-tile-from-tiles random-coordinate
+ world-size ->World tile-walkable?]]
+ [caves.coords :only [neighbors]]))
+
+
+; Convenience -----------------------------------------------------------------
+(def all-coords
+ (let [[cols rows] world-size]
+ (for [x (range cols)
+ y (range rows)]
+ [x y])))
+
+(defn get-tile-from-level [level [x y]]
+ (get-in level [y x] (:bound tiles)))
+
+
+; Region Mapping --------------------------------------------------------------
+(defn filter-walkable
+ "Filter the given coordinates to include only walkable ones."
+ [level coords]
+ (set (filter #(tile-walkable? (get-tile-from-level level %))
+ coords)))
+(defn walkable-neighbors
+ "Return the neighboring coordinates walkable from the given coord."
+ [level coord]
+ (filter-walkable level (neighbors coord)))
+(defn walkable-from
+ "Return all coordinates walkable from the given coord (including itself)."
+ [level coord]
+ (loop [walked #{}
+ to-walk #{coord}]
+ (if (empty? to-walk)
+ walked
+ (let [current (first to-walk)
+ walked (conj walked current)
+ to-walk (disj to-walk current)
+ candidates (walkable-neighbors level current)
+ to-walk (union to-walk (difference candidates walked))]
+ (recur walked to-walk)))))
+
+
+(defn get-region-map
+ "Get a region map for the given level.
+
+ A region map is a map of coordinates to region numbers. Unwalkable
+ coordinates will not be included in the map. For example, the map:
+
+ .#.
+ ##.
+
+ Would have a region map of:
+
+ x y region
+ {[0 0] 0
+ [2 0] 1
+ [2 1] 1}
+
+ "
+ [level]
+ (loop [remaining (filter-walkable level all-coords)
+ region-map {}
+ n 0]
+ (if (empty? remaining)
+ region-map
+ (let [next-coord (first remaining)
+ next-region-coords (walkable-from level next-coord)]
+ (recur (difference remaining next-region-coords)
+ (into region-map (map vector
+ next-region-coords
+ (repeat n)))
+ (inc n))))))
+
+
+; Random World Generation -----------------------------------------------------
(defn random-tiles []
(let [[cols rows] world-size]
(letfn [(random-tile []
@@ -48,4 +121,4 @@
(defn random-world []
(let [world (->World (random-tiles) {})
world (nth (iterate smooth-world world) 3)]
- world))
+ (assoc world :regions (get-region-map (:tiles world)))))