X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;ds=sidebyside;f=verbs.lisp;h=dae175a5644a93a7833bd3569050444561a78563;hb=2d1a6f87c4d559af53eb5e5f0fe571caf14f8b29;hp=7704ce39d994d9c8d6b0484e83927e91a35eb0da;hpb=0b54e760a0bb4044372a2407ee959b37952d3e4d;p=lifp.git diff --git a/verbs.lisp b/verbs.lisp index 7704ce3..dae175a 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,29 @@ (defaction go-to (dir) (let ((destination (read-property *location* (property dir)))) - (if destination (go-to-room destination) + (if destination (exec go-to-dispatch (destination) :str t) (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)) + ;(format t "go-to-dispatch: ~a~%" dest) + (unless (has dest :door) (return-from go-to-dispatch (call-next-method))) + (if (has dest :closed) (format nil "~a is closed." (the-name dest :capital t)) + (run-action 'pass (list dest)))) + +(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*)) @@ -329,6 +335,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.") @@ -370,7 +379,7 @@ (if (has obj :switchable) (progn (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.")))) (call-next-method))) @@ -379,7 +388,7 @@ (if (has obj :switchable) (progn (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.")))) (call-next-method))) @@ -436,8 +445,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) @@ -446,33 +455,33 @@ (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.") -(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 (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.") -(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))) (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) (progn (give obj :locked) @@ -484,15 +493,15 @@ (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))) (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) (progn (give obj :~locked) @@ -504,8 +513,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*)