# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1342240286 14400
# Node ID b894c3ffe436500e84e6e49dd21ddaeb1f6f3812
# Parent  9d6dd2ef87e5c98507b7fe297e0afe4e129fb74f
what have I done?

diff -r 9d6dd2ef87e5 -r b894c3ffe436 src/caves/entities/aspects/attacker.clj
--- a/src/caves/entities/aspects/attacker.clj	Fri Jul 13 23:52:13 2012 -0400
+++ b/src/caves/entities/aspects/attacker.clj	Sat Jul 14 00:31:26 2012 -0400
@@ -1,4 +1,5 @@
-(ns caves.entities.aspects.attacker)
+(ns caves.entities.aspects.attacker
+  (:use [caves.entities.core :only [defaspect]]))
 
 
 (defprotocol Attacker
diff -r 9d6dd2ef87e5 -r b894c3ffe436 src/caves/entities/aspects/mobile.clj
--- a/src/caves/entities/aspects/mobile.clj	Fri Jul 13 23:52:13 2012 -0400
+++ b/src/caves/entities/aspects/mobile.clj	Sat Jul 14 00:31:26 2012 -0400
@@ -1,9 +1,13 @@
-(ns caves.entities.aspects.mobile)
+(ns caves.entities.aspects.mobile
+  (:use [caves.entities.core :only [defaspect]]
+        [caves.world :only [is-empty?]]))
+
 
 
-(defprotocol Mobile
+(defaspect Mobile
   (move [this world dest]
-        "Move this entity to a new location.")
+    {:pre [(can-move? this world dest)]}
+    (assoc-in world [:entities (:id this) :location] dest))
   (can-move? [this world dest]
-             "Return whether the entity can move to the new location."))
+    (is-empty? world dest)))
 
diff -r 9d6dd2ef87e5 -r b894c3ffe436 src/caves/entities/core.clj
--- a/src/caves/entities/core.clj	Fri Jul 13 23:52:13 2012 -0400
+++ b/src/caves/entities/core.clj	Sat Jul 14 00:31:26 2012 -0400
@@ -13,3 +13,49 @@
     (let [id @ids]
       (alter ids inc)
       id)))
+
+
+(defn make-fnmap [fns]
+  (into {} (for [[label fntail] (map (juxt first rest) fns)]
+             [(keyword label)
+              `(fn ~@fntail)])))
+
+(defn make-fnheads [fns]
+  (map #(take 2 %) fns))
+
+
+(defmacro defaspect [label & fns]
+  (let [fnmap (make-fnmap fns)
+        fnheads (make-fnheads fns)]
+    `(do
+       (defprotocol ~label
+         ~@fnheads)
+       (def ~label
+         (with-meta ~label {:defaults ~fnmap})))))
+
+(defmacro add-aspect [entity aspect & fns]
+  (let [fnmap (make-fnmap fns)]
+    `(extend ~entity ~aspect (merge (:defaults (meta ~aspect))
+                                    ~fnmap))))
+
+
+(comment
+
+  (macroexpand-1
+    '(defaspect Mobile
+                (move [world target]
+                      (when (can-move? world target)
+                        (println world)))
+                (can-move? [world target]
+                           true)))
+
+  (macroexpand-1
+    '(add-aspect Player Mobile))
+
+  (macroexpand-1
+    '(add-aspect EE Mobile
+                 (can-move? [world target]
+                            true)))
+
+
+  )
diff -r 9d6dd2ef87e5 -r b894c3ffe436 src/caves/entities/player.clj
--- a/src/caves/entities/player.clj	Fri Jul 13 23:52:13 2012 -0400
+++ b/src/caves/entities/player.clj	Sat Jul 14 00:31:26 2012 -0400
@@ -1,5 +1,5 @@
 (ns caves.entities.player
-  (:use [caves.entities.core :only [Entity]]
+  (:use [caves.entities.core :only [Entity add-aspect]]
         [caves.entities.aspects.mobile :only [Mobile move can-move?]]
         [caves.entities.aspects.digger :only [Digger dig can-dig?]]
         [caves.entities.aspects.attacker :only [Attacker attack]]
@@ -21,12 +21,7 @@
   (tick [this world]
     world))
 
-(extend-type Player Mobile
-  (move [this world dest]
-    {:pre [(can-move? this world dest)]}
-    (assoc-in world [:entities :player :location] dest))
-  (can-move? [this world dest]
-    (is-empty? world dest)))
+(add-aspect Player Mobile)
 
 (extend-type Player Digger
   (dig [this world dest]