X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=verbs.lisp;h=7704ce39d994d9c8d6b0484e83927e91a35eb0da;hb=3c7a7c60eee66182da5b409ddd78c5349992c334;hp=406e6e622cd97a8f54944323745ea3541fa5ff42;hpb=4b3d4fbf3031334896e98a3da1dbc8820abb0c17;p=lifp.git diff --git a/verbs.lisp b/verbs.lisp index 406e6e6..7704ce3 100644 --- a/verbs.lisp +++ b/verbs.lisp @@ -16,8 +16,10 @@ :go-to :take :put-in :put-on :drop :receive :wear :strip :enter :climb :drink :eat - :rub :turn :switch-on :switch-off) - (:shadow :listen) + :rub :turn :switch-on :switch-off + :fill :empty :extract :let-go :open :close + :lock :unlock :unlock-open) + (:shadow :listen :fill :open :close) (:shadowing-import-from :if-lib :room)) (in-package :verb-lib) @@ -45,7 +47,7 @@ (const-fun const-loc (c) *location*) -(verb "look" +(verb "look" "l" `(-> look const-loc) '("at" :seen -> examine)) @@ -102,11 +104,15 @@ (verb "take" '(:noun -> take) '("off" :held -> strip) - '(:held "off" -> strip)) + '(:held "off" -> strip) + '(:noun "from" :noun -> extract) + '(:noun "from" :noun -> extract)) (verb "get" '(:noun -> take) - '((:or "in" "into" "on" "onto") :noun -> enter rest)) + '((:or "out" "off" "up") -> go-to cdir-out) + '((:or "in" "into" "on" "onto") :noun -> enter rest) + '(:noun "from" :noun -> extract)) (verb "drop" "discard" "throw" '(:held -> drop) @@ -125,7 +131,8 @@ (verb "remove" '(:held -> strip) - '(:noun -> take)) + '(:noun -> take) + '(:noun "from" :noun -> extract)) (verb "shed" "disrobe" "doff" '(:held -> strip)) @@ -164,7 +171,25 @@ '("on" :noun -> switch-on) '("off" :noun -> switch-off)) - +(verb "fill" '(:noun -> fill)) + +(verb "empty" '(:noun -> empty)) + +(verb "open" + '(:noun -> open) + '(:noun "with" :held -> unlock-open)) + +(verb "close" '(:noun -> close)) +(verb "shut" + '(:noun -> close) + '("off" :noun -> switch-off) + '(:noun "off" -> switch-off)) + +(verb "lock" + '(:noun "with" :held -> lock)) +(verb "unlock" + '(:noun "with" :held -> unlock)) + (defaction attack (obj) "Violence is not the answer.") @@ -209,9 +234,17 @@ (if (has obj :item) (if (in obj *player*) (progn (sprint "You already have ~A" (the-name obj)) t) - (progn - (move obj *player*) - (when (run-action-after obj) "Taken."))) + (if (below obj (parent *player*)) + (let ((loc (parent *player*))) + (and + (loop for x = (parent obj) + until (eql x loc) + always (run-action 'extract-silent (list obj x)) + finally (return t)) + (move obj *player*) + (run-action-after obj) + "Taken.")) + (sprint "You cannot take ~a from here." (the-name obj)))) (call-next-method))) (defaction drop (obj) @@ -230,6 +263,10 @@ ;;(format t "(~a ~a)" (print-name item) (print-name host)) (unless (has item :item) (return-from put-on "You can't get rid of that.")) (unless (has host :supporter) (return-from put-on (call-next-method))) + (when (has item :worn) + (sprint "(first removing ~a)~%" (the-name item)) + (unless (run-action 'strip item) + (return-from put-on "You can't drop it."))) (and (run-action 'receive (reverse *args*) :time 0) *after* (run-action-after item) @@ -244,6 +281,10 @@ (when (has host :closed) (return-from put-in (format nil "~a is closed." (the-name host :capital t)))) + (when (has item :worn) + (sprint "(first removing ~a)~%" (the-name item)) + (unless (run-action 'strip item) + (return-from put-in "You can't drop it."))) (and (run-action 'receive (reverse *args*) :time 0) *after* (run-action-after item) @@ -312,7 +353,7 @@ "This action achieves nothing.") (defaction turn (what) - "That's fixed in place") + "That's fixed in place.") (defmethod turn ((item item)) (if (has item :item) @@ -343,3 +384,129 @@ (when (run-action-after obj) "Done.")))) (call-next-method))) +(defaction fill (what) "You can't fill that.") + +(defaction empty (what) "That doesn't make sense.") + +(defmethod empty ((obj container)) + (unless (has obj :container) (return-from empty (call-next-method))) + (if (has obj :closed) + "But it is closed!" + (if (children obj) + (objectloop (in x obj) + (sprint "~a: " (print-name x)) + (run-action 'extract (list x obj))) + "It is already empty."))) + +(defaction extract (obj1 obj2 &key silent) "You can't do that.") + +(defmethod extract ((item item) (host container) &key silent) + (unless (has item :item) (return-from extract (call-next-method))) + (unless (has host :container) (return-from extract (call-next-method))) + (when (has host :closed) + (return-from extract + (format nil "~a is closed." (the-name host :capital t)))) + (and (run-action 'let-go (reverse *args*)) + *after* + (run-action-after item) + (if silent t "Done."))) + +(defmethod extract ((item item) (host supporter) &key silent) + (unless (has item :item) (return-from extract (call-next-method))) + (unless (has host :supporter) (return-from extract (call-next-method))) + (and (run-action 'let-go (reverse *args*)) + *after* + (run-action-after item) + (if silent t "Done."))) + +(defaction extract-silent (obj1 obj2) + (extract obj1 obj2 :silent t)) + +(defaction let-go (host thing) + "Something's wrong happened.") + +(defmethod let-go ((host supporter) (item item)) + (move item (parent host)) + (run-action-after host)) + +(defmethod let-go ((host container) (item item)) + (move item (parent host)) + (run-action-after host)) + +(defaction open (obj) + "You cannot open this.") + +(defmethod open ((obj container)) + (unless (and (has obj :container) (has obj :openable)) + (return-from open (call-next-method))) + (if (has obj :closed) + (if (hasnt obj :locked) + (progn + (give obj :~closed) + (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)))) + +(defaction close (obj) + "You cannot close this.") + +(defmethod close ((obj container)) + (unless (and (has obj :container) (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)))) + +(defaction lock (obj key) + "Not lockable.") + +(defmethod lock ((obj container) (key item)) + (unless (and (has obj :container) + (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)) + (if (hasnt obj :closed) + (format nil "~a is not closed." (the-name obj)) + (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 container) (key item)) + (unless (and (has obj :container) + (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)) + (if (hasnt obj :closed) + (format nil "~a is not closed." (the-name obj)) + (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 container) (key item)) + (unless (and (has obj :container) + (has obj :openable)) + (return-from unlock-open (call-next-method))) + (and (run-action 'unlock *args*) + (run-action 'open obj)))