X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=verbs.lisp;h=dae175a5644a93a7833bd3569050444561a78563;hb=2d1a6f87c4d559af53eb5e5f0fe571caf14f8b29;hp=d10da4d5242aa7c9b79e13aaa7452454e8a9b111;hpb=e4d49c347b683ad27be42750e0d9117384fb6c23;p=lifp.git diff --git a/verbs.lisp b/verbs.lisp index d10da4d..dae175a 100644 --- a/verbs.lisp +++ b/verbs.lisp @@ -13,11 +13,12 @@ (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 - :fill :empty :extract :let-go :open :close) + :fill :empty :extract :let-go :open :close + :lock :unlock :unlock-open) (:shadow :listen :fill :open :close) (:shadowing-import-from :if-lib :room)) @@ -204,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*)) @@ -328,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.") @@ -369,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))) @@ -378,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))) @@ -433,10 +443,11 @@ (run-action-after host)) (defaction open (obj) - "You cannot open this") + "You cannot open this.") -(defmethod open ((obj container)) - (unless (has obj :container) (return-from open (call-next-method))) +(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) (progn @@ -444,13 +455,67 @@ (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 (has obj :container) (return-from closed (call-next-method))) +(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 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 :capital t)) + (if (hasnt obj :closed) + (format nil "~a is not closed." (the-name obj :capital t)) + (if (with-keys obj key) + (progn + (give obj :locked) + (when (run-action-after obj) + (format nil "You lock ~a." (the-name obj)))) + (format nil "You cannot lock ~a with ~a." + (the-name obj) (the-name key)))))) + +(defaction unlock (obj key) + "There is nothing to unlock.") + +(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 :capital t)) + (if (hasnt obj :closed) + (format nil "~a is not closed." (the-name obj :capital t)) + (if (with-keys obj key) + (progn + (give obj :~locked) + (when (run-action-after obj) + (format nil "You unlock ~a." (the-name obj)))) + (format nil "You cannot unlock ~a with ~a." + (the-name obj) (the-name key)))))) + +(defaction unlock-open (obj key) + "You cannot open this.") + +(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*) + (run-action 'open obj)))