From: grue Date: Thu, 27 Jul 2006 17:48:12 +0000 (+0000) Subject: implement doors X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=447a18ccfc600c416a481266ecac28cd2ecd720f;p=lifp.git implement doors darcs-hash:615125721aa5edfcd8b326f063b1899f4bb72af6 --- diff --git a/EXAMPLES/advent.lisp b/EXAMPLES/advent.lisp index e768c04..fd86b04 100644 --- a/EXAMPLES/advent.lisp +++ b/EXAMPLES/advent.lisp @@ -345,9 +345,9 @@ (description "It just looks like an ordinary grate mounted in concrete.") (key 'set-of-keys) - (door-dir + (direction (lambda () (if (eql *location* below-the-grate) 'u-to 'd-to))) - (door-to + (destination (lambda () (if (eql *location* below-the-grate) outside-grate below-the-grate))) (glance diff --git a/iflib.lisp b/iflib.lisp index cfa4d1e..dad57f5 100644 --- a/iflib.lisp +++ b/iflib.lisp @@ -22,9 +22,9 @@ (defpackage :if-lib (:use :common-lisp :if-basic-lib :if-console) (:export :container :room :item :clothing :capacity - :food :switchable + :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 :with-keys @@ -91,7 +91,9 @@ ;;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) @@ -118,6 +120,10 @@ (look (look self))) (has :~light)) +(ifclass door (predoor scenery) (destination object) (has :door :closed)) + + + ;;Compass directions (object compass ()) (object dir-n () "north" (name "north" "n") compass (property 'n-to)) diff --git a/verbs.lisp b/verbs.lisp index 7704ce3..39c66af 100644 --- a/verbs.lisp +++ b/verbs.lisp @@ -13,7 +13,7 @@ (defpackage :verb-lib (:use :common-lisp :if-lib :if-basic-lib) (:export :attack :take :teleport :examine - :go-to + :go-to :pass :take :put-in :put-on :drop :receive :wear :strip :enter :climb :drink :eat :rub :turn :switch-on :switch-off @@ -205,23 +205,28 @@ (defaction go-to (dir) (let ((destination (read-property *location* (property dir)))) - (if destination (go-to-room destination) + (if destination (exec go-to-dispatch (destination)) (if (provides *location* 'cant-go) (read-property *location* 'cant-go) "You can't go here.")))) -;; (defaction go-n () (run-action 'go-to dir-n)) -;; (defaction go-ne () (run-action 'go-to dir-ne)) -;; (defaction go-e () (run-action 'go-to dir-e)) -;; (defaction go-se () (run-action 'go-to dir-se)) -;; (defaction go-s () (run-action 'go-to dir-s)) -;; (defaction go-sw () (run-action 'go-to dir-sw)) -;; (defaction go-w () (run-action 'go-to dir-w)) -;; (defaction go-nw () (run-action 'go-to dir-nw)) -;; (defaction go-u () (run-action 'go-to dir-u)) -;; (defaction go-d () (run-action 'go-to dir-d)) -;; (defaction go-in () (run-action 'go-to dir-in)) -;; (defaction go-out () (run-action 'go-to dir-out)) +(defgeneric go-to-dispatch (dest) + (:documentation "Dispatches between different kinds of goable objects")) + +(defmethod go-to-dispatch ((dest room)) + (go-to-room dest)) + +(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)) + (run-action 'pass *args*))) + +(defaction pass (obj) + "Something's wrong happened.") + +(defmethod pass ((obj door)) + (go-to-dispatch (read-property obj 'destination)) + (run-action-after obj)) (defun inventory () (sprint "You are carrying: ~a." (list-contents *player*)) @@ -436,8 +441,8 @@ (defaction open (obj) "You cannot open this.") -(defmethod open ((obj container)) - (unless (and (has obj :container) (has obj :openable)) +(defmethod open ((obj predoor)) + (unless (and (or (has obj :container) (has obj :door)) (has obj :openable)) (return-from open (call-next-method))) (if (has obj :closed) (if (hasnt obj :locked) @@ -451,8 +456,8 @@ (defaction close (obj) "You cannot close this.") -(defmethod close ((obj container)) - (unless (and (has obj :container) (has obj :openable)) +(defmethod close ((obj predoor)) + (unless (and (or (has obj :container) (has obj :door)) (has obj :openable)) (return-from close (call-next-method))) (if (hasnt obj :closed) (progn @@ -464,8 +469,8 @@ (defaction lock (obj key) "Not lockable.") -(defmethod lock ((obj container) (key item)) - (unless (and (has obj :container) +(defmethod lock ((obj predoor) (key item)) + (unless (and (or (has obj :container) (has obj :door)) (has obj :openable) (has obj :lockable)) (return-from lock (call-next-method))) @@ -484,8 +489,8 @@ (defaction unlock (obj key) "There is nothing to unlock.") -(defmethod unlock ((obj container) (key item)) - (unless (and (has obj :container) +(defmethod unlock ((obj predoor) (key item)) + (unless (and (or (has obj :container) (has obj :door)) (has obj :openable) (has obj :lockable)) (return-from unlock (call-next-method))) @@ -504,8 +509,8 @@ (defaction unlock-open (obj key) "You cannot open this.") -(defmethod unlock-open ((obj container) (key item)) - (unless (and (has obj :container) +(defmethod unlock-open ((obj predoor) (key item)) + (unless (and (or (has obj :container) (has obj :door)) (has obj :openable)) (return-from unlock-open (call-next-method))) (and (run-action 'unlock *args*)