various bugfixes + updated example
Fri Jul 28 02:43:14 PDT 2006
* various bugfixes + updated example
diff -rN -u old-lifp/EXAMPLES/lifptest.lisp new-lifp/EXAMPLES/lifptest.lisp
--- old-lifp/EXAMPLES/lifptest.lisp 2014-07-28 03:20:50.000000000 -0700
+++ new-lifp/EXAMPLES/lifptest.lisp 2014-07-28 03:20:50.000000000 -0700
@@ -5,7 +5,8 @@
(object bigroom (room) "The Big Room"
(description "This is the Big Room. It's main purpose is
to host the devices that are used to test various
- features of LIFP."))
+ features of LIFP. The door to the north leads to closet.")
+ (n-to 'closetdoor))
(object bigkey (item) "big key" bigroom
(description "This is a big key. It is probably used to
@@ -17,6 +18,15 @@
(with-keys bigkey)
(has :openable :closed :lockable :locked))
+(object closetdoor (door) "door to closet" bigroom
+ (name "door")
+ (description "The door that leads to closet")
+ (destination 'closet))
+(object closet (room) "Small Closet"
+ (description "This closet is small and dimly lit.")
+ (s-to 'bigroom))
(supply init ()
(setf *location* bigroom)
"~%~%Somehow you ended up in some big room. But hey, what do
diff -rN -u old-lifp/iflib.lisp new-lifp/iflib.lisp
--- old-lifp/iflib.lisp 2014-07-28 03:20:50.000000000 -0700
+++ new-lifp/iflib.lisp 2014-07-28 03:20:50.000000000 -0700
@@ -120,7 +120,8 @@
(look (look self)))
(has :~light))
-(ifclass door (predoor scenery) (destination object) (has :door :closed))
+(ifclass door (predoor scenery) (destination object)
+ (has :door :closed :openable))
@@ -161,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*)))
@@ -206,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*)))
@@ -327,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)
diff -rN -u old-lifp/verbs.lisp new-lifp/verbs.lisp
--- old-lifp/verbs.lisp 2014-07-28 03:20:50.000000000 -0700
+++ new-lifp/verbs.lisp 2014-07-28 03:20:50.000000000 -0700
@@ -218,7 +218,7 @@
(defmethod go-to-dispatch ((dest door))
(unless (has dest :door) (return-from go-to-dispatch (call-next-method)))
- (if (has dest :closed) (format nil "~a is closed." (the-name dest))
+ (if (has dest :closed) (format nil "~a is closed." (the-name dest :capital t))
(run-action 'pass *args*)))
(defaction pass (obj)
@@ -334,6 +334,9 @@
(defaction enter (what)
"You can't enter that.")
+(defmethod enter ((door door))
+ (go-to-dispatch door))
(defaction climb (what)
"You can't climb that.")
@@ -375,7 +378,7 @@
(if (has obj :switchable)
(if (has obj :on)
- (format nil "~a is already on." (the-name obj))
+ (format nil "~a is already on." (the-name obj :capital t))
(progn (give obj :on)
(when (run-action-after obj) "Done."))))
@@ -384,7 +387,7 @@
(if (has obj :switchable)
(if (hasnt obj :on)
- (format nil "~a is already off." (the-name obj))
+ (format nil "~a is already off." (the-name obj :capital t))
(progn (give obj :~on)
(when (run-action-after obj) "Done."))))
@@ -451,7 +454,7 @@
(when (run-action-after obj)
(format nil "You open ~a." (the-name obj))))
"It's locked.")
- (format nil "~a is already open." (the-name obj))))
+ (format nil "~a is already open." (the-name obj :capital t))))
(defaction close (obj)
"You cannot close this.")
@@ -464,7 +467,7 @@
(give obj :closed)
(when (run-action-after obj)
(format nil "You close ~a." (the-name obj))))
- (format nil "~a is already closed." (the-name obj))))
+ (format nil "~a is already closed." (the-name obj :capital t))))
(defaction lock (obj key)
"Not lockable.")
@@ -475,9 +478,9 @@
(has obj :lockable))
(return-from lock (call-next-method)))
(if (has obj :locked)
- (format nil "~a is already locked." (the-name obj))
+ (format nil "~a is already locked." (the-name obj :capital t))
(if (hasnt obj :closed)
- (format nil "~a is not closed." (the-name obj))
+ (format nil "~a is not closed." (the-name obj :capital t))
(if (with-keys obj key)
(give obj :locked)
@@ -495,9 +498,9 @@
(has obj :lockable))
(return-from unlock (call-next-method)))
(if (hasnt obj :locked)
- (format nil "~a is already unlocked." (the-name obj))
+ (format nil "~a is already unlocked." (the-name obj :capital t))
(if (hasnt obj :closed)
- (format nil "~a is not closed." (the-name obj))
+ (format nil "~a is not closed." (the-name obj :capital t))
(if (with-keys obj key)
(give obj :~locked)