official update

[lifp.git] / iflib.lisp

diff --git a/iflib.lisp b/iflib.lisp
index 8ed948098176870efde758fdbc3d4333005477c7..e9145fb1f725180bb27cc9573bfbfa2b94f81aa0 100644 (file)
--- a/iflib.lisp
+++ b/iflib.lisp
@@ -37,10 +37,11 @@
           :reset-scope :look :words2dic-first :disambig :normal-token-scope\r
           :input-quit-loop :quit-game :prompt :prompt-read :input-loop-step\r
           :go-to-room :property :init :test-seq\r
-          :heldp :the-name :each-turn\r
+          :heldp :the-name :each-turn :daemon :time-left :time-out\r
+           :start-daemon :stop-daemon :start-timer :stop-timer           \r
           :supporter :animate :scenery\r
           :afterlife :print-gamestate :end-game\r
-          :repl-mode :compile-lib \r
+          :repl-mode :compile-lib :free-symbol \r
           )\r
   (:shadow :room))\r
 \r
@@ -256,7 +257,7 @@
 (defun print-property (obj property)\r
   "Print a property of object"\r
   (multiple-value-bind (value printp) (read-property obj property)\r
-    (if (and (stringp value) (not printp)) (sprint value) value)))\r
+    (if (and (stringp value) (not printp)) (progn (sprint value) t) printp)))\r
 \r
 (defgeneric print-name (obj &key article capital)\r
   (:documentation "Returns a string containing the name of object"))\r
@@ -507,11 +508,33 @@
 (supply turn-passing (&optional time)  \r
        (reset-scope)\r
        (incf *turns* time)\r
-       (loop for x in *outscope*\r
+       (loop for x in *allobjects*\r
+              if (and (has x :daemon) (provides x 'daemon))\r
+              do (read-property- :execute x 'daemon)\r
+              if (and (has x :timer) (provides x 'time-left) \r
+                      (provides x 'time-out))\r
+              do (if (zerop (slot-value x 'time-left))\r
+                     (read-property- :execute x 'time-out)\r
+                     (decf (slot-value x 'time-left))))\r
+        (loop for x in *outscope*\r
              if (provides x 'each-turn)\r
-             do (read-property-execute (slot-value x 'each-turn)))\r
+             do (read-property- :execute x 'each-turn))           \r
        (call-next-method))          \r
 \r
+(defun start-daemon (obj)\r
+  (give obj :daemon))\r
+\r
+(defun stop-daemon (obj)\r
+  (give obj :~daemon))\r
+\r
+(defun start-timer (obj time)\r
+  (assert (provides obj 'time-left))\r
+  (setf (slot-value obj 'time-left) time)\r
+  (give obj :timer))\r
+\r
+(defun stop-timer (obj)\r
+  (give obj :~timer))\r
+\r
 (defgeneric before-special-rule (location)\r
   (:documentation "Runs on location before other before effects are runned")\r
   (:method (location) (declare (ignore location)) nil))\r
@@ -652,6 +675,12 @@
     (: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)))\r
+\r
+(defmacro free-symbol (id)\r
+  "Frees a symbol from current package using shadow"\r
+  `(eval-when (:compile-toplevel :load-toplevel :execute)\r
+     (shadow ,id)))\r
+\r
    \r
 (defun repl-mode (&optional (mode :unspecified))\r
   "Flip the using of REPL for input and output (as opposed to\r