X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=if.lisp;h=447f69787db91d9ae9364c3290072654903bc4ec;hb=HEAD;hp=881c62956b537b25ca6c5fbc4b8c2166faf8a9fc;hpb=09e2ca3c7abae98d97cbd8efedc45482e15c6169;p=lifp.git

diff --git a/if.lisp b/if.lisp
index 881c629..447f697 100644
--- a/if.lisp
+++ b/if.lisp
@@ -42,7 +42,7 @@
            :abstractobject :name :names :parent :children :flags
            :initflags :add-flags :has :hasnt :-> :give :child
            :ifclass :object :defaction :*meta*
-           :move :rmv :ofclass :among
+           :move :rmv :ofclass :among :below
            :verb :extend-verb :extend-verb-first
            :extend-verb-only :extend-verb-only-first
            :deftoken :string== :matchp :!last!
@@ -483,14 +483,14 @@ word in dictionary, add it."
 
 (defun read-property- (method self property &rest args)
   "read-property using specific method. method is one of keywords:
-   :string :number :object :integer :"
+   :string :number :object :integer :execute :list"
   (case method
     (:string (apply #'read-property-string (slot-value self property) args))
-    (:number (apply #'read-property-string (slot-value self property) args))
-    (:integer (apply #'read-property-string (slot-value self property) args))
-    (:object (apply #'read-property-string (slot-value self property) args))
-    (:execute (apply #'read-property-string (slot-value self property) args))
-    (:list (apply #'read-property-string (slot-value self property) args))
+    (:number (apply #'read-property-number (slot-value self property) args))
+    (:integer (apply #'read-property-integer (slot-value self property) args))
+    (:object (apply #'read-property-object (slot-value self property) args))
+    (:execute (apply #'read-property-execute (slot-value self property) args))
+    (:list (apply #'read-property-list (slot-value self property) args))
     (t (slot-value self property))))
 
 ;;SECTION 7: IfClass macro and its hairy surroundings
@@ -744,7 +744,14 @@ word in dictionary, add it."
 (defun notin (obj &rest what)
   "Test whether the object is not in any of other arguments"
   (notany (lambda (x) (eql (parent obj) x)) what))
-   
+
+(defun below (obj1 obj2)
+  "Tests whether obj1 is strictly below obj2 in object structure"
+  (loop for x = obj1 then (parent x)
+        while x
+        when (eql x obj2) do (return t)
+        finally (return nil)))
+
 ;;SECTION 9: Verb functions
 
 (defstruct patternlist value)
@@ -951,14 +958,15 @@ word in dictionary, add it."
   ;;React after?
   t)
 
-(defun run-action (action args &key (time 0))
+(defun run-action (action args &key (time 0) no-output)
   "Run an action with a given args"
   (unless (listp args) (setf args (list args)))
   (setf *after* nil)
   (let ((*action* action)
         (*args* args)
         (*noun* (first args))
-        (*second* (second args)))
+        (*second* (second args))
+        (*no-output* no-output))
     (when *debug* 
       (format t "[running action: ~a ~a]~%" *action* *args*))
     (when *meta* ;;Just do the darn thing!