open,close
authorgrue <grue@mail.ru>
Sun, 2 Jul 2006 16:57:03 +0000 (16:57 +0000)
committergrue <grue@mail.ru>
Sun, 2 Jul 2006 16:57:03 +0000 (16:57 +0000)
darcs-hash:426a8ec95463a391f93a39cc9400474b189da409

iflib.lisp
verbs.lisp

index 1193606f36ca4880c3708172864045d12e88c026..853d89d22a1b94182d99650ab67cbc9c0a181900 100644 (file)
@@ -79,7 +79,7 @@
   "Turns passed since beginning of the game")\r
 \r
 (defparameter *player* nil\r
-  "Current player object (will be initialised later")\r
+  "Current player object (will be initialised later)")\r
 \r
 (declare-predicate add-to-scope add-to-outscope found-in seen-from)\r
 \r
   `(defpackage ,name\r
     (:use :common-lisp :if-basic-lib :if-lib :verb-lib ,@other-packages)\r
     (:shadowing-import-from :if-lib :room)\r
-    (:shadowing-import-from :verb-lib :listen :fill)))\r
+    (:shadowing-import-from :verb-lib :listen :fill :open :close)))\r
 \r
 (defmacro free-symbol (id)\r
   "Frees a symbol from current package using shadow"\r
index 0adf53ce8cbdbf161bf1afa261b94a0fbaf08e13..d10da4d5242aa7c9b79e13aaa7452454e8a9b111 100644 (file)
@@ -17,8 +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)\r
-  (:shadow :listen :fill)\r
+           :fill :empty :extract :let-go :open :close)\r
+  (:shadow :listen :fill :open :close)\r
   (:shadowing-import-from :if-lib :room))\r
 \r
 (in-package :verb-lib)\r
       \r
 (verb "empty" '(:noun -> empty))\r
 \r
+(verb "open" \r
+      '(:noun -> open)\r
+      '(:noun "with" :held -> unlock-open))\r
 \r
+(verb "close" '(:noun -> close))\r
+(verb "shut" \r
+      '(:noun -> close)\r
+      '("off" :noun -> switch-off)\r
+      '(:noun "off" -> switch-off))\r
+\r
+(verb "lock"\r
+      '(:noun "with" :held -> lock))\r
+(verb "unlock"\r
+      '(:noun "with" :held -> unlock))\r
+      \r
 \r
 (defaction attack (obj) "Violence is not the answer.")\r
 \r
   "This action achieves nothing.")\r
 \r
 (defaction turn (what)\r
-  "That's fixed in place")\r
+  "That's fixed in place.")\r
 \r
 (defmethod turn ((item item))\r
   (if (has item :item)\r
 (defmethod let-go ((host container) (item item))\r
   (move item (parent host))\r
   (run-action-after host))\r
+\r
+(defaction open (obj)\r
+  "You cannot open this")\r
+\r
+(defmethod open ((obj container))\r
+  (unless (has obj :container) (return-from open (call-next-method)))\r
+  (if (has obj :closed)\r
+      (if (hasnt obj :locked)\r
+          (progn \r
+            (give obj :~closed)\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
+\r
+(defmethod close ((obj container))\r
+  (unless (has obj :container) (return-from closed (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