lock,unlock

darcs-hash:28fe95a7a4e97527becd746fbe454cc2c4cb54c1

diff --git a/iflib.lisp b/iflib.lisp
index 853d89d22a1b94182d99650ab67cbc9c0a181900..84b7b2b4de0ac8c4a9dbef7dd687271395cf3d72 100644 (file)
--- a/iflib.lisp
+++ b/iflib.lisp
@@ -81,8 +81,8 @@
 (defparameter *player* nil\r
   "Current player object (will be initialised later)")\r
 \r
-(declare-predicate add-to-scope add-to-outscope found-in seen-from)\r
-\r
+(declare-predicate add-to-scope add-to-outscope found-in seen-from\r
+                   with-keys)\r
 \r
 ;;Library file names\r
 (defvar *library-file-if* "if.fas")\r

diff --git a/verbs.lisp b/verbs.lisp
index d10da4d5242aa7c9b79e13aaa7452454e8a9b111..a6e4dd4d69cb8d78e7094faf781d87f45fada3ac 100644 (file)
--- a/verbs.lisp
+++ b/verbs.lisp
@@ -17,7 +17,8 @@
           :take :put-in :put-on :drop :receive\r
           :wear :strip :enter :climb :drink :eat\r
            :rub :turn :switch-on :switch-off\r
-           :fill :empty :extract :let-go :open :close)\r
+           :fill :empty :extract :let-go :open :close\r
+           :lock :unlock :open-unlock)\r
   (:shadow :listen :fill :open :close)\r
   (:shadowing-import-from :if-lib :room))\r
 \r
@@ -433,10 +434,11 @@
   (run-action-after host))\r
 \r
 (defaction open (obj)\r
-  "You cannot open this")\r
+  "You cannot open this.")\r
 \r
 (defmethod open ((obj container))\r
-  (unless (has obj :container) (return-from open (call-next-method)))\r
+  (unless (and (has obj :container) (has obj :openable))\r
+    (return-from open (call-next-method)))  \r
   (if (has obj :closed)\r
       (if (hasnt obj :locked)\r
           (progn \r
@@ -446,11 +448,65 @@
           "It's locked.")\r
       (format nil "~a is already open." (the-name obj))))\r
 \r
+(defaction close (obj)\r
+  "You cannot close this.")\r
+\r
 (defmethod close ((obj container))\r
-  (unless (has obj :container) (return-from closed (call-next-method)))\r
+  (unless (and (has obj :container) (has obj :openable))\r
+    (return-from close (call-next-method)))\r
   (if (hasnt obj :closed)\r
       (progn \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
+\r
+(defaction lock (obj key)\r
+  "Not lockable.")\r
+\r
+(defmethod lock ((obj container) (key item))\r
+  (unless (and (has obj :container) \r
+               (has obj :openable)\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
+      (if (hasnt obj :closed)\r
+          (format nil "~a is not closed." (the-name obj))\r
+          (if (with-keys obj key)\r
+              (progn\r
+                (give obj :locked)\r
+                (when (run-action-after obj)\r
+                  (format nil "You lock ~a." (the-name obj))))\r
+              (format nil "You cannot lock ~a with ~a."\r
+                      (the-name obj) (the-name key))))))\r
+\r
+(defaction unlock (obj key)\r
+  "There is nothing to unlock.")\r
+\r
+(defmethod unlock ((obj container) (key item))\r
+  (unless (and (has obj :container) \r
+               (has obj :openable)\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
+      (if (hasnt obj :closed)\r
+          (format nil "~a is not closed." (the-name obj))\r
+          (if (with-keys obj key)\r
+              (progn\r
+                (give obj :~locked)\r
+                (when (run-action-after obj)\r
+                  (format nil "You unlock ~a." (the-name obj))))\r
+              (format nil "You cannot unlock ~a with ~a."\r
+                      (the-name obj) (the-name key))))))\r
+\r
+(defaction open-unlock (obj key)\r
+  "You cannot open this.")\r
+\r
+(defmethod open-unlock ((obj container) (key item))\r
+  (unless (and (has obj :container) \r
+               (has obj :openable))\r
+    (return-from open-unlock (call-next-method)))\r
+  (and (run-action 'unlock *args*)\r
+       (run-action 'open obj)))\r