X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=iflib.lisp;h=4ba5b5dfde16d40b7918bf717fd7fcf78a7e8ae0;hb=f2bc208b79cb4993115ec0c9c4a9e12adcbc519b;hp=0098e5c2472bdbd5ea2cb261368d954fa5307073;hpb=de820dd6a33a9a08367f89c169df34c5b6ba3582;p=lifp.git

diff --git a/iflib.lisp b/iflib.lisp
index 0098e5c..4ba5b5d 100644
--- a/iflib.lisp
+++ b/iflib.lisp
@@ -22,11 +22,12 @@
 (defpackage :if-lib
   (:use :common-lisp :if-basic-lib :if-console)
   (:export :container :room :item :clothing :capacity
+           :food :switchable :door :predoor
 	   :n-to :ne-to :e-to :se-to :s-to :sw-to :w-to :nw-to :in-to :out-to
-	   :u-to :d-to :cant-go
+	   :u-to :d-to :cant-go :destination
 	   :*intscope*  :*outscope* :*location* :*trace-light* :*vowels*
 	   :*score* :*gamestate* :*turns* :*dark*
-           :add-to-scope :add-to-outscope :found-in :seen-from
+           :add-to-scope :add-to-outscope :found-in :seen-from :with-keys
 	   :compass :dir-n :dir-ne :dir-e :dir-se :dir-s
 	   :dir-sw :dir-w :dir-nw :dir-u :dir-d :dir-in :dir-out
 	   :darkness :lit :transparent :passable
@@ -36,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))
 
@@ -77,20 +79,28 @@
   "Turns passed since beginning of the game")
 
 (defparameter *player* nil
-  "Current player object (will be initialised later")
+  "Current player object (will be initialised later)")
 
-(declare-predicate add-to-scope add-to-outscope found-in seen-from)
+(declare-predicate add-to-scope add-to-outscope found-in seen-from
+                   with-keys)
+
+;;Library file names
+(defvar *library-file-if* "if.fas")
+(defvar *library-file-iflib* "iflib.fas")
+(defvar *library-file-verbs* "verbs.fas") 
 
 ;;SECTION 2: Library-defined classes and objects
 
-(ifclass container () (capacity integer) (has :container))
+(ifclass predoor ()) ;;Can potentially be locked... 
+
+(ifclass container (predoor) (capacity integer) (has :container))
 (ifclass supporter () (capacity integer) (has :supporter))
 
 (ifclass room () (description string)
 	 (n-to object) (ne-to object) (e-to object) (se-to object)
 	 (s-to object) (sw-to object) (w-to object) (nw-to object)
 	 (u-to object) (d-to object) (in-to object) (out-to object)
-	 (cant-go string)
+	 ;(cant-go string) <- doesn't provide by default
 	 (has :light :enterable))
 
 (ifclass item () (description string) (article string)
@@ -110,6 +120,11 @@
          (look (look self)))
 	(has :~light))
 
+(ifclass door (predoor scenery) (destination object) 
+         (has :door :closed :openable))
+
+
+
 ;;Compass directions
 (object compass ())
 (object dir-n () "north" (name "north" "n") compass (property 'n-to))
@@ -147,7 +162,7 @@
 
 (defun transparent (obj)
   "Whether the object is transparent"
-  (or (has obj :container :open) 
+  (or (and (has obj :container) (hasnt obj :closed)) 
       (has obj :supporter)
       (has obj :transparent)
       (eql obj *player*)))
@@ -192,7 +207,7 @@
       (seep1 actor obj)))
 
 (defun passable (obj)
-  (or (has obj :container :open)
+  (or (and (has obj :container) (hasnt obj :closed))
       (has obj :supporter)
       (eql obj *player*)))
 
@@ -255,7 +270,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"))
@@ -313,7 +328,7 @@
 (defun print-inside (obj stream)
   "Return the string containing the status of contents of the object"
   (when (has obj :container)
-    (if (or (has obj :open) (has obj :transparent))
+    (if (or (hasnt obj :closed) (has obj :transparent))
 	(if (children obj)
 	  (progn (princ " (containing " stream) 
 		 (princ (list-contents obj) stream) 
@@ -341,7 +356,7 @@
 
 (defun default-glance (obj)
   "Default initial description of object"
-  (format t "[Default glance for ~a]~%" obj)
+  ;;(format t "[Default glance for ~a]~%" obj)
   (sprint "~a~%" 
 	  (with-output-to-string (out)
 	    (princ "There is " out) (princ (print-name obj) out) 
@@ -506,11 +521,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))
@@ -610,19 +647,19 @@
 (defun lib (file dir)
   "Reloads the IF library" 
   (format t "[DIRECTORY: ~a]~%" dir)
-  (print-message "Loading if.fas...")
-  (load (merge-pathnames dir "if.fas"))
-  (print-message "Loading iflib.fas...") 
-  (load (merge-pathnames dir "iflib.fas"))
-  (print-message "Loading verbs.fas...") 
-  (load (merge-pathnames dir "verbs.fas"))
+  (print-message "Loading if-basic-lib...")
+  (load (merge-pathnames dir *library-file-if*))
+  (print-message "Loading if-lib...") 
+  (load (merge-pathnames dir *library-file-iflib*))
+  (print-message "Loading verbs...") 
+  (load (merge-pathnames dir *library-file-verbs*))
   (print-message "Loading game module...") 
   (load file)
   (print-message "Module is successfully loaded."))
 
-(defun test-seq (&optional (rm nil))
+(defun test-seq (&optional (rm *repl-mode*))
   "Test sequence emulating interactive fiction interpreter"
-  (load-cfg "iflib.cfg")
+  ;;(load-cfg "iflib.cfg")
   (setf *score* 0 
 	*turns* 0
 	*gamestate* 0)
@@ -639,8 +676,9 @@
 (defun interactive-start ()
   "Function intended to be used by user"
   (load-cfg "iflib.cfg")
-  (run-console #'seq #'lib :interactive t)
-  (when *hard-quit* (quit-lisp)))
+  (unless *repl-mode*
+    (run-console #'seq #'lib :interactive t)
+    (when *hard-quit* (quit-lisp))))
 
 ;;SECTION 9: Other stuff
 
@@ -650,7 +688,13 @@
   `(defpackage ,name
     (:use :common-lisp :if-basic-lib :if-lib :verb-lib ,@other-packages)
     (:shadowing-import-from :if-lib :room)
-    (:shadowing-import-from :verb-lib :listen)))
+    (:shadowing-import-from :verb-lib :listen :fill :open :close)))
+
+(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