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
 (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
 \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
         (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
 (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
          (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
 \r
 \r
 \r


@@ -161,7 +162,7 @@
 \r
 (defun transparent (obj)\r
   "Whether the object is transparent"\r
 \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
       (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
       (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
       (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
 (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
        (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
 \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
       (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
 (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
 (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
   (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
             (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
   (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
             (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
             (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
 \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
         (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
 \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
                (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
       (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
           (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
                (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
       (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
           (if (with-keys obj key)\r
               (progn\r
                 (give obj :~locked)\r