below function
authorgrue <grue@mail.ru>
Mon, 13 Feb 2006 20:50:52 +0000 (20:50 +0000)
committergrue <grue@mail.ru>
Mon, 13 Feb 2006 20:50:52 +0000 (20:50 +0000)
darcs-hash:1e09aa5eaf5c8dfd2a366b28780a8331e48aeded

if.lisp

diff --git a/if.lisp b/if.lisp
index 881c62956b537b25ca6c5fbc4b8c2166faf8a9fc..5664a60d9a1eddba65200111c3cf5a758c1b9481 100644 (file)
--- a/if.lisp
+++ b/if.lisp
@@ -42,7 +42,7 @@
            :abstractobject :name :names :parent :children :flags\r
            :initflags :add-flags :has :hasnt :-> :give :child\r
            :ifclass :object :defaction :*meta*\r
-           :move :rmv :ofclass :among\r
+           :move :rmv :ofclass :among :below\r
            :verb :extend-verb :extend-verb-first\r
            :extend-verb-only :extend-verb-only-first\r
            :deftoken :string== :matchp :!last!\r
@@ -744,7 +744,14 @@ word in dictionary, add it."
 (defun notin (obj &rest what)\r
   "Test whether the object is not in any of other arguments"\r
   (notany (lambda (x) (eql (parent obj) x)) what))\r
-   \r
+\r
+(defun below (obj1 obj2)\r
+  "Tests whether obj1 is strictly below obj2 in object structure"\r
+  (loop for x = obj1 then (parent x)\r
+        while x\r
+        when (eql x obj2) do (return t)\r
+        finally (return nil)))\r
+\r
 ;;SECTION 9: Verb functions\r
 \r
 (defstruct patternlist value)\r