official update

darcs-hash:5d219fd9d81a39d3a8e70d84d447180193a505fd

diff --git a/if.lisp b/if.lisp
index 08d5038aa070f1f779b87225b04cc1a2c0fdcf2a..6a0a3c22027967c87508b4a5f921265c80c8487a 100644 (file)
--- a/if.lisp
+++ b/if.lisp
@@ -36,10 +36,9 @@
            :addword :word2dic :addword2dic\r
            :split-to-words :sprint\r
            :parser :description :article :glance \r
-           :initnames :addnames\r
-           :read-property :read-property-string :read-property-number\r
-           :read-property-integer :read-property-object :read-property-execute\r
-           :read-property-other :read-property-list :exec :exec*\r
+           :initnames :addnames \r
+           :read-property :rp :read-property- \r
+           :exec :exec*\r
            :abstractobject :name :names :parent :children :flags\r
            :initflags :add-flags :has :hasnt :-> :give\r
            :ifclass :object :defaction :*meta*\r
@@ -89,7 +88,7 @@
   "make defvars for names"\r
   `(progn\r
      ,@(loop for x in names\r
-           collect `(defvar ,x))))\r
+           collect `(defvar ,x nil))))\r
 \r
 ;;SECTION 2: Global parameters and definitions\r
 \r
@@ -359,7 +358,7 @@ word in dictionary, add it."
 \r
 (defun give (obj &rest flags) \r
   "Informish synonim to add-flags." \r
-  (setf (flags obj) (combine-flags (append (flags obj) flags))))\r
+  (setf (flags obj) (combine-flags (append (flags obj) flags)))  nil)\r
 \r
 (defun has (obj &rest flags)\r
   "Informish macro has. Unlike Inform, can accept several flags."\r
@@ -478,6 +477,17 @@ word in dictionary, add it."
     (glance (apply #'read-property-string (slot-value self property) args))\r
     (t (slot-value self property))))\r
 \r
+(defun read-property- (method self property &rest args)\r
+  "read-property using specific method. method is one of keywords:\r
+   :string :number :object :integer :"\r
+  (case method\r
+    (:string (apply #'read-property-string (slot-value self property) args))\r
+    (:number (apply #'read-property-string (slot-value self property) args))\r
+    (:integer (apply #'read-property-string (slot-value self property) args))\r
+    (:object (apply #'read-property-string (slot-value self property) args))\r
+    (:execute (apply #'read-property-string (slot-value self property) args))\r
+    (:list (apply #'read-property-string (slot-value self property) args))\r
+    (t (slot-value self property))))\r
 \r
 ;;SECTION 7: IfClass macro and its hairy surroundings\r
 \r

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

diff --git a/verbs.lisp b/verbs.lisp
index 406e6e622cd97a8f54944323745ea3541fa5ff42..74979be0a564674a7003f12697854f29cab2bcaf 100644 (file)
--- a/verbs.lisp
+++ b/verbs.lisp
@@ -45,7 +45,7 @@
    \r
 (const-fun const-loc (c) *location*)\r
 \r
-(verb "look"\r
+(verb "look" "l"\r
       `(-> look const-loc)\r
       '("at" :seen -> examine))\r
 \r