(defpackage :if-lib\r
(:use :common-lisp :if-basic-lib :if-console)\r
(:export :container :room :item :clothing :capacity\r
- :food :switchable\r
+ :food :switchable :door :predoor\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
+ :u-to :d-to :cant-go :destination\r
:*intscope* :*outscope* :*location* :*trace-light* :*vowels*\r
:*score* :*gamestate* :*turns* :*dark*\r
- :add-to-scope :add-to-outscope :found-in :seen-from\r
+ :add-to-scope :add-to-outscope :found-in :seen-from :with-keys\r
:compass :dir-n :dir-ne :dir-e :dir-se :dir-s\r
:dir-sw :dir-w :dir-nw :dir-u :dir-d :dir-in :dir-out\r
:darkness :lit :transparent :passable\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
+(declare-predicate add-to-scope add-to-outscope found-in seen-from\r
+ with-keys)\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
+(ifclass predoor ()) ;;Can potentially be locked... \r
+\r
+(ifclass container (predoor) (capacity integer) (has :container))\r
(ifclass supporter () (capacity integer) (has :supporter))\r
\r
(ifclass room () (description string)\r
(look (look self)))\r
(has :~light))\r
\r
+(ifclass door (predoor scenery) (destination object) \r
+ (has :door :closed :openable))\r
+\r
+\r
+\r
;;Compass directions\r
(object compass ())\r
(object dir-n () "north" (name "north" "n") compass (property 'n-to))\r
\r
(defun transparent (obj)\r
"Whether the object is transparent"\r
- (or (has obj :container :open) \r
+ (or (and (has obj :container) (hasnt obj :closed)) \r
(has obj :supporter)\r
(has obj :transparent)\r
(eql obj *player*)))\r
(seep1 actor obj)))\r
\r
(defun passable (obj)\r
- (or (has obj :container :open)\r
+ (or (and (has obj :container) (hasnt obj :closed))\r
(has obj :supporter)\r
(eql obj *player*)))\r
\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
(defun print-inside (obj stream)\r
"Return the string containing the status of contents of the object"\r
(when (has obj :container)\r
- (if (or (has obj :open) (has obj :transparent))\r
+ (if (or (hasnt obj :closed) (has obj :transparent))\r
(if (children obj)\r
(progn (princ " (containing " stream) \r
(princ (list-contents obj) stream) \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
projects / lifp.git / blobdiff