# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1470844433 0
# Node ID 0c5970729c2f8d293062bd004ef762d0e9438ad2
# Parent  5868b180e4aa9fd92e6b4ca2a52c12125555308d
Add arbitrary labels, fixing the directions mess

diff -r 5868b180e4aa -r 0c5970729c2f silt.lisp
--- a/silt.lisp	Wed Aug 10 03:11:41 2016 +0000
+++ b/silt.lisp	Wed Aug 10 15:53:53 2016 +0000
@@ -465,7 +465,13 @@
 
 
 ;;; Inspection
-(define-aspect inspectable slots)
+(define-aspect inspectable
+  (slots :initform nil))
+
+(defun inspectable-get (entity slot)
+  (etypecase slot
+    (symbol (cons slot (slot-value entity slot)))
+    (function (funcall slot entity))))
 
 
 ;;; Visibility
@@ -776,11 +782,15 @@
       :metabolizing/energy energy
       :metabolizing/insulation insulation
       :sentient/function 'creature-act
-      :inspectable/slots '(name directions
-                           metabolizing/energy metabolizing/insulation
-                           aging/birthtick aging/age)
-      :flavor/text (list (format nil "A creature named ~:(~A~) is here." name)
-                         "It likes food."))))
+      :inspectable/slots
+      (list 'name
+            (lambda (c) (cons 'directions
+                              (weightlist-weights (creature-directions c))))
+            'metabolizing/energy 'metabolizing/insulation
+            'aging/birthtick 'aging/age)
+      :flavor/text
+      (list (format nil "A creature named ~:(~A~) is here." name)
+            "It likes food."))))
 
 (defun make-corpse (x y color name)
   (create-entity
@@ -1083,14 +1093,15 @@
           (appending
             (indent
               (iterate
-                (with slots = (inspectable/slots entity))
+                (with slots = (mapcar (curry #'inspectable-get entity)
+                                      (inspectable/slots entity)))
                 (with width = (apply #'max
-                                     (mapcar (compose #'length #'symbol-name)
+                                     (mapcar (compose #'length #'symbol-name #'car)
                                              slots)))
-                (for slot :in slots)
-                (collect (let ((*print-pretty* nil))
-                           (format nil "~vA ~A"
-                                   width slot (slot-value entity slot))))))
+                (for (label . contents) :in slots)
+                (collect
+                  (let ((*print-pretty* nil))
+                    (format nil "~vA ~A" width label contents)))))
             :into text))
 
         (collecting "" :into text))