# HG changeset patch # User Steve Losh # Date 1346555911 14400 # Node ID f15b8173a1248b9e3bc2c8b3ab6f26982356ec73 # Parent a5c19c0eb8f140e927a7e3dc5df4df9dae635e89 Add region mapping. diff -r a5c19c0eb8f1 -r f15b8173a124 src/caves/core.clj --- 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)) diff -r a5c19c0eb8f1 -r f15b8173a124 src/caves/ui/drawing.clj --- 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) diff -r a5c19c0eb8f1 -r f15b8173a124 src/caves/ui/input.clj --- 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] diff -r a5c19c0eb8f1 -r f15b8173a124 src/caves/world/core.clj --- 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] diff -r a5c19c0eb8f1 -r f15b8173a124 src/caves/world/generation.clj --- 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)))))