# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1342025010 14400
# Node ID 35acf92fe5975c9b64a5df8940ab7fba7a6dc8ae
# Parent  9770861b040f55d87b8c44f8d57795dd1f77f8e1
MOAR

diff -r 9770861b040f -r 35acf92fe597 project.clj
--- a/project.clj	Wed Jul 11 00:52:51 2012 -0400
+++ b/project.clj	Wed Jul 11 12:43:30 2012 -0400
@@ -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
+
+  )
diff -r 9770861b040f -r 35acf92fe597 src/caves/coords.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/caves/coords.clj	Wed Jul 11 12:43:30 2012 -0400
@@ -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)))
diff -r 9770861b040f -r 35acf92fe597 src/caves/entities/aspects/digger.clj
--- a/src/caves/entities/aspects/digger.clj	Wed Jul 11 00:52:51 2012 -0400
+++ b/src/caves/entities/aspects/digger.clj	Wed Jul 11 12:43:30 2012 -0400
@@ -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."))
diff -r 9770861b040f -r 35acf92fe597 src/caves/entities/aspects/mobile.clj
--- a/src/caves/entities/aspects/mobile.clj	Wed Jul 11 00:52:51 2012 -0400
+++ b/src/caves/entities/aspects/mobile.clj	Wed Jul 11 12:43:30 2012 -0400
@@ -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."))
 
diff -r 9770861b040f -r 35acf92fe597 src/caves/entities/player.clj
--- a/src/caves/entities/player.clj	Wed Jul 11 00:52:51 2012 -0400
+++ b/src/caves/entities/player.clj	Wed Jul 11 12:43:30 2012 -0400
@@ -2,32 +2,16 @@
   (: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
@@ -35,30 +19,27 @@
     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)))
diff -r 9770861b040f -r 35acf92fe597 src/caves/world.clj
--- a/src/caves/world.clj	Wed Jul 11 00:52:51 2012 -0400
+++ b/src/caves/world.clj	Wed Jul 11 12:43:30 2012 -0400
@@ -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)))
-