Permalink
Browse files

MOAR

  • Loading branch information...
1 parent 1c9630e commit e95a001b186af54ba8b7878d8afc26e2e280d991 @sjl committed Jul 11, 2012
View
@@ -4,4 +4,7 @@
:license {:name "MIT/X11"}
:dependencies [[org.clojure/clojure "1.4.0"]
[clojure-lanterna "0.9.0"]]
- :main caves.core)
+
+ ; :main caves.core
+
+ )
View
@@ -0,0 +1,25 @@
+(ns caves.coords)
+
+
+(defn offset-coords
+ "Offset the starting coordinate by the given amount, returning the result coordinate."
+ [[x y] [dx dy]]
+ [(+ x dx) (+ y dy)])
+
+(defn dir-to-offset
+ "Convert a direction to the offset for moving 1 in that direction."
+ [dir]
+ (case dir
+ :w [-1 0]
+ :e [1 0]
+ :n [0 -1]
+ :s [0 1]
+ :nw [-1 -1]
+ :ne [1 -1]
+ :sw [-1 1]
+ :se [1 1]))
+
+(defn destination-coords
+ "Take an origin's coords and a direction and return the destination's coords."
+ [origin dir]
+ (offset-coords origin (dir-to-offset dir)))
@@ -1,7 +1,8 @@
(ns caves.entities.aspects.digger)
+
(defprotocol Digger
- (dig [this world dx dy]
+ (dig [this world target]
"Dig a location.")
- (can-dig? [this world dx dy]
+ (can-dig? [this world target]
"Return whether the entity can dig the new location."))
@@ -2,8 +2,8 @@
(defprotocol Mobile
- (move [this world dx dy]
+ (move [this world dest]
"Move this entity to a new location.")
- (can-move? [this world dx dy]
+ (can-move? [this world dest]
"Return whether the entity can move to the new location."))
@@ -2,63 +2,44 @@
(:use [caves.entities.core :only [Entity]]
[caves.entities.aspects.mobile :only [Mobile move can-move?]]
[caves.entities.aspects.digger :only [Digger dig can-dig?]]
+ [caves.coords :only [destination-coords]]
[caves.world :only [find-empty-tile get-tile-kind set-tile-floor]]))
(defrecord Player [id loc])
-(defn offset-coords [[x y] dx dy]
- [(+ x dx) (+ y dy)])
-
(defn check-tile
- "Take a player and an offset, and check that the tile at the destination
- passes the given predicate."
- [player world dx dy pred]
- (let [[x y] (offset-coords (:loc player) dx dy)
- dest-tile (get-tile-kind world x y)]
- (pred dest-tile)))
-
-(defn dir-to-offset [dir]
- (case dir
- :w [-1 0]
- :e [1 0]
- :n [0 -1]
- :s [0 1]
- :nw [-1 -1]
- :ne [1 -1]
- :sw [-1 1]
- :se [1 1]))
+ "Check that the tile at the destination passes the given predicate."
+ [world dest pred]
+ (pred (get-tile-kind world dest)))
(extend-type Player Entity
(tick [this world]
world))
(extend-type Player Mobile
- (move [this world dx dy]
- (if (can-move? this world dx dy)
- (update-in world [:player :loc] offset-coords dx dy)
- world))
- (can-move? [this world dx dy]
- (check-tile this world dx dy #{:floor})))
+ (move [this world dest]
+ {:pre [(can-move? this world dest)]}
+ (assoc-in world [:player :loc] dest))
+ (can-move? [this world dest]
+ (check-tile world dest #{:floor})))
(extend-type Player Digger
- (dig [this world dx dy]
- (if (can-dig? this world dx dy)
- (let [[tx ty] (offset-coords (:loc this) dx dy)]
- (set-tile-floor world tx ty))
- world))
- (can-dig? [this world dx dy]
- (check-tile this world dx dy #{:wall})))
+ (dig [this world dest]
+ {:pre [(can-dig? this world dest)]}
+ (set-tile-floor world dest))
+ (can-dig? [this world dest]
+ (check-tile world dest #{:wall})))
(defn make-player [world]
(->Player :player (find-empty-tile world)))
-(defn move-player [world direction]
+(defn move-player [world dir]
(let [player (:player world)
- [dx dy] (dir-to-offset direction)]
+ target (destination-coords (:loc player) dir)]
(cond
- (can-move? player world dx dy) (move player world dx dy)
- (can-dig? player world dx dy) (dig player world dx dy)
+ (can-move? player world target) (move player world target)
+ (can-dig? player world target) (dig player world target)
:else world)))
View
@@ -13,11 +13,14 @@
:wall (->Tile :wall "#" :white)
:bound (->Tile :bound "X" :black)})
-(defn get-tile [tiles x y]
+
+; Convenience functions -------------------------------------------------------
+(defn get-tile-from-tiles [tiles [x y]]
(get-in tiles [y x] (:bound tiles)))
-(defn set-tile-floor [world x y]
- (assoc-in world [:tiles y x] (:floor tiles)))
+(defn random-coordinate []
+ (let [[cols rows] world-size]
+ [(rand-int cols) (rand-int rows)]))
; Debugging -------------------------------------------------------------------
@@ -53,8 +56,7 @@
[(+ x dx) (+ y dy)]))
(defn get-block [tiles x y]
- (map (fn [[x y]]
- (get-tile tiles x y))
+ (map (partial get-tile-from-tiles tiles)
(block-coords x y)))
(defn get-smoothed-row [tiles y]
@@ -78,18 +80,23 @@
; Querying a world ------------------------------------------------------------
-(defn random-coordinate []
- (let [[cols rows] world-size]
- [(rand-int cols) (rand-int rows)]))
+(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 find-empty-tile [world]
- (loop [[x y] (random-coordinate)]
- (let [{:keys [kind]} (get-tile (:tiles world) x y)]
+ (loop [coord (random-coordinate)]
+ (let [{:keys [kind]} (get-tile world coord)]
(if (#{:floor} kind)
- [x y]
+ coord
(recur (random-coordinate))))))
-
-(defn get-tile-kind [world x y]
- (:kind (get-tile (:tiles world) x y)))
-

0 comments on commit e95a001

Please sign in to comment.