various bugfixes + updated example

darcs-hash:9b62e12d63b73d52a27cf208129682d5d880d02b

diff --git a/EXAMPLES/lifptest.lisp b/EXAMPLES/lifptest.lisp
index 61e14e91690469f24fd041c49fd7f43302ff6c82..0ed87797d8b87bde7d2968cbb3e782ad31b9d633 100644 (file)
--- a/EXAMPLES/lifptest.lisp
+++ b/EXAMPLES/lifptest.lisp
@@ -5,7 +5,8 @@
 (object bigroom (room) "The Big Room"\r
         (description "This is the Big Room. It's main purpose is\r
         to host the devices that are used to test various\r
-        features of LIFP."))\r
+        features of LIFP. The door to the north leads to closet.")\r
+        (n-to 'closetdoor))\r
 \r
 (object bigkey (item) "big key" bigroom\r
         (description "This is a big key. It is probably used to\r
@@ -17,6 +18,15 @@
         (with-keys bigkey)\r
         (has :openable :closed :lockable :locked))\r
 \r
+(object closetdoor (door) "door to closet" bigroom\r
+        (name "door")\r
+        (description "The door that leads to closet")\r
+        (destination 'closet))\r
+\r
+(object closet (room) "Small Closet"\r
+        (description "This closet is small and dimly lit.")\r
+        (s-to 'bigroom))\r
+\r
 (supply init ()\r
    (setf *location* bigroom)\r
    "~%~%Somehow you ended up in some big room. But hey, what do\r

diff --git a/iflib.lisp b/iflib.lisp
index dad57f5465c3eeb760326a8cb8d63145820563df..0154b718e83198fb3af6b7c2042da93f41f87c8e 100644 (file)
--- a/iflib.lisp
+++ b/iflib.lisp
@@ -120,7 +120,8 @@
          (look (look self)))\r
        (has :~light))\r
 \r
-(ifclass door (predoor scenery) (destination object) (has :door :closed))\r
+(ifclass door (predoor scenery) (destination object) \r
+         (has :door :closed :openable))\r
 \r
 \r
 \r
@@ -161,7 +162,7 @@
 \r
 (defun transparent (obj)\r
   "Whether the object is transparent"\r
-  (or (has obj :container :open) \r
+  (or (and (has obj :container) (hasnt obj :closed)) \r
       (has obj :supporter)\r
       (has obj :transparent)\r
       (eql obj *player*)))\r
@@ -206,7 +207,7 @@
       (seep1 actor obj)))\r
 \r
 (defun passable (obj)\r
-  (or (has obj :container :open)\r
+  (or (and (has obj :container) (hasnt obj :closed))\r
       (has obj :supporter)\r
       (eql obj *player*)))\r
 \r
@@ -327,7 +328,7 @@
 (defun print-inside (obj stream)\r
   "Return the string containing the status of contents of the object"\r
   (when (has obj :container)\r
-    (if (or (has obj :open) (has obj :transparent))\r
+    (if (or (hasnt obj :closed) (has obj :transparent))\r
        (if (children obj)\r
          (progn (princ " (containing " stream) \r
                 (princ (list-contents obj) stream) \r

diff --git a/verbs.lisp b/verbs.lisp
index 39c66af586b1db27c8ec5d8e37c6706183476cc9..5b090e6e9769ab15b3cec62695be9c8745500ca8 100644 (file)
--- a/verbs.lisp
+++ b/verbs.lisp
@@ -218,7 +218,7 @@
 \r
 (defmethod go-to-dispatch ((dest door))\r
   (unless (has dest :door) (return-from go-to-dispatch (call-next-method)))\r
-  (if (has dest :closed) (format nil "~a is closed." (the-name dest))\r
+  (if (has dest :closed) (format nil "~a is closed." (the-name dest :capital t))\r
       (run-action 'pass *args*)))\r
 \r
 (defaction pass (obj)\r
@@ -334,6 +334,9 @@
 (defaction enter (what)\r
   "You can't enter that.")\r
 \r
+(defmethod enter ((door door))\r
+  (go-to-dispatch door))\r
+\r
 (defaction climb (what)\r
   "You can't climb that.")\r
 \r
@@ -375,7 +378,7 @@
   (if (has obj :switchable)\r
       (progn\r
         (if (has obj :on)\r
-            (format nil "~a is already on." (the-name obj))\r
+            (format nil "~a is already on." (the-name obj :capital t))\r
             (progn (give obj :on)\r
                    (when (run-action-after obj) "Done."))))\r
       (call-next-method)))\r
@@ -384,7 +387,7 @@
   (if (has obj :switchable)\r
       (progn\r
         (if (hasnt obj :on)\r
-            (format nil "~a is already off." (the-name obj))\r
+            (format nil "~a is already off." (the-name obj :capital t))\r
             (progn (give obj :~on)\r
                    (when (run-action-after obj) "Done."))))\r
       (call-next-method)))        \r
@@ -451,7 +454,7 @@
             (when (run-action-after obj)\r
               (format nil "You open ~a." (the-name obj))))\r
           "It's locked.")\r
-      (format nil "~a is already open." (the-name obj))))\r
+      (format nil "~a is already open." (the-name obj :capital t))))\r
 \r
 (defaction close (obj)\r
   "You cannot close this.")\r
@@ -464,7 +467,7 @@
         (give obj :closed)\r
         (when (run-action-after obj)\r
           (format nil "You close ~a." (the-name obj))))\r
-      (format nil "~a is already closed." (the-name obj))))\r
+      (format nil "~a is already closed." (the-name obj :capital t))))\r
 \r
 (defaction lock (obj key)\r
   "Not lockable.")\r
@@ -475,9 +478,9 @@
                (has obj :lockable))\r
     (return-from lock (call-next-method)))\r
   (if (has obj :locked) \r
-      (format nil "~a is already locked." (the-name obj))\r
+      (format nil "~a is already locked." (the-name obj :capital t))\r
       (if (hasnt obj :closed)\r
-          (format nil "~a is not closed." (the-name obj))\r
+          (format nil "~a is not closed." (the-name obj :capital t))\r
           (if (with-keys obj key)\r
               (progn\r
                 (give obj :locked)\r
@@ -495,9 +498,9 @@
                (has obj :lockable))\r
     (return-from unlock (call-next-method)))\r
   (if (hasnt obj :locked) \r
-      (format nil "~a is already unlocked." (the-name obj))\r
+      (format nil "~a is already unlocked." (the-name obj :capital t))\r
       (if (hasnt obj :closed)\r
-          (format nil "~a is not closed." (the-name obj))\r
+          (format nil "~a is not closed." (the-name obj :capital t))\r
           (if (with-keys obj key)\r
               (progn\r
                 (give obj :~locked)\r