--- a/src/caves/core.clj Tue Jul 31 10:05:58 2012 -0400
+++ b/src/caves/core.clj Wed Aug 01 21:13:37 2012 -0400
@@ -59,3 +59,5 @@
(main :swing false)
(main :swing true)
)
+
+
--- a/src/caves/entities/aspects/attacker.clj Tue Jul 31 10:05:58 2012 -0400
+++ b/src/caves/entities/aspects/attacker.clj Wed Aug 01 21:13:37 2012 -0400
@@ -16,7 +16,7 @@
(send-message this "You strike the %s for %d damage!"
[(:name target) damage])
(send-message target "The %s strikes you for %d damage!"
- [(:name target) damage]))))
+ [(:name this) damage]))))
(attack-value [this world]
(get this :attack 1)))
--- a/src/caves/entities/aspects/digger.clj Tue Jul 31 10:05:58 2012 -0400
+++ b/src/caves/entities/aspects/digger.clj Wed Aug 01 21:13:37 2012 -0400
@@ -1,6 +1,6 @@
(ns caves.entities.aspects.digger
(:use [caves.entities.core :only [defaspect]]
- [caves.world :only [check-tile set-tile-floor]]))
+ [caves.world.core :only [check-tile set-tile-floor]]))
(defaspect Digger
--- a/src/caves/entities/aspects/mobile.clj Tue Jul 31 10:05:58 2012 -0400
+++ b/src/caves/entities/aspects/mobile.clj Wed Aug 01 21:13:37 2012 -0400
@@ -1,6 +1,6 @@
(ns caves.entities.aspects.mobile
(:use [caves.entities.core :only [defaspect]]
- [caves.world :only [is-empty?]]))
+ [caves.world.core :only [is-empty?]]))
(defaspect Mobile
--- a/src/caves/entities/aspects/receiver.clj Tue Jul 31 10:05:58 2012 -0400
+++ b/src/caves/entities/aspects/receiver.clj Wed Aug 01 21:13:37 2012 -0400
@@ -1,6 +1,6 @@
(ns caves.entities.aspects.receiver
(:use [caves.entities.core :only [defaspect]]
- [caves.world :only [get-entities-around]]))
+ [caves.world.core :only [get-entities-around]]))
(defaspect Receiver
@@ -15,7 +15,8 @@
(defn send-message-nearby [coord message world]
(let [entities (get-entities-around world coord 7)
- sm #(send-message %2 message [] %1)]
+ sm (fn [world entity]
+ (send-message entity message [] world))]
(reduce sm world entities)))
--- a/src/caves/entities/bunny.clj Tue Jul 31 10:05:58 2012 -0400
+++ b/src/caves/entities/bunny.clj Wed Aug 01 21:13:37 2012 -0400
@@ -2,7 +2,7 @@
(:use [caves.entities.core :only [Entity get-id add-aspect]]
[caves.entities.aspects.destructible :only [Destructible]]
[caves.entities.aspects.mobile :only [Mobile move]]
- [caves.world :only [find-empty-neighbor]]))
+ [caves.world.core :only [find-empty-neighbor]]))
(defrecord Bunny [id glyph color location hp max-hp name])
--- a/src/caves/entities/core.clj Tue Jul 31 10:05:58 2012 -0400
+++ b/src/caves/entities/core.clj Wed Aug 01 21:13:37 2012 -0400
@@ -82,7 +82,7 @@
This is similar to extend-type, with two differences:
- * It must be used on a protocol defined with defaspect
+ * It must be used on a protocol defined with defaspect.
* It will use the aspect's default function implementation for any functions
not given.
--- a/src/caves/entities/lichen.clj Tue Jul 31 10:05:58 2012 -0400
+++ b/src/caves/entities/lichen.clj Wed Aug 01 21:13:37 2012 -0400
@@ -2,7 +2,7 @@
(:use [caves.entities.core :only [Entity get-id add-aspect]]
[caves.entities.aspects.receiver :only [send-message-nearby]]
[caves.entities.aspects.destructible :only [Destructible]]
- [caves.world :only [find-empty-neighbor]]))
+ [caves.world.core :only [find-empty-neighbor]]))
(defrecord Lichen [id glyph color location hp max-hp name])
--- a/src/caves/entities/player.clj Tue Jul 31 10:05:58 2012 -0400
+++ b/src/caves/entities/player.clj Wed Aug 01 21:13:37 2012 -0400
@@ -6,7 +6,7 @@
[caves.entities.aspects.attacker :only [Attacker attack]]
[caves.entities.aspects.destructible :only [Destructible]]
[caves.coords :only [destination-coords]]
- [caves.world :only [get-entity-at]]))
+ [caves.world.core :only [get-entity-at]]))
(defrecord Player [id glyph color location hp max-hp attack name])
--- a/src/caves/entities/silverfish.clj Tue Jul 31 10:05:58 2012 -0400
+++ b/src/caves/entities/silverfish.clj Wed Aug 01 21:13:37 2012 -0400
@@ -2,7 +2,7 @@
(:use [caves.entities.core :only [Entity get-id add-aspect]]
[caves.entities.aspects.destructible :only [Destructible]]
[caves.entities.aspects.mobile :only [Mobile move can-move?]]
- [caves.world :only [get-entity-at get-tile-kind]]
+ [caves.world.core :only [get-entity-at get-tile-kind]]
[caves.coords :only [neighbors]]))
--- a/src/caves/ui/input.clj Tue Jul 31 10:05:58 2012 -0400
+++ b/src/caves/ui/input.clj Wed Aug 01 21:13:37 2012 -0400
@@ -1,5 +1,6 @@
(ns caves.ui.input
- (:use [caves.world :only [random-world smooth-world find-empty-tile]]
+ (:use [caves.world.generation :only [random-world smooth-world]]
+ [caves.world.core :only [find-empty-tile]]
[caves.ui.core :only [->UI]]
[caves.entities.player :only [move-player make-player]]
[caves.entities.lichen :only [make-lichen]]
--- a/src/caves/world.clj Tue Jul 31 10:05:58 2012 -0400
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,123 +0,0 @@
-(ns caves.world
- (:use [caves.coords :only [neighbors radial-distance]]))
-
-
-; Constants -------------------------------------------------------------------
-(def world-size [160 50])
-
-; Data structures -------------------------------------------------------------
-(defrecord World [tiles entities])
-(defrecord Tile [kind glyph color])
-
-(def tiles
- {:floor (->Tile :floor "." :white)
- :wall (->Tile :wall "#" :white)
- :bound (->Tile :bound "X" :black)})
-
-
-; Convenience functions -------------------------------------------------------
-(defn get-tile-from-tiles [tiles [x y]]
- (get-in tiles [y x] (:bound tiles)))
-
-(defn random-coordinate []
- (let [[cols rows] world-size]
- [(rand-int cols) (rand-int rows)]))
-
-
-; World generation ------------------------------------------------------------
-(defn random-tiles []
- (let [[cols rows] world-size]
- (letfn [(random-tile []
- (tiles (rand-nth [:floor :wall])))
- (random-row []
- (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 (partial get-tile-from-tiles tiles)
- (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 []
- (let [world (->World (random-tiles) {})
- world (nth (iterate smooth-world world) 3)]
- world))
-
-
-; Querying a world ------------------------------------------------------------
-(defn get-tile [world coord]
- (get-tile-from-tiles (:tiles world) coord))
-
-(defn get-tile-kind [world coord]
- (:kind (get-tile world coord)))
-
-(defn set-tile [world [x y] tile]
- (assoc-in world [:tiles y x] tile))
-
-(defn set-tile-floor [world coord]
- (set-tile world coord (:floor tiles)))
-
-
-(defn get-entities-at [world coord]
- (filter #(= coord (:location %))
- (vals (:entities world))))
-
-(defn get-entity-at [world coord]
- (first (get-entities-at world coord)))
-
-(defn get-entities-around
- ([world coord] (get-entities-around world coord 1))
- ([world coord radius]
- (filter #(<= (radial-distance coord (:location %))
- radius)
- (vals (:entities world)))))
-
-(defn is-empty? [world coord]
- (and (#{:floor} (get-tile-kind world coord))
- (not (get-entity-at world coord))))
-
-(defn find-empty-tile [world]
- (loop [coord (random-coordinate)]
- (if (is-empty? world coord)
- coord
- (recur (random-coordinate)))))
-
-(defn find-empty-neighbor [world coord]
- (let [candidates (filter #(is-empty? world %) (neighbors coord))]
- (when (seq candidates)
- (rand-nth candidates))))
-
-
-(defn check-tile
- "Check that the tile at the destination passes the given predicate."
- [world dest pred]
- (pred (get-tile-kind world dest)))
-
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/caves/world/core.clj Wed Aug 01 21:13:37 2012 -0400
@@ -0,0 +1,77 @@
+(ns caves.world.core
+ (:use [caves.coords :only [neighbors radial-distance]]))
+
+
+; Constants -------------------------------------------------------------------
+(def world-size [160 50])
+
+; Data structures -------------------------------------------------------------
+(defrecord World [tiles entities])
+(defrecord Tile [kind glyph color])
+
+(def tiles
+ {:floor (->Tile :floor "." :white)
+ :wall (->Tile :wall "#" :white)
+ :up (->Tile :up "<" :white)
+ :down (->Tile :down ">" :white)
+ :bound (->Tile :bound "X" :black)})
+
+
+; Convenience functions -------------------------------------------------------
+(defn get-tile-from-tiles [tiles [x y]]
+ (get-in tiles [y x] (:bound tiles)))
+
+(defn random-coordinate []
+ (let [[cols rows] world-size]
+ [(rand-int cols) (rand-int rows)]))
+
+
+; Querying a world ------------------------------------------------------------
+(defn get-tile [world coord]
+ (get-tile-from-tiles (:tiles world) coord))
+
+(defn get-tile-kind [world coord]
+ (:kind (get-tile world coord)))
+
+(defn set-tile [world [x y] tile]
+ (assoc-in world [:tiles y x] tile))
+
+(defn set-tile-floor [world coord]
+ (set-tile world coord (:floor tiles)))
+
+
+(defn get-entities-at [world coord]
+ (filter #(= coord (:location %))
+ (vals (:entities world))))
+
+(defn get-entity-at [world coord]
+ (first (get-entities-at world coord)))
+
+(defn get-entities-around
+ ([world coord] (get-entities-around world coord 1))
+ ([world coord radius]
+ (filter #(<= (radial-distance coord (:location %))
+ radius)
+ (vals (:entities world)))))
+
+(defn is-empty? [world coord]
+ (and (#{:floor} (get-tile-kind world coord))
+ (not (get-entity-at world coord))))
+
+(defn find-empty-tile [world]
+ (loop [coord (random-coordinate)]
+ (if (is-empty? world coord)
+ coord
+ (recur (random-coordinate)))))
+
+(defn find-empty-neighbor [world coord]
+ (let [candidates (filter #(is-empty? world %) (neighbors coord))]
+ (when (seq candidates)
+ (rand-nth candidates))))
+
+
+(defn check-tile
+ "Check that the tile at the destination passes the given predicate."
+ [world dest pred]
+ (pred (get-tile-kind world dest)))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/caves/world/generation.clj Wed Aug 01 21:13:37 2012 -0400
@@ -0,0 +1,51 @@
+(ns caves.world.generation
+ (:use [caves.world.core :only [tiles get-tile-from-tiles random-coordinate
+ world-size ->World]]))
+
+
+
+(defn random-tiles []
+ (let [[cols rows] world-size]
+ (letfn [(random-tile []
+ (tiles (rand-nth [:floor :wall])))
+ (random-row []
+ (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 (partial get-tile-from-tiles tiles)
+ (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 []
+ (let [world (->World (random-tiles) {})
+ world (nth (iterate smooth-world world) 3)]
+ world))