open,close
[lifp.git] / iflib.lisp
index 0098e5c2472bdbd5ea2cb261368d954fa5307073..853d89d22a1b94182d99650ab67cbc9c0a181900 100644 (file)
@@ -22,6 +22,7 @@
 (defpackage :if-lib\r
   (:use :common-lisp :if-basic-lib :if-console)\r
   (:export :container :room :item :clothing :capacity\r
+           :food :switchable\r
           :n-to :ne-to :e-to :se-to :s-to :sw-to :w-to :nw-to :in-to :out-to\r
           :u-to :d-to :cant-go\r
           :*intscope*  :*outscope* :*location* :*trace-light* :*vowels*\r
           :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
   "Turns passed since beginning of the game")\r
 \r
 (defparameter *player* nil\r
-  "Current player object (will be initialised later")\r
+  "Current player object (will be initialised later)")\r
 \r
 (declare-predicate add-to-scope add-to-outscope found-in seen-from)\r
 \r
+\r
+;;Library file names\r
+(defvar *library-file-if* "if.fas")\r
+(defvar *library-file-iflib* "iflib.fas")\r
+(defvar *library-file-verbs* "verbs.fas") \r
+\r
 ;;SECTION 2: Library-defined classes and objects\r
 \r
 (ifclass container () (capacity integer) (has :container))\r
 (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
 (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
 (defun lib (file dir)\r
   "Reloads the IF library" \r
   (format t "[DIRECTORY: ~a]~%" dir)\r
-  (print-message "Loading if.fas...")\r
-  (load (merge-pathnames dir "if.fas"))\r
-  (print-message "Loading iflib.fas...") \r
-  (load (merge-pathnames dir "iflib.fas"))\r
-  (print-message "Loading verbs.fas...") \r
-  (load (merge-pathnames dir "verbs.fas"))\r
+  (print-message "Loading if-basic-lib...")\r
+  (load (merge-pathnames dir *library-file-if*))\r
+  (print-message "Loading if-lib...") \r
+  (load (merge-pathnames dir *library-file-iflib*))\r
+  (print-message "Loading verbs...") \r
+  (load (merge-pathnames dir *library-file-verbs*))\r
   (print-message "Loading game module...") \r
   (load file)\r
   (print-message "Module is successfully loaded."))\r
 \r
-(defun test-seq (&optional (rm nil))\r
+(defun test-seq (&optional (rm *repl-mode*))\r
   "Test sequence emulating interactive fiction interpreter"\r
-  (load-cfg "iflib.cfg")\r
+  ;;(load-cfg "iflib.cfg")\r
   (setf *score* 0 \r
        *turns* 0\r
        *gamestate* 0)\r
 (defun interactive-start ()\r
   "Function intended to be used by user"\r
   (load-cfg "iflib.cfg")\r
-  (run-console #'seq #'lib :interactive t)\r
-  (when *hard-quit* (quit-lisp)))\r
+  (unless *repl-mode*\r
+    (run-console #'seq #'lib :interactive t)\r
+    (when *hard-quit* (quit-lisp))))\r
 \r
 ;;SECTION 9: Other stuff\r
 \r
   `(defpackage ,name\r
     (: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
+    (:shadowing-import-from :verb-lib :listen :fill :open :close)))\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