aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Pouar <pouar@pouar.net>2020-08-13 13:47:26 -0500
committerGravatar Pouar <pouar@pouar.net>2020-08-13 14:03:25 -0500
commit25279f7e781e58af62329ab6f24f7a8568b00863 (patch)
tree125212ccfaddd52c28862f0107e17063f949a005
parentapi change (diff)
yet another mega commit that should probably be split up but eh
-rw-r--r--core/bin/world.lisp57
-rw-r--r--core/classes.lisp195
-rw-r--r--core/libexec/conditions.lisp14
-rw-r--r--core/libexec/functions.lisp46
-rw-r--r--core/libexec/generic-functions.lisp173
-rw-r--r--core/libexec/macros.lisp55
-rw-r--r--core/libexec/methods.lisp96
-rw-r--r--data/items/consumable.lisp21
-rw-r--r--data/items/misc.lisp18
-rw-r--r--data/map/bandits-domain.lisp3
-rw-r--r--data/map/home.lisp2
-rw-r--r--data/map/secret-underground.lisp12
-rw-r--r--data/props/base.lisp12
-rw-r--r--data/props/props/beds.lisp13
-rw-r--r--data/props/props/toilets.lisp5
-rw-r--r--data/props/props/washers.lisp2
-rw-r--r--data/props/toilets.lisp3
-rw-r--r--data/props/washers.lisp2
-rw-r--r--packages.lisp71
-rw-r--r--yadfa.asd5
20 files changed, 473 insertions, 332 deletions
diff --git a/core/bin/world.lisp b/core/bin/world.lisp
index 4005b56..5fff2e4 100644
--- a/core/bin/world.lisp
+++ b/core/bin/world.lisp
@@ -43,6 +43,35 @@ You can also specify multiple directions, for example @code{(move :south :south)
(format t "~a" error)
(return-from yadfa-world:move))
(move-to-zone new-position :direction direction :old-position old-position)))))
+(defunassert yadfa-world:place-prop (prop indicator)
+ (prop (or unsigned-byte type-specifier) indicator symbol)
+ (let ((position (position-of (player-of *game*))))
+ (handle-user-input ((selected-prop (s:dispatch-case ((prop (or unsigned-byte type-specifier)))
+ ((unsigned-byte) (nth prop (inventory-of (player-of *game*))))
+ ((type-specifier) (find prop (inventory-of (player-of *game*)) :test (lambda (o e)
+ (typep e o)))))))
+ (*query-io* ((typep selected-prop '(not placable-prop))
+ (prop)
+ :prompt-text "Enter a different prop, either as a type specifier or an index of your inventory"
+ :error-text "Either that prop doesn't exist or it isn't placable")
+ ((or (not (eq (symbol-package indicator) (find-package :yadfa-user))) (getf (props-of (get-zone position)) indicator))
+ (indicator)
+ :prompt-text "Enter the property indicator for the prop you want to place"
+ :error-text "Either there's already a prop there or you picked a symbol that's not in the YADFA-USER package as the property indicator"))
+ (a:deletef (inventory-of (player-of *game*)) selected-prop :count 1 :test 'eq)
+ (setf (getf (props-of (get-zone position)) indicator) selected-prop)
+ selected-prop)))
+(defunassert yadfa-world:take-prop (indicator)
+ (indicator symbol)
+ (let ((position (position-of (player-of *game*))))
+ (handle-user-input ((selected-prop (getf (props-of (get-zone position)) indicator)))
+ (*query-io* ((and #-sbcl (symbolp indicator) (typep selected-prop '(not placable-prop)))
+ (indicator)
+ :prompt-text "Enter the property indicator for the prop you want to take"
+ :error-text "Either there's already a prop there, the prop you picked isn't a YADFA:PLACABLE-PROP or the property indicator you picked is not a symbol"))
+ (remf (props-of (get-zone position)) indicator)
+ (push selected-prop (inventory-of (player-of *game*)))
+ selected-prop)))
(defunassert yadfa-world:interact (prop &rest keys &key list take action describe-action describe &allow-other-keys)
(action (or keyword null)
describe-action (or keyword null)
@@ -239,7 +268,6 @@ You can also specify multiple directions, for example @code{(move :south :south)
(find item (inventory-of (player-of *game*))
:test #'(lambda (type-specifier obj)
(typep obj type-specifier))))))
- ret
(allies-length (list-length (allies-of *game*))))
(*query-io* ((null selected-item)
(item)
@@ -249,15 +277,26 @@ You can also specify multiple directions, for example @code{(move :south :south)
(user)
:prompt-text "Enter a different user"
:error-text (format nil "You only have ~d allies" allies-length)))
- (incf (time-of *game*))
(let ((this-user (if user (nth user (allies-of *game*)) (player-of *game*))))
- (setf ret (apply #'use-item% selected-item (player-of *game*)
- :target this-user
- keys))
- (process-potty)
- (iter (for i in (allies-of *game*))
- (process-potty i))
- ret)))
+ (handler-case (progn
+ (multiple-value-bind (cant-use plist) (apply 'cant-use-p selected-item (player-of *game*) this-user (getf keys :action) keys)
+ (when cant-use
+ (destructuring-bind (&key format-control format-arguments &allow-other-keys) plist
+ (if format-control
+ (apply 'format t format-control format-arguments)
+ (write-line "You can't do that with that item"))
+ (fresh-line)
+ (return-from yadfa-world:use-item))))
+ (let ((ret (apply #'use-item% selected-item (player-of *game*)
+ :target this-user
+ keys)))
+ (incf (time-of *game*))
+ (process-potty)
+ (iter (for i in (allies-of *game*))
+ (process-potty i))
+ ret))
+ (unusable-item (c)
+ (princ c))))))
(defunassert yadfa-world:reload (ammo-type &optional user)
(ammo-type (and type-specifier (not null))
user (or unsigned-byte null))
diff --git a/core/classes.lisp b/core/classes.lisp
index a9b1d13..4051651 100644
--- a/core/classes.lisp
+++ b/core/classes.lisp
@@ -24,33 +24,6 @@
(defmethod c2mop:validate-superclass ((class standard-class) (superclass element-type-class))
(error 'simple-error :format-control "Either you didn't use ~s to define ~s or you tried to inherit a class not defined with ~s" :format-arguments `(define-type ,(class-name class) define-type)))
(defclass element-type () () (:metaclass element-type-class))
-(defmethod print-object ((o element-type) s)
- (let ((class (slot-value (class-of o) 'name)))
- (if class
- (print-unreadable-object-with-prefix (o s :type t :identity t)
- (write class :stream s))
- (call-next-method))))
-(defmethod print-object ((o element-type-class) s)
- (let ((class (slot-value o 'name)))
- (if class
- (print-unreadable-object-with-prefix (o s :type t :identity nil)
- (f:fmt s (:s class) " " (:s (class-name o))))
- (call-next-method))))
-(defgeneric coerce-element-type (element)
- (:method ((element-type (eql nil)))
- nil)
- (:method ((element-type symbol))
- (make-instance element-type))
- (:method ((element-type element-type))
- element-type))
-(defgeneric type-match (source target)
- (:documentation "Used to determine the effectiveness of element type @var{SOURCE} against element type @var{TARGET}. Valid return values are @code{NIL}, @code{:SUPER-EFFECTIVE}, @code{:NOT-VERY-EFFECTIVE}, and @code{:NO-EFFECT}, which represent the effectiveness")
- (:method (source target) (type-match (coerce-element-type source) (coerce-element-type target)))
- (:method ((source element-type) (target element-type)) nil)
- (:method ((source (eql nil)) target)
- nil)
- (:method (source (target (eql nil)))
- nil))
(defclass element-type-mixin ()
((element-types
:accessor element-types-of
@@ -234,26 +207,6 @@
:type list
:documentation "Plist of actions that the player sees as actions with a lambda with the lambda-list @code{(item user &key &allow-other-keys)} they can perform with the item, @var{ITEM} is the instance that this slot belongs to, @var{USER} is the user using the item"))
(:documentation "Something you can store in your inventory and use"))
-(defgeneric cant-use-p (item user target action &rest keys &key &allow-other-keys)
- (:documentation "Function that is used to determine if the player can use this item")
- (:method (item user target action &rest keys &key &allow-other-keys)
- (declare (ignorable item user keys target action))
- nil))
-(define-condition unusable-item ()
- ((item :initarg :item
- :initform nil))
- (:report (lambda (condition stream)
- (format stream "~s has no ~s method defined" (slot-value condition 'item) 'use-script))))
-(defgeneric use-script (item user target)
- (:documentation "Function that runs when @var{USER} uses @var{ITEM} on @var{TARGET}. @var{ITEM} is the instance of the item and @var{USER} and @var{TARGET} are instances of base-character")
- (:method ((item item) (user base-character) (target base-character))
- (error 'unusable-item :item item)))
-(defgeneric wield-script (item user)
- (:documentation "Function that runs when @var{USER} is wielding @var{ITEM}. @var{ITEM} is the instance of the item and @var{USER} is the user you're using it on.")
- (:method ((item item) (user base-character))))
-(defgeneric wear-script (item user)
- (:documentation "Function that runs when @var{USER} is wearing @var{ITEM}. @var{ITEM} is the instance of the item and @var{USER} is the user you're using it on.")
- (:method ((item item) (user base-character))))
(defclass status-condition (yadfa-class battle-script-mixin)
((name
:initarg :name
@@ -351,50 +304,6 @@
(:documentation "Basically any move that involves messing"))
(defclass wet-move-mixin (move) ()
(:documentation "Basically any move that involves wetting"))
-(declaim (ftype (function (t t) (values &rest list)) ))
-(defmethod process-potty-dance ((character base-character) attack (item item) reload (selected-target base-character))
- (declare (ignore item reload selected-target))
- (when (process-potty-dance-check character attack)
- (format t "~a is too busy doing a potty dance to fight~%" (name-of character))
- t))
-(defmethod process-battle-accident ((character base-character) attack item reload selected-target)
- (declare (ignore attack item reload selected-target))
- (when (or (>= (bladder/contents-of character) (bladder/maximum-limit-of character))
- (>= (bowels/contents-of character) (bowels/maximum-limit-of character)))
- (when (>= (bladder/contents-of character) (bladder/maximum-limit-of character))
- (format t "~a lets out a quiet moan as ~a accidentally wets ~aself in battle~%"
- (name-of character)
- (if (malep character) "he" "she")
- (if (malep character) "him" "her"))
- (let ((wet (wet :wetter character)))
- (when (> (getf wet :leak-amount) 0)
- (f:fmt t "A puddle starts to form at " (name-of character) "'s feet" #\Newline)))
- (set-status-condition 'yadfa-status-conditions:wetting character))
- (when (>= (bladder/contents-of character) (bladder/maximum-limit-of character))
- (format t "~a instinctively squats down as ~a accidentally messes ~aself in battle~%"
- (name-of character)
- (if (malep character) "he" "she")
- (if (malep character) "him" "her"))
- (let ((mess (mess :messer character)))
- (when (> (getf mess :leak-amount) 0)
- (f:fmt t (name-of character) " starts to make a mess on the floor" #\Newline)))
- (set-status-condition 'yadfa-status-conditions:messing character))
- t))
-#.`(progn ,@(iter (for i in '("BLADDER" "BOWELS"))
- (appending (iter (for j in '("CONTENTS-OF" "FILL-RATE-OF"))
- (collect `(defmethod ,(a:format-symbol :yadfa "~a/~a" i j) ((object base-character))
- (declare (ignore object))
- 0))
- (collect `(defmethod (setf ,(a:format-symbol :yadfa "~a/~a" i j)) (newval (object base-character))
- (declare (ignore object newval))
- 0))))
- (appending (iter (for j in '("NEED-TO-POTTY-LIMIT-OF" "POTTY-DANCE-LIMIT-OF" "POTTY-DESPERATE-LIMIT-OF" "MAXIMUM-LIMIT-OF"))
- (collect `(defmethod ,(a:format-symbol :yadfa "~a/~a" i j) ((object base-character))
- (declare (ignore object))
- 1))
- (collect `(defmethod (setf ,(a:format-symbol :yadfa "~a/~a" i j)) (newval (object base-character))
- (declare (ignore object newval))
- 1))))))
(defclass bladder-character (base-character)
((bladder/contents
:initarg :bladder/contents
@@ -510,42 +419,10 @@
:wear (list (make-instance 'yadfa-items:diaper))
:moves (list (make-instance 'yadfa-moves:watersport) (make-instance 'yadfa-moves:mudsport))))
(defclass ally-no-potty-training (ally potty-character) ())
-(defmethod process-battle-accident ((character ally-no-potty-training) attack (item item) reload (selected-target base-character))
- (declare (ignore attack item reload selected-target))
- (when (>= (bladder/contents-of character) (bladder/need-to-potty-limit-of character))
- (let ((wet-status (wet :wetter character)))
- (format t "~a wet ~aself~%" (name-of character) (if (malep character) "him" "her"))
- (when (> (getf wet-status :leak-amount) 0))
- (format t "~a leaks and leaves puddles~%" (name-of character))))
- (when (and (>= (bowels/contents-of character) (bowels/need-to-potty-limit-of character)))
- (let ((mess-status (mess :messer character)))
- (format t "~a messed ~aself~%" (name-of character) (if (malep character) "him" "her"))
- (when (> (getf mess-status :leak-amount) 0))
- (format t "~a has a blowout and leaves a mess~%" (name-of character)))))
(defclass ally-rebel-potty-training (ally potty-character) ())
-(defmethod process-battle-accident ((character ally-rebel-potty-training) attack (item item) reload (selected-target ally-rebel-potty-training))
- (declare (ignore item reload))
- (cond ((and (not (typep (get-move attack character)
- 'yadfa-moves:watersport))
- (>= (bladder/contents-of character) (bladder/need-to-potty-limit-of character)))
- (let ((a (make-instance 'yadfa-moves:watersport)))
- (format t "~a: YOU DON'T HAVE ENOUGH BADGES TO TRAIN ME!~%~%" (name-of character))
- (format t "*~a uses ~a instead*~%~%" (name-of character) (name-of a))
- (attack selected-target character a))
- t)
- ((and (not (typep (get-move attack character) 'yadfa-moves:mudsport))
- (>= (bowels/contents-of character) (bowels/need-to-potty-limit-of character)))
- (let ((a (make-instance 'yadfa-moves:mudsport)))
- (format t "~a: YOU DON'T HAVE ENOUGH BADGES TO TRAIN ME!~%~%" (name-of character))
- (format t "*~a uses ~a instead*~%~%" (name-of character) (name-of a))
- (attack selected-target character a))
- t)))
(defclass ally-silent-potty-training (ally potty-trained-team-member) ())
(defclass ally-last-minute-potty-training (ally potty-trained-team-member) ())
(defclass ally-feral (ally potty-trained-team-member) ())
-(defmethod print-object ((obj ally) stream)
- (print-unreadable-object-with-prefix (obj stream :type t :identity t)
- (print-slot obj 'name stream)))
(defclass playable-ally (ally) ())
(defmethod initialize-instance :after
((c base-character) &rest initargs &key &allow-other-keys)
@@ -771,13 +648,13 @@
:initform ()
:type (or symbol list)
:accessor team-npc-spawn-list-of
- :documentation "list containing what npcs team member might show up when you enter an area. Each entry looks like this @code{(:chance chance :npc npc)} If @var{RANDOM} is specified, then the probability of the enemy being spawn is @var{CHANCE} out of 1 where @var{CHANCE} is a number between 0 and 1"))
+ :documentation "list containing what npcs team member might show up when you enter an area. Each entry looks like this @code{(:chance chance :npc npc)} If @var{RANDOM} is specified, then the probability of the enemy being spawn is @var{CHANCE} out of 1 where @var{CHANCE} is a number between 0 and 1")
+ (placable
+ :initarg :placable
+ :initform nil
+ :accessor placeablep
+ :documentation "Whether you can place items here or not"))
(:documentation "A zone on the map"))
-(defmethod print-object ((obj zone) stream)
- (print-unreadable-object-with-prefix (obj stream :type t :identity t)
- (print-slot obj 'position stream)
- (write-string " " stream)
- (print-slot obj 'name stream)))
(defclass prop (yadfa-class)
((description
:initarg :description
@@ -816,9 +693,9 @@
:type list
:documentation "Plist of actions who's lambda-list is @code{(prop &key &allow-other-keys)} that the player sees as actions they can perform with the prop, @var{PROP} is the instance that this slot belongs to"))
(:documentation "Tangible objects in the AREA that the player can interact with"))
-(defmethod print-object ((obj prop) stream)
- (print-unreadable-object-with-prefix (obj stream :type t :identity t)
- (print-slot obj 'name stream)))
+(defclass placable-prop (prop item)
+ ()
+ (:documentation "Prop that you can place"))
(defclass consumable (item)
()
(:documentation "Doesn't actually cause items to be consumable, but is there to make filtering easier"))
@@ -1111,60 +988,6 @@
:bitcoins 0
:level (random-from-range 2 5))
(:documentation "Class for enemies"))
-(defmethod process-battle-accident ((character enemy) attack (item item) reload (selected-target base-character))
- (declare (ignore attack item reload selected-target))
- (let* ((male (malep character))
- (heshe (if male "he" "she"))
- (himher (if male "him" "her"))
- (name (name-of character))
- (bladder/maximum-limit (bladder/maximum-limit-of character))
- (bowels/maximum-limit (bowels/maximum-limit-of character))
- (mudsport-limit (mudsport-limit-of character))
- (watersport-limit (watersport-limit-of character))
- (bladder/contents (bladder/contents-of character))
- (bowels/contents (bowels/contents-of character)))
- (cond ((or (>= bladder/contents bladder/maximum-limit)
- (>= bowels/contents bowels/maximum-limit))
- (when (>= bladder/contents bladder/maximum-limit)
- (format t "~a lets out a quiet moan as ~a accidentally wets ~aself in battle~%"
- name
- heshe
- himher)
- (let ((wet (wet :wetter character)))
- (when (> (getf wet :leak-amount) 0)
- (f:fmt t "A puddle starts to form at " (name-of character) "'s feet" #\Newline)))
- (set-status-condition 'yadfa-status-conditions:wetting character))
- (when (>= bowels/contents bowels/maximum-limit)
- (format t "~a involuntarily squats down as ~a accidentally messes ~aself in battle~%"
- name
- heshe
- himher)
- (let ((mess (mess :messer character)))
- (when (> (getf mess :leak-amount) 0)
- (f:fmt t (name-of character) " starts to make a mess on the floor" #\Newline)))
- (set-status-condition 'yadfa-status-conditions:messing character))
- t)
- ((and watersport-limit
- (<= (- bladder/maximum-limit (bladder/contents-of character)) watersport-limit)
- (< (random (watersport-chance-of character)) 1))
- (let ((a (make-instance 'yadfa-moves:watersport)))
- (attack (player-of *game*) character a))
- t)
- ((and mudsport-limit
- (<= (- bowels/maximum-limit (bowels/contents-of character)) mudsport-limit)
- (< (random (mudsport-chance-of character)) 1))
- (let ((a (make-instance 'yadfa-moves:mudsport)))
- (attack (player-of *game*) character a))
- t))))
-(defmethod print-object ((obj enemy) stream)
- (print-unreadable-object-with-prefix (obj stream :type t :identity t)
- (cond ((not (slot-boundp obj 'male))
- (print-slot obj 'male stream))
- ((slot-value obj 'male)
- (write "Male" :stream stream))
- (t (write "Female" :stream stream)))
- (write-string " " stream)
- (print-slot obj 'species stream)))
(defclass bladder-enemy (enemy bladder-character) ()
(:documentation "Class for an enemy with a bladder fill rate. This enemy may @{wet,mess@} @{him,her@}self in battle."))
(defclass bowels-enemy (enemy bowels-character) ()
diff --git a/core/libexec/conditions.lisp b/core/libexec/conditions.lisp
index 28d5db9..f0f6211 100644
--- a/core/libexec/conditions.lisp
+++ b/core/libexec/conditions.lisp
@@ -14,3 +14,17 @@
(:documentation "Condition signaled by @code{TOGGLE-ONESIE} when @code{(CAR CLOTHES)} is locked")
(:report (lambda (c s)
(format s "~s is locked" (car (clothes-of c))))))
+(define-condition unusable-item ()
+ ((item :initarg :item
+ :initform nil
+ :reader unusable-item-item)))
+(define-condition item-action-missing (unusable-item)
+ ((action :initarg :action
+ :initform nil
+ :reader unusable-item-action))
+ (:report (lambda (condition stream)
+ (format stream "Action ~s for ~s doesn't exist" (unusable-item-action condition) (unusable-item-item condition)))))
+(define-condition item-use-script-missing (unusable-item)
+ ()
+ (:report (lambda (condition stream)
+ (format stream "~s has no ~s method defined" (unusable-item-item condition) 'use-script))))
diff --git a/core/libexec/functions.lisp b/core/libexec/functions.lisp
index 608e135..43fa022 100644
--- a/core/libexec/functions.lisp
+++ b/core/libexec/functions.lisp
@@ -1903,6 +1903,7 @@
(type (or symbol boolean) attack)
(type type-specifier reload)
(type (or item null) item))
+ (fresh-line)
(when (and (not attack) (not item))
(write-line "You need to either specify an attack or an item to use")
(return-from process-battle))
@@ -1934,6 +1935,14 @@
(unless (or (eq attack t) (get-move attack (first (turn-queue-of *battle*))))
(format t "~a doesn't know ~a~%" (name-of (first (turn-queue-of *battle*))) attack)
(return-from process-battle))
+ (when item
+ (multiple-value-bind (cant-use plist) (cant-use-p item (car (turn-queue-of *battle*)) selected-target nil)
+ (when cant-use
+ (destructuring-bind (&key format-control format-arguments &allow-other-keys) plist
+ (if format-control
+ (apply 'format t format-control format-arguments)
+ (write-line "You can't do that with that item"))
+ (return-from process-battle)))))
(when (and (not (eq attack t)) (< (energy-of (first (turn-queue-of *battle*))) (energy-cost-of (get-move attack (first (turn-queue-of *battle*))))))
(format t "~a doesn't have enough energy to use ~a~%"
(name-of (first (turn-queue-of *battle*))) (name-of (get-move attack (first (turn-queue-of *battle*)))))
@@ -1972,26 +1981,25 @@
(bitcoins-of ally) 0)
t)
(defun use-item% (item user &rest keys &key target action &allow-other-keys)
- (let ((script (when action
- (action-lambda (getf (special-actions-of item) action))))
- (ret nil))
+ (let* ((effective-action (getf (special-actions-of item) action))
+ (script (when effective-action
+ (action-lambda effective-action))))
(unless (apply 'cant-use-p item user target action keys)
- (if action
- (if script
- (progn (setf ret (apply (coerce script 'function) item target keys))
- (when (consumablep item)
- (a:deletef (the list (inventory-of user)) item)))
- (write-line "You can't do that with that item"))
- (handler-case (progn (setf ret (use-script item user target))
- (when (consumablep item)
- (a:deletef (the list (inventory-of user)) item)))
- (unusable-item ()
- (write-line "You can't do that with that item")))))
- (when (> (health-of target) (calculate-stat target :health))
- (setf (health-of target) (calculate-stat target :health)))
- (when (> (energy-of target) (calculate-stat target :energy))
- (setf (energy-of target) (calculate-stat target :energy)))
- ret))
+ (cond ((and action effective-action)
+ (error 'item-action-missing :action action :item item))
+ ((and (not action)
+ (not (compute-applicable-methods #'use-script (list item user target))))
+ (error 'item-use-script-missing-error :format-control "~s has no ~s method defined" :format-arguments `(,item use-script))))
+ (let ((ret (if script
+ (apply (coerce script 'function) item target keys)
+ (use-script item user target))))
+ (when (consumablep item)
+ (a:deletef (the list (inventory-of user)) item))
+ (when (> (health-of target) (calculate-stat target :health))
+ (setf (health-of target) (calculate-stat target :health)))
+ (when (> (energy-of target) (calculate-stat target :energy))
+ (setf (energy-of target) (calculate-stat target :energy)))
+ ret))))
(defunassert set-player (name malep species)
(malep boolean
name simple-string
diff --git a/core/libexec/generic-functions.lisp b/core/libexec/generic-functions.lisp
index e8cf825..f12e287 100644
--- a/core/libexec/generic-functions.lisp
+++ b/core/libexec/generic-functions.lisp
@@ -1,5 +1,119 @@
;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa"; coding: utf-8-unix; -*-
(in-package :yadfa)
+(defgeneric cant-use-p (item user target action &rest keys &key &allow-other-keys)
+ (:documentation "Function that is used to determine if the player can use this item. Should return 2 values. A boolean indicating whether it can be used, and a plist. Current keys to the plist are :FORMAT-CONTROL and :FORMAT-ARGUMENTS which are used to override the usual dialog that shows up when the player selects an unusable item with their own message.")
+ (:method (item user target (action (eql nil)) &key &allow-other-keys)
+ (unless (compute-applicable-methods #'use-script (list item user target))
+ (values t `(:format-control "~s has no ~s method defined" :format-arguments (,item use-script)))))
+ (:method (item user target (action symbol) &key &allow-other-keys)
+ (unless (getf (special-actions-of item) action)
+ (values t `(:format-control "~s has no special action ~s set" :format-arguments (,item ,action))))))
+(defgeneric process-battle-accident (base-character attack item reload selected-target)
+ (:method ((character base-character) attack item reload selected-target)
+ (declare (ignore attack item reload selected-target))
+ (when (or (>= (bladder/contents-of character) (bladder/maximum-limit-of character))
+ (>= (bowels/contents-of character) (bowels/maximum-limit-of character)))
+ (when (>= (bladder/contents-of character) (bladder/maximum-limit-of character))
+ (format t "~a lets out a quiet moan as ~a accidentally wets ~aself in battle~%"
+ (name-of character)
+ (if (malep character) "he" "she")
+ (if (malep character) "him" "her"))
+ (let ((wet (wet :wetter character)))
+ (when (> (getf wet :leak-amount) 0)
+ (f:fmt t "A puddle starts to form at " (name-of character) "'s feet" #\Newline)))
+ (set-status-condition 'yadfa-status-conditions:wetting character))
+ (when (>= (bladder/contents-of character) (bladder/maximum-limit-of character))
+ (format t "~a instinctively squats down as ~a accidentally messes ~aself in battle~%"
+ (name-of character)
+ (if (malep character) "he" "she")
+ (if (malep character) "him" "her"))
+ (let ((mess (mess :messer character)))
+ (when (> (getf mess :leak-amount) 0)
+ (f:fmt t (name-of character) " starts to make a mess on the floor" #\Newline)))
+ (set-status-condition 'yadfa-status-conditions:messing character))
+ t))
+ (:method ((character ally-no-potty-training) attack (item item) reload (selected-target base-character))
+ (declare (ignore attack item reload selected-target))
+ (when (>= (bladder/contents-of character) (bladder/need-to-potty-limit-of character))
+ (let ((wet-status (wet :wetter character)))
+ (format t "~a wet ~aself~%" (name-of character) (if (malep character) "him" "her"))
+ (when (> (getf wet-status :leak-amount) 0))
+ (format t "~a leaks and leaves puddles~%" (name-of character))))
+ (when (and (>= (bowels/contents-of character) (bowels/need-to-potty-limit-of character)))
+ (let ((mess-status (mess :messer character)))
+ (format t "~a messed ~aself~%" (name-of character) (if (malep character) "him" "her"))
+ (when (> (getf mess-status :leak-amount) 0))
+ (format t "~a has a blowout and leaves a mess~%" (name-of character)))))
+ (:method ((character enemy) attack (item item) reload (selected-target base-character))
+ (declare (ignore attack item reload selected-target))
+ (let* ((male (malep character))
+ (heshe (if male "he" "she"))
+ (himher (if male "him" "her"))
+ (name (name-of character))
+ (bladder/maximum-limit (bladder/maximum-limit-of character))
+ (bowels/maximum-limit (bowels/maximum-limit-of character))
+ (mudsport-limit (mudsport-limit-of character))
+ (watersport-limit (watersport-limit-of character))
+ (bladder/contents (bladder/contents-of character))
+ (bowels/contents (bowels/contents-of character)))
+ (cond ((or (>= bladder/contents bladder/maximum-limit)
+ (>= bowels/contents bowels/maximum-limit))
+ (when (>= bladder/contents bladder/maximum-limit)
+ (format t "~a lets out a quiet moan as ~a accidentally wets ~aself in battle~%"
+ name
+ heshe
+ himher)
+ (let ((wet (wet :wetter character)))
+ (when (> (getf wet :leak-amount) 0)
+ (f:fmt t "A puddle starts to form at " (name-of character) "'s feet" #\Newline)))
+ (set-status-condition 'yadfa-status-conditions:wetting character))
+ (when (>= bowels/contents bowels/maximum-limit)
+ (format t "~a involuntarily squats down as ~a accidentally messes ~aself in battle~%"
+ name
+ heshe
+ himher)
+ (let ((mess (mess :messer character)))
+ (when (> (getf mess :leak-amount) 0)
+ (f:fmt t (name-of character) " starts to make a mess on the floor" #\Newline)))
+ (set-status-condition 'yadfa-status-conditions:messing character))
+ t)
+ ((and watersport-limit
+ (<= (- bladder/maximum-limit (bladder/contents-of character)) watersport-limit)
+ (< (random (watersport-chance-of character)) 1))
+ (let ((a (make-instance 'yadfa-moves:watersport)))
+ (attack (player-of *game*) character a))
+ t)
+ ((and mudsport-limit
+ (<= (- bowels/maximum-limit (bowels/contents-of character)) mudsport-limit)
+ (< (random (mudsport-chance-of character)) 1))
+ (let ((a (make-instance 'yadfa-moves:mudsport)))
+ (attack (player-of *game*) character a))
+ t))))
+ (:method ((character ally-rebel-potty-training) attack (item item) reload (selected-target ally-rebel-potty-training))
+ (declare (ignore item reload))
+ (cond ((and (not (typep (get-move attack character)
+ 'yadfa-moves:watersport))
+ (>= (bladder/contents-of character) (bladder/need-to-potty-limit-of character)))
+ (let ((a (make-instance 'yadfa-moves:watersport)))
+ (format t "~a: YOU DON'T HAVE ENOUGH BADGES TO TRAIN ME!~%~%" (name-of character))
+ (format t "*~a uses ~a instead*~%~%" (name-of character) (name-of a))
+ (attack selected-target character a))
+ t)
+ ((and (not (typep (get-move attack character) 'yadfa-moves:mudsport))
+ (>= (bowels/contents-of character) (bowels/need-to-potty-limit-of character)))
+ (let ((a (make-instance 'yadfa-moves:mudsport)))
+ (format t "~a: YOU DON'T HAVE ENOUGH BADGES TO TRAIN ME!~%~%" (name-of character))
+ (format t "*~a uses ~a instead*~%~%" (name-of character) (name-of a))
+ (attack selected-target character a))
+ t))))
+(defgeneric use-script (item user target)
+ (:documentation "Function that runs when @var{USER} uses @var{ITEM} on @var{TARGET}. @var{ITEM} is the instance of the item and @var{USER} and @var{TARGET} are instances of base-character"))
+(defgeneric wield-script (item user)
+ (:documentation "Function that runs when @var{USER} is wielding @var{ITEM}. @var{ITEM} is the instance of the item and @var{USER} is the user you're using it on.")
+ (:method ((item item) (user base-character))))
+(defgeneric wear-script (item user)
+ (:documentation "Function that runs when @var{USER} is wearing @var{ITEM}. @var{ITEM} is the instance of the item and @var{USER} is the user you're using it on.")
+ (:method ((item item) (user base-character))))
(defgeneric resolve-enemy-spawn-list (element)
(:documentation "returns the enemy-spawn-list in the hash table (enemy-spawn-list-of *game*) if a symbol or itself if a list")
(:method ((element symbol)) (gethash element (enemy-spawn-list-of *game*)))
@@ -70,5 +184,62 @@
(defgeneric toggle-onesie (onesie clothes user))
;;; Wish the API I made for this wasn't so complex, but I wasn't sure how to make it simple and still retain the functionality
(defgeneric get-babyish-padding (user))
-(defgeneric get-process-potty-action-type (user type had-accident))
+(defgeneric get-process-potty-action-type (user type had-accident)
+ (:method ((user ally-last-minute-potty-training) (type (eql :wet)) had-accident)
+ (cond ((and
+ (car had-accident)
+ (> (getf (car had-accident) :wet-amount) 0))
+ :had-accident)
+ ((>=
+ (bladder/contents-of user)
+ (bladder/potty-desperate-limit-of user))
+ :desparate)
+ ((>= (bladder/contents-of user) (bladder/potty-dance-limit-of user))
+ :potty-dance)))
+ (:method ((user ally-last-minute-potty-training) (type (eql :mess)) had-accident)
+ (cond ((and
+ (cdr had-accident)
+ (> (getf (cdr had-accident) :mess-amount) 0))
+ :had-accident)
+ ((>=
+ (bowels/contents-of user)
+ (bowels/potty-desperate-limit-of user))
+ :desparate)
+ ((>= (bowels/contents-of user) (bowels/potty-dance-limit-of user))
+ :potty-dance)))
+ (:method ((user ally) (type (eql :wet)) had-accident)
+ (when (and (car had-accident) (> (getf (car had-accident) :wet-amount) 0))
+ :had-accident))
+ (:method ((user ally) (type (eql :mess)) had-accident)
+ (when (and (cdr had-accident) (> (getf (cdr had-accident) :mess-amount) 0))
+ :had-accident))
+ (:method ((user player) (type (eql :wet)) had-accident)
+ (cond ((and (car had-accident) (> (getf (car had-accident) :wet-amount) 0))
+ :had-accident)
+ ((>= (bladder/contents-of user) (bladder/potty-dance-limit-of user))
+ :potty-dance)
+ ((>= (bladder/contents-of user) (bladder/need-to-potty-limit-of user))
+ :need-to-potty)))
+ (:method ((user player) (type (eql :mess)) had-accident)
+ (cond ((and (cdr had-accident) (> (getf (cdr had-accident) :mess-amount) 0))
+ :had-accident)
+ ((>= (bowels/contents-of user) (bowels/potty-dance-limit-of user))
+ :potty-dance)
+ ((>= (bowels/contents-of user) (bowels/need-to-potty-limit-of user))
+ :need-to-potty))))
(defgeneric output-process-potty-text (user padding type action had-accident &key stream))
+(defgeneric coerce-element-type (element)
+ (:method ((element-type (eql nil)))
+ nil)
+ (:method ((element-type symbol))
+ (make-instance element-type))
+ (:method ((element-type element-type))
+ element-type))
+(defgeneric type-match (source target)
+ (:documentation "Used to determine the effectiveness of element type @var{SOURCE} against element type @var{TARGET}. Valid return values are @code{NIL}, @code{:SUPER-EFFECTIVE}, @code{:NOT-VERY-EFFECTIVE}, and @code{:NO-EFFECT}, which represent the effectiveness")
+ (:method (source target) (type-match (coerce-element-type source) (coerce-element-type target)))
+ (:method ((source element-type) (target element-type)) nil)
+ (:method ((source (eql nil)) target)
+ nil)
+ (:method (source (target (eql nil)))
+ nil))
diff --git a/core/libexec/macros.lisp b/core/libexec/macros.lisp
index be2532c..fc441d5 100644
--- a/core/libexec/macros.lisp
+++ b/core/libexec/macros.lisp
@@ -2,33 +2,34 @@
(in-package :yadfa)
(defmacro handle-user-input (bindings (stream &rest forms) &body body)
"Macro used to prompt the user for input using restarts when the user enters the wrong input. @var{FORMS} is a list containing the lambda list @code{(case (&optional set-value) &key (error-text \"\") (prompt-text \"\"))}"
- (a:with-gensyms (tag)
- `(tagbody
- ,tag
- (let* ,bindings
- ,@(iter (for form in forms)
- (collect (a:with-gensyms (value)
- (destructuring-bind (case (&optional set-value) &key (error-text "") (prompt-text ""))
- form
- `(restart-case (when ,case
- (error 'invalid-user-input :format-control ,error-text))
- ,@(when set-value
- `((use-value (,value)
- :interactive (lambda ()
- (if clim:*application-frame*
- ;; For some reason McCLIM does not echo when using CL:READ on the
- ;; Listener's standard input until CL:READ returns. CLIM:ACCEPT otoh
- ;; actually does, so let's use that with McCLIM instead.
- (list (eval (clim:accept 'clim:expression
- :stream ,stream
- :prompt ,prompt-text)))
- (progn
- (format ,stream "~s: " ,prompt-text)
- (list (eval (read ,stream))))))
- :report ,prompt-text
- (setf ,set-value ,value)
- (go ,tag)))))))))
- ,@body))))
+ (a:with-gensyms (tag block)
+ `(block ,block
+ (tagbody
+ ,tag
+ (let* ,bindings
+ ,@(iter (for form in forms)
+ (collect (a:with-gensyms (value)
+ (destructuring-bind (case (&optional set-value) &key (error-text "") (prompt-text ""))
+ form
+ `(restart-case (when ,case
+ (error 'invalid-user-input :format-control ,error-text))
+ ,@(when set-value
+ `((use-value (,value)
+ :interactive (lambda ()
+ (if clim:*application-frame*
+ ;; For some reason McCLIM does not echo when using CL:READ on the
+ ;; Listener's standard input until CL:READ returns. CLIM:ACCEPT otoh
+ ;; actually does, so let's use that with McCLIM instead.
+ (list (eval (clim:accept 'clim:expression
+ :stream ,stream
+ :prompt ,prompt-text)))
+ (progn
+ (format ,stream "~s: " ,prompt-text)
+ (list (eval (read ,stream))))))
+ :report ,prompt-text
+ (setf ,set-value ,value)
+ (go ,tag)))))))))
+ (return-from ,block (progn ,@body)))))))
(defmacro defmatch (source target &body return)
(flet ((arg (arg sym)
(typecase arg
diff --git a/core/libexec/methods.lisp b/core/libexec/methods.lisp
index c0ded4a..e54697c 100644
--- a/core/libexec/methods.lisp
+++ b/core/libexec/methods.lisp
@@ -2,6 +2,58 @@
(in-package :yadfa)
(defmethod documentation ((x symbol) (doc-type (eql 'event)))
(slot-value (get-event x) 'documentation))
+(defmethod print-object ((o element-type) s)
+ (let ((class (slot-value (class-of o) 'name)))
+ (if class
+ (print-unreadable-object-with-prefix (o s :type t :identity t)
+ (write class :stream s))
+ (call-next-method))))
+(defmethod print-object ((o element-type-class) s)
+ (let ((class (slot-value o 'name)))
+ (if class
+ (print-unreadable-object-with-prefix (o s :type t :identity nil)
+ (f:fmt s (:s class) " " (:s (class-name o))))
+ (call-next-method))))
+(defmethod print-object ((obj ally) stream)
+ (print-unreadable-object-with-prefix (obj stream :type t :identity t)
+ (print-slot obj 'name stream)))
+(defmethod print-object ((obj zone) stream)
+ (print-unreadable-object-with-prefix (obj stream :type t :identity t)
+ (print-slot obj 'position stream)
+ (write-string " " stream)
+ (print-slot obj 'name stream)))
+(defmethod print-object ((obj prop) stream)
+ (print-unreadable-object-with-prefix (obj stream :type t :identity t)
+ (print-slot obj 'name stream)))
+(defmethod print-object ((obj enemy) stream)
+ (print-unreadable-object-with-prefix (obj stream :type t :identity t)
+ (cond ((not (slot-boundp obj 'male))
+ (print-slot obj 'male stream))
+ ((slot-value obj 'male)
+ (write "Male" :stream stream))
+ (t (write "Female" :stream stream)))
+ (write-string " " stream)
+ (print-slot obj 'species stream)))
+(defmethod process-potty-dance ((character base-character) attack (item item) reload (selected-target base-character))
+ (declare (ignore item reload selected-target))
+ (when (process-potty-dance-check character attack)
+ (format t "~a is too busy doing a potty dance to fight~%" (name-of character))
+ t))
+#.`(progn ,@(iter (for i in '("BLADDER" "BOWELS"))
+ (appending (iter (for j in '("CONTENTS-OF" "FILL-RATE-OF"))
+ (collect `(defmethod ,(a:format-symbol :yadfa "~a/~a" i j) ((object base-character))
+ (declare (ignore object))
+ 0))
+ (collect `(defmethod (setf ,(a:format-symbol :yadfa "~a/~a" i j)) (newval (object base-character))
+ (declare (ignore object newval))
+ 0))))
+ (appending (iter (for j in '("NEED-TO-POTTY-LIMIT-OF" "POTTY-DANCE-LIMIT-OF" "POTTY-DESPERATE-LIMIT-OF" "MAXIMUM-LIMIT-OF"))
+ (collect `(defmethod ,(a:format-symbol :yadfa "~a/~a" i j) ((object base-character))
+ (declare (ignore object))
+ 1))
+ (collect `(defmethod (setf ,(a:format-symbol :yadfa "~a/~a" i j)) (newval (object base-character))
+ (declare (ignore object newval))
+ 1))))))
(defmethod toggle-onesie (onesie clothes user)
(error 'invalid-user-input :format-control "That's not a onesie"))
(defmethod toggle-onesie ((onesie onesie/opened) clothes (user base-character))
@@ -19,48 +71,6 @@
(collect `((filter-items (wear-of user) ',i)
',i)))
(t nil)))
-(defmethod get-process-potty-action-type ((user ally-last-minute-potty-training) (type (eql :wet)) had-accident)
- (cond ((and
- (car had-accident)
- (> (getf (car had-accident) :wet-amount) 0))
- :had-accident)
- ((>=
- (bladder/contents-of user)
- (bladder/potty-desperate-limit-of user))
- :desparate)
- ((>= (bladder/contents-of user) (bladder/potty-dance-limit-of user))
- :potty-dance)))
-(defmethod get-process-potty-action-type ((user ally-last-minute-potty-training) (type (eql :mess)) had-accident)
- (cond ((and
- (cdr had-accident)
- (> (getf (cdr had-accident) :mess-amount) 0))
- :had-accident)
- ((>=
- (bowels/contents-of user)
- (bowels/potty-desperate-limit-of user))
- :desparate)
- ((>= (bowels/contents-of user) (bowels/potty-dance-limit-of user))
- :potty-dance)))
-(defmethod get-process-potty-action-type ((user ally) (type (eql :wet)) had-accident)
- (when (and (car had-accident) (> (getf (car had-accident) :wet-amount) 0))
- :had-accident))
-(defmethod get-process-potty-action-type ((user ally) (type (eql :mess)) had-accident)
- (when (and (cdr had-accident) (> (getf (cdr had-accident) :mess-amount) 0))
- :had-accident))
-(defmethod get-process-potty-action-type ((user player) (type (eql :wet)) had-accident)
- (cond ((and (car had-accident) (> (getf (car had-accident) :wet-amount) 0))
- :had-accident)
- ((>= (bladder/contents-of user) (bladder/potty-dance-limit-of user))
- :potty-dance)
- ((>= (bladder/contents-of user) (bladder/need-to-potty-limit-of user))
- :need-to-potty)))
-(defmethod get-process-potty-action-type ((user player) (type (eql :mess)) had-accident)
- (cond ((and (cdr had-accident) (> (getf (cdr had-accident) :mess-amount) 0))
- :had-accident)
- ((>= (bowels/contents-of user) (bowels/potty-dance-limit-of user))
- :potty-dance)
- ((>= (bowels/contents-of user) (bowels/need-to-potty-limit-of user))
- :need-to-potty)))
(defmethod output-process-potty-text (user padding type action had-accident &key (stream *standard-output*))
(declare (ignore user padding type action had-accident stream)))
(defmethod output-process-potty-text ((user player) padding (type (eql :wet)) (action (eql :potty-dance)) had-accident &key (stream *standard-output*))
@@ -1754,7 +1764,7 @@ randomrange is @code{(random-from-range 85 100)}"
(if (malep character) "his" "her")
(name-of (nth item (inventory-of (player-of *game*))))
(name-of selected-target))
- (use-item% (nth item (inventory-of (player-of *game*))) (player-of *game*) :target selected-target))
+ (use-item% item character :target selected-target))
(reload (format t "~a reloaded ~a ~a"
(name-of character)
(if (malep character)
diff --git a/data/items/consumable.lisp b/data/items/consumable.lisp
index a88fecc..cee09c3 100644
--- a/data/items/consumable.lisp
+++ b/data/items/consumable.lisp
@@ -56,11 +56,9 @@
:description "WARNING! NOT MEANT FOR HUMAN (or furry) CONSUMPTION. Fills up your energy and your bladder."
:value 100
:consumable t))
-(defmethod cant-use-p ((item monster-energy-drink) (user base-character) (target base-character) action &rest keys &key &allow-other-keys)
- (declare (ignorable item user keys target action))
+(defmethod cant-use-p ((item monster-energy-drink) (user base-character) (target base-character) action &key &allow-other-keys)
(when (<= (health-of target) 0)
- (format t "Does ~a look conscious enough to use that?~%" (name-of target))
- t))
+ (values t `(:format-control "Does ~a look conscious enough to use that?" :format-arguments (,(name-of target))))))
(defmethod use-script ((item monster-energy-drink) (user base-character) (target base-character))
(declare (ignore item))
(incf (bladder/contents-of target) 175)
@@ -84,13 +82,10 @@
(+ (bowels/contents-of target) (bowels/potty-dance-limit-of target)))))
(defclass consious-mixin (item) ())
(defmethod cant-use-p ((item consious-mixin) (user base-character) (target base-character) action &key &allow-other-keys)
- (declare (ignorable item user action))
(when (<= (health-of target) 0)
- (format t "Does ~a look conscious enough to use that?~%" (name-of target))
- t)
+ (values t `(:format-control "Does ~a look conscious enough to use that?" :format-arguments (,(name-of target)))))
(when (>= (health-of target) (calculate-stat target :health))
- (format t "~a's health is already full~%" (name-of target))
- t))
+ (values t `(:format-control "~a's health is already full" :format-arguments (,(name-of target))))))
(defclass potion (consious-mixin consumable) ()
(:default-initargs
:name "Potion"
@@ -107,10 +102,8 @@
:value 500
:consumable t))
(defmethod cant-use-p ((item revive) (user base-character) (target base-character) action &key &allow-other-keys)
- (declare (ignorable item user target action))
(when (> (health-of target) 0)
- (format t "Does ~a look unconscious to you?~%" (name-of target))
- t))
+ (values t `(:format-control "Does ~a look unconscious to you?~%" :format-arguments (,(name-of target))))))
(defmethod use-script ((item revive) (user base-character) (target base-character))
(declare (ignore item))
(incf (health-of target) 20))
@@ -140,10 +133,8 @@
:value 200
:consumable t))
(defmethod cant-use-p ((item holy-hand-grenade) (user base-character) (target base-character) action &key &allow-other-keys)
- (declare (ignorable item user target action))
(unless *battle*
- (write-line "You can only use that in battle")
- t))
+ (values t `(:format-control "You can only use that in battle"))))
(defmethod use-script ((item holy-hand-grenade) (user base-character) (target base-character))
(declare (ignore item))
(if (or (and (typep target 'team-member) (cdr (team-of *game*)))
diff --git a/data/items/misc.lisp b/data/items/misc.lisp
index 9f23494..7251b09 100644
--- a/data/items/misc.lisp
+++ b/data/items/misc.lisp
@@ -103,21 +103,15 @@
:description "Use this to catch enemies"
:value 500
:power 0))
-(defmethod cant-use-p ((item enemy-catcher) (user base-character) (target base-character) action &rest keys &key &allow-other-keys)
- (declare (ignorable item user keys target action))
- (f:fmt t (name-of item) " can't be used on " (name-of user) #\Newline)
- t)
-(defmethod cant-use-p ((item enemy-catcher) (user base-character) (target yadfa-enemies:catchable-enemy) action &rest keys &key &allow-other-keys)
- (declare (ignorable item user keys target action))
+(defmethod cant-use-p ((item enemy-catcher) (user base-character) (target base-character) action &key &allow-other-keys)
+ (values t `(:format-control "~a can't be used on ~a" :format-arguments `(,(name-of item) ,(name-of target)))))
+(defmethod cant-use-p ((item enemy-catcher) (user base-character) (target yadfa-enemies:catchable-enemy) action &key &allow-other-keys)
nil)
(defclass ghost-catcher (enemy-catcher) ()
(:default-initargs
:name "Ghost Catcher"
:description "Use this to catch ghosts"))
-(defmethod cant-use-p ((item ghost-catcher) (user base-character) (target base-character) action &rest keys &key &allow-other-keys)
- (declare (ignorable item user keys target action))
- (f:fmt t (name-of item) " can't be used on " (name-of target) #\Newline)
- t)
-(defmethod cant-use-p ((item ghost-catcher) (user base-character) (target yadfa-enemies:ghost) action &rest keys &key &allow-other-keys)
- (declare (ignorable item user keys target action))
+(defmethod cant-use-p ((item ghost-catcher) (user base-character) (target base-character) action &key &allow-other-keys)
+ (values t `(:format-control "~a can't be used on ~a" :format-arguments `(,(name-of item) ,(name-of target)))))
+(defmethod cant-use-p ((item ghost-catcher) (user base-character) (target yadfa-enemies:ghost) action &key &allow-other-keys)
nil)
diff --git a/data/map/bandits-domain.lisp b/data/map/bandits-domain.lisp
index bb55200..941009d 100644
--- a/data/map/bandits-domain.lisp
+++ b/data/map/bandits-domain.lisp
@@ -145,7 +145,8 @@
(yadfa-items:ak47)
(yadfa-items:box-of-7.62×39mm)
(yadfa-items:pink-sword)
- (yadfa-items:toddler-dress)))
+ (yadfa-items:toddler-dress)
+ (yadfa-props:placable-bed)))
:changing-table (make-instance 'yadfa-props:automatic-changing-table)
:bed (make-instance 'yadfa-props:bed)
:checkpoint (make-instance 'yadfa-props:checkpoint))
diff --git a/data/map/home.lisp b/data/map/home.lisp
index 42c07d2..2579304 100644
--- a/data/map/home.lisp
+++ b/data/map/home.lisp
@@ -4,6 +4,7 @@
:name "Bedroom"
:description "Your house only has a bedroom and a bathroom. Because Pouar was too lazy to code you a real house."
:enter-text "You enter your bedroom."
+ :placable t
:props (list :bed (make-instance 'yadfa-props:bed
:name "Your bed"
:description "Pouar wasn't sure what design to put on the sheets, so he decided to leave that up to the player's interpretation.")
@@ -17,6 +18,7 @@
:name "Bathroom"
:description "Your bathroom"
:enter-text "You enter the bathroom"
+ :placable t
:props (list :toilet (make-instance 'yadfa-props:toilet
:name "Toilet"
:description "You can use this so you don't wet or mess yourself")
diff --git a/data/map/secret-underground.lisp b/data/map/secret-underground.lisp
index 9c916be..ff55ff4 100644
--- a/data/map/secret-underground.lisp
+++ b/data/map/secret-underground.lisp
@@ -13,10 +13,10 @@
:enter-text "You're wandering around in the secret underground")
(ensure-zone (-1 1 0 secret-underground)
:name "Secret Underground Base"
- :description "A path"
+ :description "A place where you can rest"
:enter-text "You're wandering around in the secret underground"
+ :placable t
:props (list :changing-table (make-instance 'yadfa-props:automatic-changing-table)
- :bed (make-instance 'yadfa-props:bed)
:chest (make-instance 'prop
:name "Dresser"
:placeable t
@@ -41,6 +41,8 @@
(inventory-of (player-of *game*)))))))))
(ensure-zone (1 1 0 secret-underground)
:name "Secret Underground Shop"
- :description "This place has everything"
- :enter-text "You're inside the secret underground shop"
- :props (list :shop (make-instance 'yadfa-props:debug-shop)))
+ :description "A shop where you can buy stuff. Be sure to buy a training potty for your base. You don't want to have an accident now do you?"
+ :enter-text "You enter the shop"
+ :props (list :shop (make-instance 'yadfa-props:shop
+ :items-for-sale '((yadfa-props:pet-bed)
+ (yadfa-props:training-potty)))))
diff --git a/data/props/base.lisp b/data/props/base.lisp
index 161640b..6d386f2 100644
--- a/data/props/base.lisp
+++ b/data/props/base.lisp
@@ -1,3 +1,4 @@
+;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa-props"; coding: utf-8-unix; -*-
(in-package :yadfa-props)
(defun change-the-baby (user &rest new-diaper)
(let ((b (apply #'make-instance new-diaper)))
@@ -53,6 +54,13 @@
(nth ally (allies-of *game*))
(player-of *game*))))))))
(:documentation "Class for toilets. I'm pretty sure I don't need to tell you what these are for."))
+(defclass placable-toilet (placable-prop toilet) ())
+(defmethod cant-use-p ((item placable-toilet) (user base-character) (target base-character) action &key &allow-other-keys)
+ (values t (if *battle*
+ '(:format-control "That can't be used in a battle")
+ '(:format-control #.(f:fmt nil "YOU CAN'T USE DA POTTY HERE!!! THERE ARE LIKE, PEOPLE HERE!!!!!~%"
+ "You're just going to have to hold it until you find an appropriate place to put it~%"
+ "or you can just wet and/or mess your pamps like the bab you are.~%")))))
(defclass washer (prop) ()
(:default-initargs
:name "Washer"
@@ -65,7 +73,8 @@
#-sbcl (check-type prop prop)
(yadfa-world:wash-all-in prop)))))
(:documentation "Class for washers, you can wash your diapers and all the clothes you've ruined in these."))
-
+(defclass placable-washer (placable-prop washer)
+ ())
(defclass automatic-changing-table (prop) ()
(:default-initargs
:name "Automatic Changing Table"
@@ -284,3 +293,4 @@
#-sbcl (check-type prop prop)
(go-to-sleep)))))
(:documentation "Class for beds, you can sleep in these."))
+(defclass placable-bed (placable-prop bed) ())
diff --git a/data/props/props/beds.lisp b/data/props/props/beds.lisp
new file mode 100644
index 0000000..6835286
--- /dev/null
+++ b/data/props/props/beds.lisp
@@ -0,0 +1,13 @@
+;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa-props"; coding: utf-8-unix; -*-
+(in-package :yadfa-props)
+(defclass pet-bed (placable-bed) ()
+ (:default-initargs :name "Pet Bed"
+ :description "A portable pet bed big enough for you to sleep in"))
+(defmethod use-script ((item pet-bed) (user base-character) (target team-member))
+ (go-to-sleep))
+(defmethod cant-use-p ((item pet-bed) (user base-character) (target base-character) action &key &allow-other-keys)
+ (when *battle*
+ (values t '(:format-control "that item can't be used in battle"))))
+(defclass crib (placable-bed) ()
+ (:default-initargs :name "Crib"
+ :description "A crib big enough for you to sleep in"))
diff --git a/data/props/props/toilets.lisp b/data/props/props/toilets.lisp
new file mode 100644
index 0000000..1e99dfd
--- /dev/null
+++ b/data/props/props/toilets.lisp
@@ -0,0 +1,5 @@
+;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa-props"; coding: utf-8-unix; -*-
+(in-package :yadfa-props)
+(defclass training-potty (placable-toilet) ()
+ (:default-initargs :name "Training Potty"
+ :description "A training potty"))
diff --git a/data/props/props/washers.lisp b/data/props/props/washers.lisp
new file mode 100644
index 0000000..4b1e8f6
--- /dev/null
+++ b/data/props/props/washers.lisp
@@ -0,0 +1,2 @@
+;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa-props"; coding: utf-8-unix; -*-
+(in-package :yadfa-props)
diff --git a/data/props/toilets.lisp b/data/props/toilets.lisp
deleted file mode 100644
index ee28eed..0000000
--- a/data/props/toilets.lisp
+++ /dev/null
@@ -1,3 +0,0 @@
-;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa"; coding: utf-8-unix; -*-
-(in-package :yadfa-props)
-
diff --git a/data/props/washers.lisp b/data/props/washers.lisp
deleted file mode 100644
index fa1045f..0000000
--- a/data/props/washers.lisp
+++ /dev/null
@@ -1,2 +0,0 @@
-;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa"; coding: utf-8-unix; -*-
-(in-package :yadfa-props)
diff --git a/packages.lisp b/packages.lisp
index 1488a32..46171aa 100644
--- a/packages.lisp
+++ b/packages.lisp
@@ -155,6 +155,7 @@
#:mess-move-mixin
#:wet-move-mixin
#:prop
+ #:placable-prop
#:item
#:consumable
#:ammo
@@ -200,8 +201,6 @@
#:stairs-of
#:element-types-of
#:last-process-potty-time-of
- #:process-battle-accident-of
- #:process-potty-dance-of
#:blocks-turn-of
#:duration-of
#:stat-delta-of
@@ -321,13 +320,49 @@
(:local-nicknames (:s :serapeum) (:a :alexandria) (:u :ugly-tiny-infix-macro) (:g :global-vars)
(:c :clim) (:ce :clim-extensions) (:cc :conditional-commands) (:ms :marshal) (:f :fmt)))
(uiop:define-package :yadfa-bin
- (:export #:lst #:wear #:unwear #:get-stats #:toggle-onesie #:toss #:toggle-full-repl #:wield #:unwiled #:pokedex #:toggle-lock #:change #:wield #:unwield #:enable-mods #:disable-mods #:reload-files #:get-inventory-of-type)
+ (:export #:lst
+ #:wear
+ #:unwear
+ #:get-stats
+ #:toggle-onesie
+ #:toss
+ #:toggle-full-repl
+ #:wield
+ #:unwiled
+ #:pokedex
+ #:toggle-lock
+ #:change
+ #:wield
+ #:unwield
+ #:enable-mods
+ #:disable-mods
+ #:reload-files
+ #:get-inventory-of-type)
(:documentation "Commands that the player can run anytime"))
(uiop:define-package :yadfa-world
- (:export #:move #:interact #:save-game #:load-game #:go-potty #:tickle #:wash-all-in #:use-item #:add-ally-to-team #:remove-ally-from-team #:swap-team-member #:stats #:place #:reload)
+ (:export #:move
+ #:interact
+ #:save-game
+ #:load-game
+ #:go-potty
+ #:tickle
+ #:wash-all-in
+ #:use-item
+ #:add-ally-to-team
+ #:remove-ally-from-team
+ #:swap-team-member
+ #:stats
+ #:place
+ #:reload
+ #:place-prop
+ #:take-prop)
(:documentation "contains the commands when in the open world (assuming that's what it's called) (and not in something like a battle). The player probably shouldn't call these with the package prefix unless they're developing"))
(uiop:define-package :yadfa-battle
- (:export #:fight #:run #:use-item #:stats #:reload)
+ (:export #:fight
+ #:run
+ #:use-item
+ #:stats
+ #:reload)
(:documentation "Contains the commands used when battling. The player probably shouldn't call these with the package prefix unless they're developing"))
(uiop:define-package :yadfa-moves
(:shadow #:pants)
@@ -518,8 +553,25 @@
(:c :clim) (:ce :clim-extensions) (:cc :conditional-commands) (:f :fmt)))
(uiop:define-package :yadfa-element-types
(:use :cl :yadfa :yadfa-util :iterate)
- (:export #:normal #:fighting #:flying #:poison #:ground #:rock #:bug #:ghost #:steel #:fire #:water
- #:grass #:electric #:psychic #:ice #:dragon #:dark #:fairy #:abdl)
+ (:export #:normal
+ #:fighting
+ #:flying
+ #:poison
+ #:ground
+ #:rock
+ #:bug
+ #:ghost
+ #:steel
+ #:fire
+ #:water
+ #:grass
+ #:electric
+ #:psychic
+ #:ice
+ #:dragon
+ #:dark
+ #:fairy
+ #:abdl)
(:documentation "Element types")
(:local-nicknames (:s :serapeum) (:a :alexandria) (:u :ugly-tiny-infix-macro) (:g :global-vars)
(:c :clim) (:ce :clim-extensions) (:cc :conditional-commands) (:f :fmt)))
@@ -567,6 +619,11 @@
#:vending-machine
#:debug-shop
#:bed
+ #:placable-bed
+ #:placable-toilet
+ #:placable-washer
+ #:pet-bed
+ #:training-potty
#:items-for-sale-of)
(:documentation "Contains all the enemies in the game")
(:local-nicknames (:s :serapeum) (:a :alexandria) (:u :ugly-tiny-infix-macro) (:g :global-vars)
diff --git a/yadfa.asd b/yadfa.asd
index 0625ccd..536393b 100644
--- a/yadfa.asd
+++ b/yadfa.asd
@@ -56,7 +56,10 @@
:components ((:file "allies") (:file "catchables")))
(:module "props"
:depends-on ("items" "enemies" "team-members" "prolog")
- :components ((:file "base") (:file "toilets") (:file "washers")))
+ :components ((:file "base")
+ (:module "props"
+ :depends-on ("base")
+ :components ((:file "toilets") (:file "washers") (:file "beds")))))
(:module "events"
:depends-on ("moves" "items" "enemies" "team-members" "props" "prolog")
:components ((:file "bandits-domain") (:file "base") (:file "debug") (:file "dirty-chasm")