From: grue <grue@mail.ru>
Date: Thu, 9 Feb 2006 21:24:44 +0000 (+0000)
Subject: official update
X-Git-Url: https://jxself.org/git/?p=lifp.git;a=commitdiff_plain;h=9356b489df2d529f843e4143e8b9528b4d64e186

official update

darcs-hash:5d219fd9d81a39d3a8e70d84d447180193a505fd
---

diff --git a/if.lisp b/if.lisp
index 08d5038..6a0a3c2 100644
--- a/if.lisp
+++ b/if.lisp
@@ -36,10 +36,9 @@
            :addword :word2dic :addword2dic
            :split-to-words :sprint
            :parser :description :article :glance 
-           :initnames :addnames
-           :read-property :read-property-string :read-property-number
-           :read-property-integer :read-property-object :read-property-execute
-           :read-property-other :read-property-list :exec :exec*
+           :initnames :addnames 
+           :read-property :rp :read-property- 
+           :exec :exec*
            :abstractobject :name :names :parent :children :flags
            :initflags :add-flags :has :hasnt :-> :give
            :ifclass :object :defaction :*meta*
@@ -89,7 +88,7 @@
   "make defvars for names"
   `(progn
      ,@(loop for x in names
-	    collect `(defvar ,x))))
+	    collect `(defvar ,x nil))))
 
 ;;SECTION 2: Global parameters and definitions
 
@@ -359,7 +358,7 @@ word in dictionary, add it."
 
 (defun give (obj &rest flags) 
   "Informish synonim to add-flags." 
-  (setf (flags obj) (combine-flags (append (flags obj) flags))))
+  (setf (flags obj) (combine-flags (append (flags obj) flags)))  nil)
 
 (defun has (obj &rest flags)
   "Informish macro has. Unlike Inform, can accept several flags."
@@ -478,6 +477,17 @@ word in dictionary, add it."
     (glance (apply #'read-property-string (slot-value self property) args))
     (t (slot-value self property))))
 
+(defun read-property- (method self property &rest args)
+  "read-property using specific method. method is one of keywords:
+   :string :number :object :integer :"
+  (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))
+    (t (slot-value self property))))
 
 ;;SECTION 7: IfClass macro and its hairy surroundings
 
diff --git a/iflib.lisp b/iflib.lisp
index 8ed9480..e9145fb 100644
--- a/iflib.lisp
+++ b/iflib.lisp
@@ -37,10 +37,11 @@
 	   :reset-scope :look :words2dic-first :disambig :normal-token-scope
 	   :input-quit-loop :quit-game :prompt :prompt-read :input-loop-step
 	   :go-to-room :property :init :test-seq
-	   :heldp :the-name :each-turn
+	   :heldp :the-name :each-turn :daemon :time-left :time-out
+           :start-daemon :stop-daemon :start-timer :stop-timer           
 	   :supporter :animate :scenery
 	   :afterlife :print-gamestate :end-game
-	   :repl-mode :compile-lib 
+	   :repl-mode :compile-lib :free-symbol 
 	   )
   (:shadow :room))
 
@@ -256,7 +257,7 @@
 (defun print-property (obj property)
   "Print a property of object"
   (multiple-value-bind (value printp) (read-property obj property)
-    (if (and (stringp value) (not printp)) (sprint value) value)))
+    (if (and (stringp value) (not printp)) (progn (sprint value) t) printp)))
 
 (defgeneric print-name (obj &key article capital)
   (:documentation "Returns a string containing the name of object"))
@@ -507,11 +508,33 @@
 (supply turn-passing (&optional time)	
 	(reset-scope)
 	(incf *turns* time)
-	(loop for x in *outscope*
+	(loop for x in *allobjects*
+              if (and (has x :daemon) (provides x 'daemon))
+              do (read-property- :execute x 'daemon)
+              if (and (has x :timer) (provides x 'time-left) 
+                      (provides x 'time-out))
+              do (if (zerop (slot-value x 'time-left))
+                     (read-property- :execute x 'time-out)
+                     (decf (slot-value x 'time-left))))
+        (loop for x in *outscope*
 	      if (provides x 'each-turn)
-	      do (read-property-execute (slot-value x 'each-turn)))
+	      do (read-property- :execute x 'each-turn))           
 	(call-next-method))	     
 
+(defun start-daemon (obj)
+  (give obj :daemon))
+
+(defun stop-daemon (obj)
+  (give obj :~daemon))
+
+(defun start-timer (obj time)
+  (assert (provides obj 'time-left))
+  (setf (slot-value obj 'time-left) time)
+  (give obj :timer))
+
+(defun stop-timer (obj)
+  (give obj :~timer))
+
 (defgeneric before-special-rule (location)
   (:documentation "Runs on location before other before effects are runned")
   (:method (location) (declare (ignore location)) nil))
@@ -652,6 +675,12 @@
     (:use :common-lisp :if-basic-lib :if-lib :verb-lib ,@other-packages)
     (:shadowing-import-from :if-lib :room)
     (:shadowing-import-from :verb-lib :listen)))
+
+(defmacro free-symbol (id)
+  "Frees a symbol from current package using shadow"
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
+     (shadow ,id)))
+
    
 (defun repl-mode (&optional (mode :unspecified))
   "Flip the using of REPL for input and output (as opposed to
diff --git a/verbs.lisp b/verbs.lisp
index 406e6e6..74979be 100644
--- a/verbs.lisp
+++ b/verbs.lisp
@@ -45,7 +45,7 @@
    
 (const-fun const-loc (c) *location*)
 
-(verb "look"
+(verb "look" "l"
       `(-> look const-loc)
       '("at" :seen -> examine))