X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=verbs.lisp;h=39c66af586b1db27c8ec5d8e37c6706183476cc9;hb=447a18ccfc600c416a481266ecac28cd2ecd720f;hp=d10da4d5242aa7c9b79e13aaa7452454e8a9b111;hpb=e4d49c347b683ad27be42750e0d9117384fb6c23;p=lifp.git

diff --git a/verbs.lisp b/verbs.lisp
index d10da4d..39c66af 100644
--- a/verbs.lisp
+++ b/verbs.lisp
@@ -13,11 +13,12 @@
 (defpackage :verb-lib
   (:use :common-lisp :if-lib :if-basic-lib)
   (:export :attack :take :teleport :examine 
-	   :go-to 
+	   :go-to :pass
 	   :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 :unlock-open)
   (:shadow :listen :fill :open :close)
   (:shadowing-import-from :if-lib :room))
 
@@ -204,23 +205,28 @@
 
 (defaction go-to (dir)
   (let ((destination (read-property *location* (property dir))))
-    (if destination (go-to-room destination)
+    (if destination (exec go-to-dispatch (destination))
 	(if (provides *location* 'cant-go) 
 	    (read-property *location* 'cant-go)
 	    "You can't go here."))))
 
-;; (defaction go-n () (run-action 'go-to dir-n))
-;; (defaction go-ne () (run-action 'go-to dir-ne))
-;; (defaction go-e () (run-action 'go-to dir-e))
-;; (defaction go-se () (run-action 'go-to dir-se))
-;; (defaction go-s () (run-action 'go-to dir-s))
-;; (defaction go-sw () (run-action 'go-to dir-sw))
-;; (defaction go-w () (run-action 'go-to dir-w))
-;; (defaction go-nw () (run-action 'go-to dir-nw))
-;; (defaction go-u () (run-action 'go-to dir-u))
-;; (defaction go-d () (run-action 'go-to dir-d))
-;; (defaction go-in () (run-action 'go-to dir-in))
-;; (defaction go-out () (run-action 'go-to dir-out))
+(defgeneric go-to-dispatch (dest)
+  (:documentation "Dispatches between different kinds of goable objects"))
+
+(defmethod go-to-dispatch ((dest room))
+  (go-to-room dest))
+
+(defmethod go-to-dispatch ((dest door))
+  (unless (has dest :door) (return-from go-to-dispatch (call-next-method)))
+  (if (has dest :closed) (format nil "~a is closed." (the-name dest))
+      (run-action 'pass *args*)))
+
+(defaction pass (obj)
+  "Something's wrong happened.")
+
+(defmethod pass ((obj door))
+  (go-to-dispatch (read-property obj 'destination))
+  (run-action-after obj))
 
 (defun inventory ()
   (sprint "You are carrying: ~a." (list-contents *player*))
@@ -433,10 +439,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)))
+(defmethod open ((obj predoor))
+  (unless (and (or (has obj :container) (has obj :door)) (has obj :openable))
+    (return-from open (call-next-method)))  
   (if (has obj :closed)
       (if (hasnt obj :locked)
           (progn 
@@ -446,11 +453,65 @@
           "It's locked.")
       (format nil "~a is already open." (the-name obj))))
 
-(defmethod close ((obj container))
-  (unless (has obj :container) (return-from closed (call-next-method)))
+(defaction close (obj)
+  "You cannot close this.")
+
+(defmethod close ((obj predoor))
+  (unless (and (or (has obj :container) (has obj :door)) (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 predoor) (key item))
+  (unless (and (or (has obj :container) (has obj :door)) 
+               (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 predoor) (key item))
+  (unless (and (or (has obj :container) (has obj :door)) 
+               (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 unlock-open (obj key)
+  "You cannot open this.")
+
+(defmethod unlock-open ((obj predoor) (key item))
+  (unless (and (or (has obj :container) (has obj :door)) 
+               (has obj :openable))
+    (return-from unlock-open (call-next-method)))
+  (and (run-action 'unlock *args*)
+       (run-action 'open obj)))