Steve Losh avatar Steve Losh committed f15b817

Add region mapping.

Comments (0)

Files changed (5)

src/caves/core.clj

 
 
 ; Data Structures -------------------------------------------------------------
-(defrecord Game [world uis input])
+(defrecord Game [world uis input debug-flags])
 
 ; Main ------------------------------------------------------------------------
 (defn tick-entity [world entity]
         (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))

src/caves/ui/drawing.clj

         {: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)))
 
 
           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))]
 
 (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)

src/caves/ui/input.clj

     \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]

src/caves/world/core.clj

 
 
 ; Constants -------------------------------------------------------------------
-(def world-size [160 50])
+(def world-size [120 50])
 
 ; Data structures -------------------------------------------------------------
 (defrecord World [tiles entities])
   (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]
              (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]

src/caves/world/generation.clj

 (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 []
 (defn random-world []
   (let [world (->World (random-tiles) {})
         world (nth (iterate smooth-world world) 3)]
-    world))
+    (assoc world :regions (get-region-map (:tiles world)))))
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.