From 9c86499fa997e562b8a2434bf2a978f85969eda1 Mon Sep 17 00:00:00 2001
From: grue <grue@mail.ru>
Date: Wed, 5 Jul 2006 09:23:31 +0000
Subject: [PATCH] lock,unlock

darcs-hash:28fe95a7a4e97527becd746fbe454cc2c4cb54c1
---
 iflib.lisp |  4 ++--
 verbs.lisp | 64 ++++++++++++++++++++++++++++++++++++++++++++++++++----
 2 files changed, 62 insertions(+), 6 deletions(-)

diff --git a/iflib.lisp b/iflib.lisp
index 853d89d..84b7b2b 100644
--- a/iflib.lisp
+++ b/iflib.lisp
@@ -81,8 +81,8 @@
 (defparameter *player* nil
   "Current player object (will be initialised later)")
 
-(declare-predicate add-to-scope add-to-outscope found-in seen-from)
-
+(declare-predicate add-to-scope add-to-outscope found-in seen-from
+                   with-keys)
 
 ;;Library file names
 (defvar *library-file-if* "if.fas")
diff --git a/verbs.lisp b/verbs.lisp
index d10da4d..a6e4dd4 100644
--- a/verbs.lisp
+++ b/verbs.lisp
@@ -17,7 +17,8 @@
 	   :take :put-in :put-on :drop :receive
 	   :wear :strip :enter :climb :drink :eat
            :rub :turn :switch-on :switch-off
-           :fill :empty :extract :let-go :open :close)
+           :fill :empty :extract :let-go :open :close
+           :lock :unlock :open-unlock)
   (:shadow :listen :fill :open :close)
   (:shadowing-import-from :if-lib :room))
 
@@ -433,10 +434,11 @@
   (run-action-after host))
 
 (defaction open (obj)
-  "You cannot open this")
+  "You cannot open this.")
 
 (defmethod open ((obj container))
-  (unless (has obj :container) (return-from open (call-next-method)))
+  (unless (and (has obj :container) (has obj :openable))
+    (return-from open (call-next-method)))  
   (if (has obj :closed)
       (if (hasnt obj :locked)
           (progn 
@@ -446,11 +448,65 @@
           "It's locked.")
       (format nil "~a is already open." (the-name obj))))
 
+(defaction close (obj)
+  "You cannot close this.")
+
 (defmethod close ((obj container))
-  (unless (has obj :container) (return-from closed (call-next-method)))
+  (unless (and (has obj :container) (has obj :openable))
+    (return-from close (call-next-method)))
   (if (hasnt obj :closed)
       (progn 
         (give obj :closed)
         (when (run-action-after obj)
           (format nil "You close ~a." (the-name obj))))
       (format nil "~a is already closed." (the-name obj))))
+
+(defaction lock (obj key)
+  "Not lockable.")
+
+(defmethod lock ((obj container) (key item))
+  (unless (and (has obj :container) 
+               (has obj :openable)
+               (has obj :lockable))
+    (return-from lock (call-next-method)))
+  (if (has obj :locked) 
+      (format nil "~a is already locked." (the-name obj))
+      (if (hasnt obj :closed)
+          (format nil "~a is not closed." (the-name obj))
+          (if (with-keys obj key)
+              (progn
+                (give obj :locked)
+                (when (run-action-after obj)
+                  (format nil "You lock ~a." (the-name obj))))
+              (format nil "You cannot lock ~a with ~a."
+                      (the-name obj) (the-name key))))))
+
+(defaction unlock (obj key)
+  "There is nothing to unlock.")
+
+(defmethod unlock ((obj container) (key item))
+  (unless (and (has obj :container) 
+               (has obj :openable)
+               (has obj :lockable))
+    (return-from unlock (call-next-method)))
+  (if (hasnt obj :locked) 
+      (format nil "~a is already unlocked." (the-name obj))
+      (if (hasnt obj :closed)
+          (format nil "~a is not closed." (the-name obj))
+          (if (with-keys obj key)
+              (progn
+                (give obj :~locked)
+                (when (run-action-after obj)
+                  (format nil "You unlock ~a." (the-name obj))))
+              (format nil "You cannot unlock ~a with ~a."
+                      (the-name obj) (the-name key))))))
+
+(defaction open-unlock (obj key)
+  "You cannot open this.")
+
+(defmethod open-unlock ((obj container) (key item))
+  (unless (and (has obj :container) 
+               (has obj :openable))
+    (return-from open-unlock (call-next-method)))
+  (and (run-action 'unlock *args*)
+       (run-action 'open obj)))
-- 
2.31.1