aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Pouar <pouar@pouar.net>2020-09-23 12:12:16 -0500
committerGravatar Pouar <pouar@pouar.net>2020-09-23 12:12:16 -0500
commit0fc086b487668f8421d4080e54aaf8cecad51e7d (patch)
tree010bf91bc5e26c34af0aa275446eefea04b69ac6
parentchange the convention for initargs in mods (diff)
make more use of serapeum
found a few new functions in it
-rw-r--r--core/bin/bin.lisp8
-rw-r--r--core/libexec/functions.lisp12
-rw-r--r--core/libexec/methods.lisp4
-rw-r--r--core/util.lisp3
-rw-r--r--data/enemies/fursuiters.lisp87
-rw-r--r--data/enemies/navy.lisp151
-rw-r--r--data/enemies/pokemon.lisp11
-rw-r--r--data/enemies/raccoon-bandits.lisp123
-rw-r--r--data/enemies/rpgmaker.lisp237
-rw-r--r--data/items/consumable.lisp73
-rw-r--r--data/items/diaper.lisp44
-rw-r--r--data/items/misc.lisp18
-rw-r--r--data/items/weapons.lisp19
-rw-r--r--data/moves/pokemon.lisp27
-rw-r--r--data/moves/regular.lisp243
-rw-r--r--data/team-members/allies.lisp37
-rw-r--r--packages.lisp1
17 files changed, 561 insertions, 537 deletions
diff --git a/core/bin/bin.lisp b/core/bin/bin.lisp
index 5462fe3..7560da3 100644
--- a/core/bin/bin.lisp
+++ b/core/bin/bin.lisp
@@ -157,7 +157,7 @@
(format t "~a:~%~%" (name-of user))
(apply #'format-table '("Symbol" "Name" "Description")
(iter (for i in (moves-of user))
- (when i (collect (list (class-name (class-of i)) (name-of i) (description-of i)))))))
+ (when i (collect (list (s:class-name-of i) (name-of i) (description-of i)))))))
(format-user (user)
(format t "Name: ~a~%Species: ~a~%Description: ~a~%~%"
(name-of user)
@@ -181,9 +181,9 @@
(let ((a ()))
(iter (for i in (inventory-of (player-of *game*)))
(when (typep i inventory-group)
- (if (getf a (class-name (class-of i)))
- (incf (second (getf a (class-name (class-of i)))))
- (setf (getf a (class-name (class-of i))) (list (name-of (make-instance (class-name (class-of i)))) 1)))))
+ (if (getf a (s:class-name-of i))
+ (incf (second (getf a (s:class-name-of i))))
+ (setf (getf a (s:class-name-of i)) (list (name-of (make-instance (s:class-name-of i))) 1)))))
(apply #'format-table '("Class Name" "Name" "Quantity")
(iter (for (key value) on a by #'cddr)
(collect (apply 'list key value)))))))
diff --git a/core/libexec/functions.lisp b/core/libexec/functions.lisp
index edc9eaa..4dfe6a0 100644
--- a/core/libexec/functions.lisp
+++ b/core/libexec/functions.lisp
@@ -277,10 +277,10 @@
keys))
(format t "~a~%" (enter-battle-text-of *battle*))
(iter (for (the symbol j) in (iter (for i in (enemies-of *battle*))
- (unless (s:memq (class-name (class-of i)) (seen-enemies-of *game*))
+ (unless (s:memq (s:class-name-of i) (seen-enemies-of *game*))
(format t "~a was added to your pokedex~%" (name-of i))
- (push (class-name (class-of i)) (seen-enemies-of *game*))
- (collect (class-name (class-of i))))))
+ (push (s:class-name-of i) (seen-enemies-of *game*))
+ (collect (s:class-name-of i)))))
(yadfa-bin:pokedex j))
(switch-user-packages)
(process-battle :attack t :no-team-attack t))
@@ -1327,13 +1327,13 @@
(defun pushnewmove (move* user)
(pushnew (make-instance move*) (moves-of user)
:test (lambda (a b)
- (eq (class-name (class-of a)) (class-name (class-of b))))))
+ (eq (s:class-name-of a) (s:class-name-of b)))))
(defun get-move (move* user)
(find move* (moves-of user)
:test (lambda (a b)
(if (typep a 'keyword)
- (string= a (class-name (class-of b)))
- (eq a (class-name (class-of b)))))))
+ (string= a (s:class-name-of b))
+ (eq a (s:class-name-of b))))))
(defunassert calculate-diaper-usage (user)
(user base-character)
(iter
diff --git a/core/libexec/methods.lisp b/core/libexec/methods.lisp
index 71cad12..9baff63 100644
--- a/core/libexec/methods.lisp
+++ b/core/libexec/methods.lisp
@@ -1585,7 +1585,7 @@ randomrange is @code{(random-from-range 85 100)}"
(round (u:$ (u:$ (u:$ (u:$ (u:$ (u:$ (u:$ 2 * (level-of user)) / 5) + 2) * attack * (u:$ (calculate-stat user :attack) / (calculate-stat target :defense)))
/ 50)
+ 2)
- * (u:$ (random-from-range 85 100) / 100))))
+ * (u:$ (s:random-in-range 85 101) / 100))))
(defmethod calculate-damage ((target base-character) (user base-character) (attack move))
"Figures out the damage dealt, we use the formula
@@ -1620,7 +1620,7 @@ randomrange is @code{(random-from-range 85 100)}"
(u:$ (calculate-stat user :attack) / (calculate-stat target :defense)))
/ 50)
+ 2)
- * (* (u:$ (random-from-range 85 100) / 100)
+ * (* (u:$ (s:random-in-range 85 101) / 100)
(if (> no-effect 0)
0
(expt 2 (- super-effective not-very-effective)))
diff --git a/core/util.lisp b/core/util.lisp
index 3924429..aa6a41c 100644
--- a/core/util.lisp
+++ b/core/util.lisp
@@ -46,9 +46,6 @@ the result of calling @code{SUSTITUTE} with @var{OLD}, @var{NEW}, place, and the
remove-if/swapped-arguments
"Modify-macro for @code{REMOVE-IF}. Sets place designated by the first argument to
the result of calling @code{REMOVE-IF} with @var{TEST}, place, and the @var{KEYWORD-ARGUMENTS}.")
-(declaim (ftype (function (real real) real) random-from-range))
-(defun random-from-range (start end)
- (+ start (random (+ 1 (- end start)))))
(defun type-specifier-p (type-specifier)
"Returns true if @var{TYPE-SPECIFIER} is a valid type specifier."
#+sbcl (sb-ext:valid-type-specifier-p type-specifier)
diff --git a/data/enemies/fursuiters.lisp b/data/enemies/fursuiters.lisp
index 53595e9..0eb0ca5 100644
--- a/data/enemies/fursuiters.lisp
+++ b/data/enemies/fursuiters.lisp
@@ -9,49 +9,50 @@
:bladder/contents (random 500)
:bowels/contents (random 700)
:wear (make-instances yadfa-items:fursuit yadfa-items:kurikia-thick-diaper)))
-(defmethod process-battle-accident ((character padded-fursuiter-servant) 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")))
- (cond ((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)
- heshe
- himher)
- (wet :wetter character)
- (set-status-condition 'yadfa-status-conditions:wetting character))
- (when (>= (bowels/contents-of character) (bowels/maximum-limit-of character))
- (format t "~a involuntarily squats down as ~a accidentally messes ~aself in battle~%"
- (name-of character)
- heshe
- himher)
- (mess :messer character)
- (set-status-condition 'yadfa-status-conditions:messing character))
- t)
- ((and (watersport-limit-of character)
- (<= (- (bladder/maximum-limit-of character) (bladder/contents-of character)) (watersport-limit-of character))
- (< (random (watersport-chance-of character)) 1))
- (format t "~a floods ~aself in the middle of battle~%" (name-of character) himher)
- (wet :wetter character))
- ((and (mudsport-limit-of character)
- (<= (- (bowels/maximum-limit-of character) (bowels/contents-of character)) (mudsport-limit-of character))
- (< (random (mudsport-chance-of character)) 1))
- (format t "~a squats down and messes ~aself in the middle of battle~%" (name-of character) himher)
- (mess :messer character)))))
-(defmethod initialize-instance :after
- ((c padded-fursuiter-servant) &key (watersport-limit nil watersportp) (mudsport-limit nil mudsportp) &allow-other-keys)
- (declare (ignore watersport-limit mudsport-limit))
- (cond ((and watersportp mudsportp)
- (let ((limits (a:random-elt (list (cons (bladder/need-to-potty-limit-of c) (bowels/need-to-potty-limit-of c)) '(nil)))))
- (setf (watersport-limit-of c) (car limits) (mudsport-limit-of c) (cdr limits))))
- (watersportp
- (setf (mudsport-limit-of c) (a:random-elt (list (bowels/need-to-potty-limit-of c) nil))))
- (mudsportp
- (setf (watersport-limit-of c) (a:random-elt (list (bladder/need-to-potty-limit-of c) nil))))))
+(s:defmethods padded-fursuiter-servant (character)
+ (:method process-battle-accident (character 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")))
+ (cond ((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)
+ heshe
+ himher)
+ (wet :wetter character)
+ (set-status-condition 'yadfa-status-conditions:wetting character))
+ (when (>= (bowels/contents-of character) (bowels/maximum-limit-of character))
+ (format t "~a involuntarily squats down as ~a accidentally messes ~aself in battle~%"
+ (name-of character)
+ heshe
+ himher)
+ (mess :messer character)
+ (set-status-condition 'yadfa-status-conditions:messing character))
+ t)
+ ((and (watersport-limit-of character)
+ (<= (- (bladder/maximum-limit-of character) (bladder/contents-of character)) (watersport-limit-of character))
+ (< (random (watersport-chance-of character)) 1))
+ (format t "~a floods ~aself in the middle of battle~%" (name-of character) himher)
+ (wet :wetter character))
+ ((and (mudsport-limit-of character)
+ (<= (- (bowels/maximum-limit-of character) (bowels/contents-of character)) (mudsport-limit-of character))
+ (< (random (mudsport-chance-of character)) 1))
+ (format t "~a squats down and messes ~aself in the middle of battle~%" (name-of character) himher)
+ (mess :messer character)))))
+ (:method initialize-instance :after
+ (character &key (watersport-limit nil watersportp) (mudsport-limit nil mudsportp) &allow-other-keys)
+ (declare (ignore watersport-limit mudsport-limit))
+ (cond ((and watersportp mudsportp)
+ (let ((limits (a:random-elt (list (cons (bladder/need-to-potty-limit-of character) (bowels/need-to-potty-limit-of character)) '(nil)))))
+ (setf (watersport-limit-of character) (car limits) (mudsport-limit-of character) (cdr limits))))
+ (watersportp
+ (setf (mudsport-limit-of character) (a:random-elt (list (bowels/need-to-potty-limit-of character) nil))))
+ (mudsportp
+ (setf (watersport-limit-of character) (a:random-elt (list (bladder/need-to-potty-limit-of character) nil)))))))
(defclass fursuiter-servant (potty-enemy) ()
(:default-initargs
:name "Fursuiter Servant"
diff --git a/data/enemies/navy.lisp b/data/enemies/navy.lisp
index 7e48a53..0a999ef 100644
--- a/data/enemies/navy.lisp
+++ b/data/enemies/navy.lisp
@@ -13,81 +13,82 @@
:element-types '#.(coerce-element-types 'yadfa-element-types:water)
:inventory (iter (for i from 0 to (random 5)) (collect (make-instance 'yadfa-items:navy-pullups)))
:bitcoins-per-level 60))
-(defmethod process-battle-accident ((character navy-officer) attack (item item) reload (selected-target base-character))
- (declare (ignore attack item reload selected-target))
- (let* ((male (malep character))
- (pamps (iter (for i in (wear-of character))
- (let ((i (typecase i
- (diaper 'diaper)
- (pullup 'pullup)
- (closed-bottoms 'closed-bottoms))))
- (when i
- (leave i)))))
- (pampspronoun (if male
- (if pamps
- "his "
- "him")
- (if pamps
- "her "
- "her")))
- (pampsname (case pamps
- (diaper "diapers")
- (pullup "pullups")
- (closed-bottoms "pants")
- (t "self"))))
- (cond ((or (>= (bladder/contents-of character)
- (bladder/maximum-limit-of character))
- (>= (bowels/contents-of character) (bowels/maximum-limit-of character)))
- (let ((heshe (if male "he" "she"))
- (himher (if male "him" "her")))
- (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)
- heshe
- himher)
- (wet :wetter character)
- (set-status-condition 'yadfa-status-conditions:wetting character))
- (when (>= (bowels/contents-of character) (bowels/maximum-limit-of character))
- (format t "~a involuntarily squats down as ~a accidentally messes ~aself in battle~%"
- (name-of character)
- heshe
- himher)
- (mess :messer character)
- (set-status-condition 'yadfa-status-conditions:messing character))
- t))
- ((and (watersport-limit-of character)
- (<= (- (bladder/maximum-limit-of character) (bladder/contents-of character)) (watersport-limit-of character))
- (< (random (watersport-chance-of character)) 1))
- (format t "~a slightly blushes and lets go from the front of ~a~a and spreads ~a legs apart and floods them~%"
- (name-of character)
- pampspronoun
- pampsname
- (if male
- "his"
- "her"))
- (wet :wetter character))
- ((and (mudsport-limit-of character)
- (<= (- (bowels/maximum-limit-of character) (bowels/contents-of character)) (mudsport-limit-of character))
- (< (random (mudsport-chance-of character)) 1))
- (format t "~a slightly blushes and squats down and messes ~a~a~%"
- (name-of character)
- pampspronoun
- pampsname)
- (mess :messer character)))))
-(defmethod initialize-instance :after
- ((c navy-officer) &key (watersport-limit nil watersportp) (mudsport-limit nil mudsportp) (wear nil wearp) &allow-other-keys)
- (declare (ignore watersport-limit mudsport-limit wear))
- (unless wearp
- (push (make-instance 'yadfa-items:navy-pullups) (wear-of c))
- (when (and (not (malep c)) (= (random 5) 0))
- (push (make-instance 'yadfa-items:navy-skirt) (wear-of c)))
- (unless (malep c)
- (push (make-instance 'yadfa-items:bra) (wear-of c)))
- (push (make-instance 'yadfa-items:navy-shirt) (wear-of c)))
- (unless watersportp
- (setf (watersport-limit-of c) (- (bladder/maximum-limit-of c) (bladder/potty-desperate-limit-of c))))
- (unless mudsportp
- (setf (mudsport-limit-of c) (- (bowels/maximum-limit-of c) (bowels/potty-desperate-limit-of c)))))
+(s:defmethods navy-officer (character)
+ (:method process-battle-accident (character attack (item item) reload (selected-target base-character))
+ (declare (ignore attack item reload selected-target))
+ (let* ((male (malep character))
+ (pamps (iter (for i in (wear-of character))
+ (let ((i (typecase i
+ (diaper 'diaper)
+ (pullup 'pullup)
+ (closed-bottoms 'closed-bottoms))))
+ (when i
+ (leave i)))))
+ (pampspronoun (if male
+ (if pamps
+ "his "
+ "him")
+ (if pamps
+ "her "
+ "her")))
+ (pampsname (case pamps
+ (diaper "diapers")
+ (pullup "pullups")
+ (closed-bottoms "pants")
+ (t "self"))))
+ (cond ((or (>= (bladder/contents-of character)
+ (bladder/maximum-limit-of character))
+ (>= (bowels/contents-of character) (bowels/maximum-limit-of character)))
+ (let ((heshe (if male "he" "she"))
+ (himher (if male "him" "her")))
+ (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)
+ heshe
+ himher)
+ (wet :wetter character)
+ (set-status-condition 'yadfa-status-conditions:wetting character))
+ (when (>= (bowels/contents-of character) (bowels/maximum-limit-of character))
+ (format t "~a involuntarily squats down as ~a accidentally messes ~aself in battle~%"
+ (name-of character)
+ heshe
+ himher)
+ (mess :messer character)
+ (set-status-condition 'yadfa-status-conditions:messing character))
+ t))
+ ((and (watersport-limit-of character)
+ (<= (- (bladder/maximum-limit-of character) (bladder/contents-of character)) (watersport-limit-of character))
+ (< (random (watersport-chance-of character)) 1))
+ (format t "~a slightly blushes and lets go from the front of ~a~a and spreads ~a legs apart and floods them~%"
+ (name-of character)
+ pampspronoun
+ pampsname
+ (if male
+ "his"
+ "her"))
+ (wet :wetter character))
+ ((and (mudsport-limit-of character)
+ (<= (- (bowels/maximum-limit-of character) (bowels/contents-of character)) (mudsport-limit-of character))
+ (< (random (mudsport-chance-of character)) 1))
+ (format t "~a slightly blushes and squats down and messes ~a~a~%"
+ (name-of character)
+ pampspronoun
+ pampsname)
+ (mess :messer character)))))
+ (:method initialize-instance :after
+ (character &key (watersport-limit nil watersportp) (mudsport-limit nil mudsportp) (wear nil wearp) &allow-other-keys)
+ (declare (ignore watersport-limit mudsport-limit wear))
+ (unless wearp
+ (push (make-instance 'yadfa-items:navy-pullups) (wear-of character))
+ (when (and (not (malep character)) (= (random 5) 0))
+ (push (make-instance 'yadfa-items:navy-skirt) (wear-of character)))
+ (unless (malep character)
+ (push (make-instance 'yadfa-items:bra) (wear-of character)))
+ (push (make-instance 'yadfa-items:navy-shirt) (wear-of character)))
+ (unless watersportp
+ (setf (watersport-limit-of character) (- (bladder/maximum-limit-of character) (bladder/potty-desperate-limit-of character))))
+ (unless mudsportp
+ (setf (mudsport-limit-of character) (- (bowels/maximum-limit-of character) (bowels/potty-desperate-limit-of character))))))
(defclass navy-officer* (navy-officer) ()
(:default-initargs
:description "A variant of the Navy Officer. This variant still wears the standard pullups, but supplements them with stuffers to avoid changing the pullups out and is a bit less likely to try and hold it"
diff --git a/data/enemies/pokemon.lisp b/data/enemies/pokemon.lisp
index d2fd243..1c28211 100644
--- a/data/enemies/pokemon.lisp
+++ b/data/enemies/pokemon.lisp
@@ -8,8 +8,9 @@
:male (a:random-elt '(t nil))
:bitcoins-per-level 10
:element-types '#.(coerce-element-types 'yadfa-element-types:water)))
-(defmethod attack ((target team-member) (user magikarp) (attack null))
- (declare (ignore target attack))
- (format t "~a uses Splash, obviously it had no effect. What did you think was going to happen?" (name-of user)))
-(defmethod battle-script ((self magikarp) (target base-character))
- (attack target self nil))
+(s:defmethods magikarp (user)
+ (:method attack ((target team-member) user (attack null))
+ (declare (ignore target attack))
+ (format t "~a uses Splash, obviously it had no effect. What did you think was going to happen?" (name-of user)))
+ (:method battle-script (user (target base-character))
+ (attack target user nil)))
diff --git a/data/enemies/raccoon-bandits.lisp b/data/enemies/raccoon-bandits.lisp
index b6d6ff1..c7e7e13 100644
--- a/data/enemies/raccoon-bandits.lisp
+++ b/data/enemies/raccoon-bandits.lisp
@@ -17,67 +17,68 @@
(iter (for i from 0 to (random 5))
(push (make-instance 'yadfa-items:bandit-female-diaper) a)))
:bitcoins-per-level 40))
-(defmethod battle-script ((self diapered-raccoon-bandit) (target base-character))
- (let ((moves-with-health (iter (for i in (moves-of self))
- (when (and (>= (energy-of self) (energy-cost-of i)) (typep i 'health-inc-move))
- (collect i))))
- (moves-can-use (iter (for i in (moves-of self))
- (when (>= (energy-of self) (energy-cost-of i))
- (collect i))))
- (move-to-use nil))
- (cond ((and (<= (health-of self) (/ (calculate-stat self :health) 4)) moves-with-health)
- (setf move-to-use (a:random-elt moves-with-health))
- (attack target self move-to-use))
- (t
- (when moves-can-use
- (setf move-to-use (a:random-elt moves-can-use)))
- (cond ((and (>= (bladder/contents-of target) (bladder/potty-dance-limit-of target)) (= (random 3) 0))
- (format t "~a gets a grin on ~a face~%" (name-of self) (if (malep self) "his" "her"))
- (let ((move-to-use (make-instance 'yadfa-moves:tickle)))
- (attack target self move-to-use)))
- ((and (> (getf (calculate-diaper-usage target) :messiness) 0) (= (random 3) 0))
- (format t "~a gets a grin on ~a face~%" (name-of self) (if (malep self) "his" "her"))
- (let ((move-to-use (make-instance 'yadfa-moves:mush)))
- (attack target self move-to-use)))
- ((and move-to-use (= (random 4) 0))
- (attack target self move-to-use)
- (decf (energy-of self) (energy-cost-of move-to-use)))
- ((wield-of self)
- (attack target self (wield-of self)))
- (t
- (attack target self nil)))))))
-(defmethod process-battle-accident ((character diapered-raccoon-bandit) attack (item item) reload (selected-target base-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 (>= (bowels/contents-of character) (bowels/maximum-limit-of character))
- (format t "~a involuntarily 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))
- (let ((wetting (find-if (lambda (o) (typep o 'yadfa-status-conditions:wetting))
- (getf (status-conditions-of *battle*) character)))
- (messing (find-if (lambda (o) (typep o 'yadfa-status-conditions:messing))
- (getf (status-conditions-of *battle*) character)))
- (teammember (find-if (lambda (o)
- (and (typep o 'diapered-raccoon-bandit) (not (eq o character))))
- (enemies-of *battle*))))
- (cond ((and wetting teammember (= (random 5) 0))
- (write-line "Other Raccoon: Now's not the time to go potty")
- (write-line "Flooding Raccoon Bandit: *whines*"))
- ((and messing teammember (= (random 5) 0))
- (write-line "Other Raccoon: You couldn't wait until after the battle before doing that?")
- (write-line "Messing Raccoon Bandit: *grunts*")))))
+(s:defmethods diapered-raccoon-bandit (character)
+ (:method battle-script (character (target base-character))
+ (let ((moves-with-health (iter (for i in (moves-of character))
+ (when (and (>= (energy-of character) (energy-cost-of i)) (typep i 'health-inc-move))
+ (collect i))))
+ (moves-can-use (iter (for i in (moves-of character))
+ (when (>= (energy-of character) (energy-cost-of i))
+ (collect i))))
+ (move-to-use nil))
+ (cond ((and (<= (health-of character) (/ (calculate-stat character :health) 4)) moves-with-health)
+ (setf move-to-use (a:random-elt moves-with-health))
+ (attack target character move-to-use))
+ (t
+ (when moves-can-use
+ (setf move-to-use (a:random-elt moves-can-use)))
+ (cond ((and (>= (bladder/contents-of target) (bladder/potty-dance-limit-of target)) (= (random 3) 0))
+ (format t "~a gets a grin on ~a face~%" (name-of character) (if (malep character) "his" "her"))
+ (let ((move-to-use (make-instance 'yadfa-moves:tickle)))
+ (attack target character move-to-use)))
+ ((and (> (getf (calculate-diaper-usage target) :messiness) 0) (= (random 3) 0))
+ (format t "~a gets a grin on ~a face~%" (name-of character) (if (malep character) "his" "her"))
+ (let ((move-to-use (make-instance 'yadfa-moves:mush)))
+ (attack target character move-to-use)))
+ ((and move-to-use (= (random 4) 0))
+ (attack target character move-to-use)
+ (decf (energy-of character) (energy-cost-of move-to-use)))
+ ((wield-of character)
+ (attack target character (wield-of character)))
+ (t
+ (attack target character nil)))))))
+ (:method process-battle-accident (character attack (item item) reload (selected-target base-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 (>= (bowels/contents-of character) (bowels/maximum-limit-of character))
+ (format t "~a involuntarily 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))
+ (let ((wetting (find-if (lambda (o) (typep o 'yadfa-status-conditions:wetting))
+ (getf (status-conditions-of *battle*) character)))
+ (messing (find-if (lambda (o) (typep o 'yadfa-status-conditions:messing))
+ (getf (status-conditions-of *battle*) character)))
+ (teammember (find-if (lambda (o)
+ (and (typep o 'diapered-raccoon-bandit) (not (eq o character))))
+ (enemies-of *battle*))))
+ (cond ((and wetting teammember (= (random 5) 0))
+ (write-line "Other Raccoon: Now's not the time to go potty")
+ (write-line "Flooding Raccoon Bandit: *whines*"))
+ ((and messing teammember (= (random 5) 0))
+ (write-line "Other Raccoon: You couldn't wait until after the battle before doing that?")
+ (write-line "Messing Raccoon Bandit: *grunts*"))))))
(defclass rookie-diapered-raccoon-bandit (potty-enemy pantsable-character) ()
(:default-initargs
:name "Rookie Diapered Raccoon Bandit"
diff --git a/data/enemies/rpgmaker.lisp b/data/enemies/rpgmaker.lisp
index b9e27ac..7c3ba6b 100644
--- a/data/enemies/rpgmaker.lisp
+++ b/data/enemies/rpgmaker.lisp
@@ -37,63 +37,67 @@
(collect (make-instance 'yadfa-items:high-capacity-diaper)))
:element-types '#.(coerce-element-types 'yadfa-element-types:poison)
:moves (make-instances yadfa-moves:spray yadfa-moves:face-sit)))
-(defmethod initialize-instance :after
- ((c diapered-skunk) &key (watersport-limit nil watersportp) (mudsport-limit nil mudsportp)
- (wear nil wearp) &allow-other-keys)
- (declare (ignore watersport-limit mudsport-limit wear))
- (unless wearp
- (push (let ((a (make-instance 'yadfa-items:high-capacity-diaper)))
- (setf (sogginess-of a) (+ (bladder/potty-desperate-limit-of c) (random (+ (bladder/maximum-limit-of c) (- (bladder/maximum-limit-of c) (bladder/potty-desperate-limit-of c))))))
- (setf (messiness-of a) (+ (bowels/potty-desperate-limit-of c) (random (- (bowels/maximum-limit-of c) (bowels/potty-desperate-limit-of c)))))
- a)
- (wear-of c))
- (push (make-instance (if (malep c) 'yadfa-items:tshirt 'yadfa-items:bikini-top)) (wear-of c))
- (push (make-instance 'yadfa-items:black-leather-jacket) (wear-of c)))
- (unless watersportp
- (setf (watersport-limit-of c) (- (bladder/maximum-limit-of c) (bladder/potty-desperate-limit-of c))))
- (unless mudsportp
- (setf (mudsport-limit-of c) (- (bowels/maximum-limit-of c) (bowels/potty-desperate-limit-of c)))))
-(defmethod process-battle-accident ((character diapered-skunk) attack (item item) reload (selected-target base-character))
- (declare (ignore attack item reload selected-target))
- (let* ((watersport-chance (random (watersport-chance-of character)))
- (mudsport-chance (random (mudsport-chance-of character)))
- (male (malep character))
- (hisher (if male "his" "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)))
- (cond ((or (>= (bladder/contents-of character)
- (bladder/maximum-limit-of character))
- (>= (bowels/contents-of character) bowels/maximum-limit)
- (and watersport-limit
- (<= (- bladder/maximum-limit (bladder/contents-of character)) watersport-limit)
- (< watersport-chance 1))
- (and mudsport-limit
- (<= (- bowels/maximum-limit (bowels/contents-of character)) mudsport-limit)
- (< mudsport-chance 1)))
- (when (or (>= (bladder/contents-of character) bladder/maximum-limit)
- (and watersport-limit
- (<= (- bladder/maximum-limit (bladder/contents-of character)) watersport-limit)
- (< watersport-chance 1)))
- (format t "~a gets a look of relief on ~a face as ~a floods ~a pamps~%"
- name
- hisher
- (if male "he" "she")
- hisher)
- (wet :wetter character)
- (set-status-condition 'yadfa-status-conditions:wetting character))
- (when (or (>= (bowels/contents-of character) bowels/maximum-limit)
- (and mudsport-limit
- (<= (- bowels/maximum-limit (bowels/contents-of character)) mudsport-limit)
- (< mudsport-chance 1)))
- (format t "~a squats down and with a heavy grunt pushes a huge load into ~a diapers~%"
- name
- hisher)
- (mess :messer character)
- (set-status-condition 'yadfa-status-conditions:messing character))
- t))))
+(s:defmethods diapered-skunk (character)
+ (:method initialize-instance :after
+ (character &key (watersport-limit nil watersportp) (mudsport-limit nil mudsportp)
+ (wear nil wearp) &allow-other-keys)
+ (declare (ignore watersport-limit mudsport-limit wear))
+ (unless wearp
+ (push (let ((a (make-instance 'yadfa-items:high-capacity-diaper)))
+ (setf (sogginess-of a) (+ (bladder/potty-desperate-limit-of character)
+ (random (+ (bladder/maximum-limit-of character)
+ (- (bladder/maximum-limit-of character) (bladder/potty-desperate-limit-of character))))))
+ (setf (messiness-of a) (+ (bowels/potty-desperate-limit-of character)
+ (random (- (bowels/maximum-limit-of character) (bowels/potty-desperate-limit-of character)))))
+ a)
+ (wear-of character))
+ (push (make-instance (if (malep character) 'yadfa-items:tshirt 'yadfa-items:bikini-top)) (wear-of character))
+ (push (make-instance 'yadfa-items:black-leather-jacket) (wear-of character)))
+ (unless watersportp
+ (setf (watersport-limit-of character) (- (bladder/maximum-limit-of character) (bladder/potty-desperate-limit-of character))))
+ (unless mudsportp
+ (setf (mudsport-limit-of character) (- (bowels/maximum-limit-of character) (bowels/potty-desperate-limit-of character)))))
+ (:method process-battle-accident (character attack (item item) reload (selected-target base-character))
+ (declare (ignore attack item reload selected-target))
+ (let* ((watersport-chance (random (watersport-chance-of character)))
+ (mudsport-chance (random (mudsport-chance-of character)))
+ (male (malep character))
+ (hisher (if male "his" "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)))
+ (cond ((or (>= (bladder/contents-of character)
+ (bladder/maximum-limit-of character))
+ (>= (bowels/contents-of character) bowels/maximum-limit)
+ (and watersport-limit
+ (<= (- bladder/maximum-limit (bladder/contents-of character)) watersport-limit)
+ (< watersport-chance 1))
+ (and mudsport-limit
+ (<= (- bowels/maximum-limit (bowels/contents-of character)) mudsport-limit)
+ (< mudsport-chance 1)))
+ (when (or (>= (bladder/contents-of character) bladder/maximum-limit)
+ (and watersport-limit
+ (<= (- bladder/maximum-limit (bladder/contents-of character)) watersport-limit)
+ (< watersport-chance 1)))
+ (format t "~a gets a look of relief on ~a face as ~a floods ~a pamps~%"
+ name
+ hisher
+ (if male "he" "she")
+ hisher)
+ (wet :wetter character)
+ (set-status-condition 'yadfa-status-conditions:wetting character))
+ (when (or (>= (bowels/contents-of character) bowels/maximum-limit)
+ (and mudsport-limit
+ (<= (- bowels/maximum-limit (bowels/contents-of character)) mudsport-limit)
+ (< mudsport-chance 1)))
+ (format t "~a squats down and with a heavy grunt pushes a huge load into ~a diapers~%"
+ name
+ hisher)
+ (mess :messer character)
+ (set-status-condition 'yadfa-status-conditions:messing character))
+ t)))))
(defclass diapered-skunk* (potty-enemy skunk-boop-mixin) ()
(:default-initargs
:name "Diapered Skunk"
@@ -106,65 +110,66 @@
:bitcoins-per-level 100
:element-types '#.(coerce-element-types 'yadfa-element-types:poison)
:moves (make-instances yadfa-moves:spray yadfa-moves:face-sit)))
-(defmethod initialize-instance :after
- ((c diapered-skunk*) &key (watersport-limit nil watersportp) (mudsport-limit nil mudsportp)
- (wear nil wearp) (description nil descriptionp) &allow-other-keys)
- (declare (ignore watersport-limit mudsport-limit wear description))
- (unless wearp
- (push (let ((a (make-instance 'yadfa-items:high-capacity-diaper)))
- (setf (sogginess-of a) (sogginess-capacity-of a))
- (setf (messiness-of a) (messiness-capacity-of a))
- a)
- (wear-of c)))
- (unless watersportp
- (setf (watersport-limit-of c) (- (bladder/maximum-limit-of c) (bladder/potty-desperate-limit-of c))))
- (unless mudsportp
- (setf (mudsport-limit-of c) (- (bowels/maximum-limit-of c) (bowels/potty-desperate-limit-of c))))
- (unless descriptionp
- (let* ((male (malep c))
- (hisher (if male "his" "her")))
- (setf (description-of c) (format nil "If you thought the other skunk was stinky, that's nothing compared to this one. Apparently this skunk never changes ~a pamps at all and just continues to flood, mess, and spray ~a current one. ~a doesn't wear anything else because it just gets covered in too much of ~a own stinky juices." hisher hisher (if male "He" "She") hisher)))))
-(defmethod process-battle-accident ((character diapered-skunk*) attack (item item) reload (selected-target base-character))
- (declare (ignore attack item reload selected-target))
- (let* ((watersport-chance (random (watersport-chance-of character)))
- (mudsport-chance (random (mudsport-chance-of character)))
- (male (malep character))
- (hisher (if male "his" "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)))
- (cond ((or (>= (bladder/contents-of character)
- (bladder/maximum-limit-of character))
- (>= (bowels/contents-of character) bowels/maximum-limit)
- (and watersport-limit
- (<= (- bladder/maximum-limit (bladder/contents-of character)) watersport-limit)
- (< watersport-chance 1))
- (and mudsport-limit
- (<= (- bowels/maximum-limit (bowels/contents-of character)) mudsport-limit)
- (< mudsport-chance 1)))
- (when (or (>= (bladder/contents-of character) bladder/maximum-limit)
- (and watersport-limit
- (<= (- bladder/maximum-limit (bladder/contents-of character)) watersport-limit)
- (< watersport-chance 1)))
- (format t "~a gets a look of relief on ~a face as ~a floods ~a already leaky and waterlogged pamps~%"
- name
- hisher
- (if male "he" "she")
- hisher)
- (wet :wetter character)
- (set-status-condition 'yadfa-status-conditions:wetting character))
- (when (or (>= (bowels/contents-of character) bowels/maximum-limit)
- (and mudsport-limit
- (<= (- bowels/maximum-limit (bowels/contents-of character)) mudsport-limit)
- (< mudsport-chance 1)))
- (format t "~a squats down and with a heavy grunt pushes a huge load into ~a already overly full diapers~%"
- name
- hisher)
- (mess :messer character)
- (set-status-condition 'yadfa-status-conditions:messing character))
- t))))
+(s:defmethods diapered-skunk* (character)
+ (:method initialize-instance :after
+ (character &key (watersport-limit nil watersportp) (mudsport-limit nil mudsportp)
+ (wear nil wearp) (description nil descriptionp) &allow-other-keys)
+ (declare (ignore watersport-limit mudsport-limit wear description))
+ (unless wearp
+ (push (let ((a (make-instance 'yadfa-items:high-capacity-diaper)))
+ (setf (sogginess-of a) (sogginess-capacity-of a))
+ (setf (messiness-of a) (messiness-capacity-of a))
+ a)
+ (wear-of character)))
+ (unless watersportp
+ (setf (watersport-limit-of character) (- (bladder/maximum-limit-of character) (bladder/potty-desperate-limit-of character))))
+ (unless mudsportp
+ (setf (mudsport-limit-of character) (- (bowels/maximum-limit-of character) (bowels/potty-desperate-limit-of character))))
+ (unless descriptionp
+ (let* ((male (malep character))
+ (hisher (if male "his" "her")))
+ (setf (description-of character) (format nil "If you thought the other skunk was stinky, that's nothing compared to this one. Apparently this skunk never changes ~a pamps at all and just continues to flood, mess, and spray ~a current one. ~a doesn't wear anything else because it just gets covered in too much of ~a own stinky juices." hisher hisher (if male "He" "She") hisher)))))
+ (:method process-battle-accident (character attack (item item) reload (selected-target base-character))
+ (declare (ignore attack item reload selected-target))
+ (let* ((watersport-chance (random (watersport-chance-of character)))
+ (mudsport-chance (random (mudsport-chance-of character)))
+ (male (malep character))
+ (hisher (if male "his" "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)))
+ (cond ((or (>= (bladder/contents-of character)
+ (bladder/maximum-limit-of character))
+ (>= (bowels/contents-of character) bowels/maximum-limit)
+ (and watersport-limit
+ (<= (- bladder/maximum-limit (bladder/contents-of character)) watersport-limit)
+ (< watersport-chance 1))
+ (and mudsport-limit
+ (<= (- bowels/maximum-limit (bowels/contents-of character)) mudsport-limit)
+ (< mudsport-chance 1)))
+ (when (or (>= (bladder/contents-of character) bladder/maximum-limit)
+ (and watersport-limit
+ (<= (- bladder/maximum-limit (bladder/contents-of character)) watersport-limit)
+ (< watersport-chance 1)))
+ (format t "~a gets a look of relief on ~a face as ~a floods ~a already leaky and waterlogged pamps~%"
+ name
+ hisher
+ (if male "he" "she")
+ hisher)
+ (wet :wetter character)
+ (set-status-condition 'yadfa-status-conditions:wetting character))
+ (when (or (>= (bowels/contents-of character) bowels/maximum-limit)
+ (and mudsport-limit
+ (<= (- bowels/maximum-limit (bowels/contents-of character)) mudsport-limit)
+ (< mudsport-chance 1)))
+ (format t "~a squats down and with a heavy grunt pushes a huge load into ~a already overly full diapers~%"
+ name
+ hisher)
+ (mess :messer character)
+ (set-status-condition 'yadfa-status-conditions:messing character))
+ t)))))
(defclass diapered-dragon (potty-enemy) ()
(:default-initargs
:name "Diapered Dragon"
diff --git a/data/items/consumable.lisp b/data/items/consumable.lisp
index 64ee9e4..c628b74 100644
--- a/data/items/consumable.lisp
+++ b/data/items/consumable.lisp
@@ -56,13 +56,14 @@
: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 &key &allow-other-keys)
- (when (<= (health-of target) 0)
- (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)
- (incf (energy-of target) 20))
+(s:defmethods monster-energy-drink (item)
+ (:method cant-use-p (item (user base-character) (target base-character) action &key &allow-other-keys)
+ (when (<= (health-of target) 0)
+ (values t `(:format-control "Does ~a look conscious enough to use that?" :format-arguments (,(name-of target))))))
+ (:method use-script (item (user base-character) (target base-character))
+ (declare (ignore item))
+ (incf (bladder/contents-of target) 175)
+ (incf (energy-of target) 20)))
(defclass spiked-bottle-of-milk (consumable) ()
(:default-initargs
:name "Spiked Bottle of milk"
@@ -101,12 +102,13 @@
:description "Bring someone back from the dead with this"
:value 500
:consumable t))
-(defmethod cant-use-p ((item revive) (user base-character) (target base-character) action &key &allow-other-keys)
- (when (> (health-of target) 0)
- (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))
+(s:defmethods revive (item)
+ (:method cant-use-p (item (user base-character) (target base-character) action &key &allow-other-keys)
+ (when (> (health-of target) 0)
+ (values t `(:format-control "Does ~a look unconscious to you?~%" :format-arguments (,(name-of target))))))
+ (:method use-script (item (user base-character) (target base-character))
+ (declare (ignore item))
+ (incf (health-of target) 20)))
(defclass cannibal-corp-meat (consious-mixin consumable) ()
(:default-initargs
:name "\"CANNIBAL CORP.\" Brand Meat"
@@ -132,25 +134,26 @@
:description "And Saint Attila raised the hand grenade up on high, saying, “O Lord, bless this thy hand grenade. That with it, thou mayest blow thine enemies to tiny bits, in thy mercy” And the Lord did grin, and the people did feast upon the lambs, and sloths, and carp, and anchovies, and orangutans, and breakfast cereals, and fruit bats, and..."
:value 200
:consumable t))
-(defmethod cant-use-p ((item holy-hand-grenade) (user base-character) (target base-character) action &key &allow-other-keys)
- (unless *battle*
- (values t `(:format-control "You can only use that in battle"))))
-(defmethod use-script :around ((item holy-hand-grenade) (user base-character) (target base-character))
- (if (or (and (typep target 'team-member) (cdr (team-of *game*)))
- (and (typep target 'enemy) (cdr (enemies-of *battle*))))
- (progn
- (format t "~a: One, Two, Five~%" (name-of target))
- (format t "~a: Three ~a~%" (name-of (if (typep target 'team-member)
- (or (second (member target (team-of *game*)))
- (player-of *game*))
- (or (second (member target (enemies-of *battle*)))
- (first (enemies-of *battle*)))))
- (if (malep target) "Sir" "Ma'am"))
- (format t "~a: Three!!!" (name-of target)))
- (format t "~a: One, Two, Five, I mean Three!!!" (name-of target)))
- (write-line " *throws hand grenade*")
- (write-line "*BOOM*")
- (iter (for i in (if (typep target 'team-member)
- (enemies-of *battle*)
- (team-of *game*)))
- (decf (health-of i) (use-power-of item))))
+(s:defmethods holy-hand-grenade (item)
+ (:method cant-use-p (item (user base-character) (target base-character) action &key &allow-other-keys)
+ (unless *battle*
+ (values t `(:format-control "You can only use that in battle"))))
+ (:method use-script :around (item (user base-character) (target base-character))
+ (if (or (and (typep target 'team-member) (cdr (team-of *game*)))
+ (and (typep target 'enemy) (cdr (enemies-of *battle*))))
+ (progn
+ (format t "~a: One, Two, Five~%" (name-of target))
+ (format t "~a: Three ~a~%" (name-of (if (typep target 'team-member)
+ (or (second (member target (team-of *game*)))
+ (player-of *game*))
+ (or (second (member target (enemies-of *battle*)))
+ (first (enemies-of *battle*)))))
+ (if (malep target) "Sir" "Ma'am"))
+ (format t "~a: Three!!!" (name-of target)))
+ (format t "~a: One, Two, Five, I mean Three!!!" (name-of target)))
+ (write-line " *throws hand grenade*")
+ (write-line "*BOOM*")
+ (iter (for i in (if (typep target 'team-member)
+ (enemies-of *battle*)
+ (team-of *game*)))
+ (decf (health-of i) (use-power-of item)))))
diff --git a/data/items/diaper.lisp b/data/items/diaper.lisp
index a9f6417..d6feeaf 100644
--- a/data/items/diaper.lisp
+++ b/data/items/diaper.lisp
@@ -243,26 +243,30 @@
(collect (format-pair i))))))
(0
(:fmt (format-pair (car text))))))))))
-(defmethod describe-diaper-wear-usage ((item gem-diaper))
- (let ((wet-gems (round (- 100 (* (/ (sogginess-of item) (sogginess-capacity-of item)) 100))))
- (mess-gems (round (- 100 (* (/ (messiness-of item) (messiness-capacity-of item)) 100)))))
- (declare (type fixnum wet-gems mess-gems))
- (f:fmt t "The front of the diaper has a picture of " (describe-gems wet-gems) #\Newline
- (:esc (when (>= (sogginess-of item) (sogginess-capacity-of item))
- (:fmt "Pee is dripping down your legs" #\Newline)))
- "The back of the diaper has a picture of " (describe-gems mess-gems) #\Newline
- (:esc (when (>= (messiness-of item) (messiness-capacity-of item))
- (:fmt "Poop is leaking down the leg guards" #\Newline))))))
-(defmethod describe-diaper-inventory-usage ((item gem-diaper))
- (let ((wet-gems (round (- 100 (* (/ (sogginess-of item) (sogginess-capacity-of item)) 100))))
- (mess-gems (round (- 100 (* (/ (messiness-of item) (messiness-capacity-of item)) 100)))))
- (declare (type fixnum wet-gems mess-gems))
- (f:fmt t "The front of the diaper has a picture of " (describe-gems wet-gems) #\Newline
- (:esc (when (>= (sogginess-of item) (sogginess-capacity-of item))
- (:fmt "It is totally drenched" #\Newline)))
- "The back of the diaper has a picture of " (describe-gems mess-gems) #\Newline
- (:esc (when (>= (messiness-of item) (messiness-capacity-of item))
- (:fmt "Diaper is clearly full" #\Newline))))))
+(s:defmethods gem-diaper (item (sogginess #'sogginess-of)
+ (messiness #'messiness-of)
+ (sogginess-capacity #'sogginess-capacity-of)
+ (messiness-capacity #'messiness-capacity-of))
+ (:method describe-diaper-wear-usage (item)
+ (let ((wet-gems (round (- 100 (* (/ sogginess sogginess-capacity) 100))))
+ (mess-gems (round (- 100 (* (/ messiness messiness-capacity) 100)))))
+ (declare (type fixnum wet-gems mess-gems))
+ (f:fmt t "The front of the diaper has a picture of " (describe-gems wet-gems) #\Newline
+ (:esc (when (>= sogginess sogginess-capacity)
+ (:fmt "Pee is dripping down your legs" #\Newline)))
+ "The back of the diaper has a picture of " (describe-gems mess-gems) #\Newline
+ (:esc (when (>= messiness messiness-capacity)
+ (:fmt "Poop is leaking down the leg guards" #\Newline))))))
+ (:method describe-diaper-inventory-usage (item)
+ (let ((wet-gems (round (- 100 (* (/ sogginess sogginess-capacity) 100))))
+ (mess-gems (round (- 100 (* (/ messiness messiness-capacity) 100)))))
+ (declare (type fixnum wet-gems mess-gems))
+ (f:fmt t "The front of the diaper has a picture of " (describe-gems wet-gems) #\Newline
+ (:esc (when (>= sogginess sogginess-capacity)
+ (:fmt "It is totally drenched" #\Newline)))
+ "The back of the diaper has a picture of " (describe-gems mess-gems) #\Newline
+ (:esc (when (>= messiness messiness-capacity)
+ (:fmt "Diaper is clearly full" #\Newline)))))))
(defclass temple-diaper (cloth-mixin yadfa:diaper) ()
(:default-initargs
:name "Temple Diaper"
diff --git a/data/items/misc.lisp b/data/items/misc.lisp
index 03c917e..dee9b00 100644
--- a/data/items/misc.lisp
+++ b/data/items/misc.lisp
@@ -103,10 +103,11 @@
:description "Use this to catch enemies"
:value 500
:power 0))
-(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)
+(s:defmethods enemy-catcher (item)
+ (:method cant-use-p (item (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)))))
+ (:method cant-use-p (item (user base-character) (target yadfa-enemies:catchable-enemy) action &key &allow-other-keys)
+ nil))
(defclass ghost-catcher (enemy-catcher) ()
(:default-initargs
:name "Ghost Catcher"
@@ -115,7 +116,8 @@
;;; which should get replaced later in the loading process
(unless (find-class 'yadfa-enemies:ghost nil)
(defclass yadfa-enemies:ghost () ()))
-(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)
+(s:defmethods ghost-catcher (item)
+ (:method cant-use-p (item (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)))))
+ (:method cant-use-p (item (user base-character) (target yadfa-enemies:ghost) action &key &allow-other-keys)
+ nil))
diff --git a/data/items/weapons.lisp b/data/items/weapons.lisp
index 95263f9..8a4e6b2 100644
--- a/data/items/weapons.lisp
+++ b/data/items/weapons.lisp
@@ -93,12 +93,13 @@
:name "Messing Laser"
:description "Causes enemies to mess themselves"
:values 8000))
-(defmethod attack :around ((target base-character) (user base-character) (weapon messing-laser))
- (f:fmt t (name-of user) " fires " (if (malep user) "his" "her") " laser at " (name-of target) #\Newline)
- (use-script weapon user target))
-(defmethod use-script ((weapon messing-laser) (user base-character) (target base-character))
- (f:fmt t "It has no effect on " (name-of target) #\Newline))
-(defmethod use-script ((weapon messing-laser) (user base-character) (target bowels-character))
- (f:fmt t (name-of target) " squats down and starts blorting " (if (malep target) "himself" "herself") " uncontrollably." #\Newline)
- (mess :force-fill-amount (bowels/maximum-limit-of target))
- (set-status-condition 'yadfa-status-conditions:messing target))
+(s:defmethods messing-laser (weapon)
+ (:method attack :around ((target base-character) (user base-character) weapon)
+ (f:fmt t (name-of user) " fires " (if (malep user) "his" "her") " laser at " (name-of target) #\Newline)
+ (use-script weapon user target))
+ (:method use-script (weapon (user base-character) (target base-character))
+ (f:fmt t "It has no effect on " (name-of target) #\Newline))
+ (:method use-script (weapon (user base-character) (target bowels-character))
+ (f:fmt t (name-of target) " squats down and starts blorting " (if (malep target) "himself" "herself") " uncontrollably." #\Newline)
+ (mess :force-fill-amount (bowels/maximum-limit-of target))
+ (set-status-condition 'yadfa-status-conditions:messing target)))
diff --git a/data/moves/pokemon.lisp b/data/moves/pokemon.lisp
index c1c49c8..b1007eb 100644
--- a/data/moves/pokemon.lisp
+++ b/data/moves/pokemon.lisp
@@ -44,20 +44,21 @@
:description "massively mess your diapers, never fails"
:energy-cost 5
:element-types '#.(coerce-element-types '(yadfa-element-types:abdl yadfa-element-types:poison))))
-(defmethod attack ((target base-character) (user base-character) (attack mudbomb))
- (write-line "But it failed."))
-(defmethod attack ((target base-character) (user bowels-character) (attack mudbomb)
+(s:defmethods mudbomb (attack)
+ (:method attack ((target base-character) (user base-character) attack)
+ (write-line "But it failed."))
+ (:method attack ((target base-character) (user bowels-character) attack
&aux (bowels/fill-rate (* 30 24 (bowels/fill-rate-of user))) (bowels/maximum-limit (bowels/maximum-limit-of user))
- (name (name-of user)))
- (mess :force-fill-amount (if (< bowels/fill-rate bowels/maximum-limit) bowels/maximum-limit bowels/fill-rate) :messer user)
- (format t "~a messed ~a massively~%"
- name
- (if (malep user) "himself" "herself"))
- (iter (for i in (if (typep user 'team-member)
- (enemies-of *battle*)
- (team-of *game*)))
- (set-status-condition 'yadfa-status-conditions:skunked i)
- (format t "~a is grossed out by the smell~%" (name-of i))))
+ (name (name-of user)))
+ (mess :force-fill-amount (if (< bowels/fill-rate bowels/maximum-limit) bowels/maximum-limit bowels/fill-rate) :messer user)
+ (format t "~a messed ~a massively~%"
+ name
+ (if (malep user) "himself" "herself"))
+ (iter (for i in (if (typep user 'team-member)
+ (enemies-of *battle*)
+ (team-of *game*)))
+ (set-status-condition 'yadfa-status-conditions:skunked i)
+ (format t "~a is grossed out by the smell~%" (name-of i)))))
(defclass tickle (move debuff) ()
(:default-initargs
:name "Tickle"
diff --git a/data/moves/regular.lisp b/data/moves/regular.lisp
index df0102d..d2e25a6 100644
--- a/data/moves/regular.lisp
+++ b/data/moves/regular.lisp
@@ -19,71 +19,72 @@
(:default-initargs
:name "Pants"
:description "Pants the enemy"))
-(defmethod attack ((target base-character) (user base-character) (self pants))
- (declare (ignore self))
- (format t "~a tries to pants ~a~%" (name-of user) (name-of target))
- (format t "The attack has no effect on ~a~%" (name-of target)))
-(defmethod attack ((target pantsable-character) (user base-character) (self pants))
- (declare (ignore self))
- (let* ((pants (filter-items (wear-of target) '(or pants skirt dress)))
- (stat
- (when pants
- (iter (for i in (wear-of target))
- (when (typep i '(or diaper pullup))
- (let ((severity (cond ((and (> (sogginess-of i) 300) (> (messiness-of i) 4000))
- 'both)
- ((> (messiness-of i) 4000)
- 'messy)
- ((> (sogginess-of i) 300)
- 'soggy)))
- (padding i))
- (leave `(padding ,padding severity ,severity)))))))
- (old-condition (find 'yadfa-status-conditions:pantsed (getf (status-conditions-of *battle*) target)
- :test (lambda (o e)
- (typep e o)))))
- (if stat
- (progn
- (cond ((filter-items pants '(or pants skirt))
- (format t "~a pantses ~a~%"
- (name-of user)
- (name-of target)))
- ((filter-items pants 'dress)
- (format t "~a raises ~a's ~a~%"
- (name-of user)
- (name-of target)
- (name-of (car (filter-items pants 'dress))))))
- (unless old-condition
- (push (make-instance 'yadfa-status-conditions:pantsed) (getf (status-conditions-of *battle*) target)))
- (format t "~a gets a horrified look on ~a face as ~a ~a is exposed to the world~%"
- (name-of target)
- (if (malep target) "his" "her")
- (if (malep target) "his" "her")
- (cond ((getf stat 'both)
- (format nil "soggy mushy padding"))
- ((getf stat 'messy)
- "messy padding")
- ((getf stat 'soggy)
- "soggy padding")
- (t "padding")))
- (let ((audience (iter (for i in (if (typep target 'enemy)
- (enemies-of *battle*)
- (team-of *game*)))
- (unless (eq target i)
- (collect i)))))
- (when audience
- (format t (if (> (list-length audience) 1)
- "~a's team mates start laughing at ~a~%"
- "~a's team mate starts laughing at ~a~%")
- (name-of target)
- (if (malep target)
- "him"
- "her"))
- (unless old-condition
- (iter (for i in audience)
- (set-status-condition 'yadfa-status-conditions:laughing i))))))
- (progn
- (format t "~a tries to pants ~a~%" (name-of user) (name-of target))
- (format t "The attack has no effect on ~a~%" (name-of target))))))
+(s:defmethods pants (self)
+ (:method attack ((target base-character) (user base-character) self)
+ (declare (ignore self))
+ (format t "~a tries to pants ~a~%" (name-of user) (name-of target))
+ (format t "The attack has no effect on ~a~%" (name-of target)))
+ (:method attack ((target pantsable-character) (user base-character) self)
+ (declare (ignore self))
+ (let* ((pants (filter-items (wear-of target) '(or pants skirt dress)))
+ (stat
+ (when pants
+ (iter (for i in (wear-of target))
+ (when (typep i '(or diaper pullup))
+ (let ((severity (cond ((and (> (sogginess-of i) 300) (> (messiness-of i) 4000))
+ 'both)
+ ((> (messiness-of i) 4000)
+ 'messy)
+ ((> (sogginess-of i) 300)
+ 'soggy)))
+ (padding i))
+ (leave `(padding ,padding severity ,severity)))))))
+ (old-condition (find 'yadfa-status-conditions:pantsed (getf (status-conditions-of *battle*) target)
+ :test (lambda (o e)
+ (typep e o)))))
+ (if stat
+ (progn
+ (cond ((filter-items pants '(or pants skirt))
+ (format t "~a pantses ~a~%"
+ (name-of user)
+ (name-of target)))
+ ((filter-items pants 'dress)
+ (format t "~a raises ~a's ~a~%"
+ (name-of user)
+ (name-of target)
+ (name-of (car (filter-items pants 'dress))))))
+ (unless old-condition
+ (push (make-instance 'yadfa-status-conditions:pantsed) (getf (status-conditions-of *battle*) target)))
+ (format t "~a gets a horrified look on ~a face as ~a ~a is exposed to the world~%"
+ (name-of target)
+ (if (malep target) "his" "her")
+ (if (malep target) "his" "her")
+ (cond ((getf stat 'both)
+ (format nil "soggy mushy padding"))
+ ((getf stat 'messy)
+ "messy padding")
+ ((getf stat 'soggy)
+ "soggy padding")
+ (t "padding")))
+ (let ((audience (iter (for i in (if (typep target 'enemy)
+ (enemies-of *battle*)
+ (team-of *game*)))
+ (unless (eq target i)
+ (collect i)))))
+ (when audience
+ (format t (if (> (list-length audience) 1)
+ "~a's team mates start laughing at ~a~%"
+ "~a's team mate starts laughing at ~a~%")
+ (name-of target)
+ (if (malep target)
+ "him"
+ "her"))
+ (unless old-condition
+ (iter (for i in audience)
+ (set-status-condition 'yadfa-status-conditions:laughing i))))))
+ (progn
+ (format t "~a tries to pants ~a~%" (name-of user) (name-of target))
+ (format t "The attack has no effect on ~a~%" (name-of target)))))))
(defclass spray (move debuff) ()
(:default-initargs
:name "Spray"
@@ -122,19 +123,20 @@
:name "Boop"
:description "Boops da target on da snoot"
:energy-cost 5))
-(defmethod attack ((target base-character) (user base-character) (attack boop))
- (let ((user-name (name-of user))
- (target-name (name-of target)))
- (f:fmt t target-name " blushes as " user-name " boops " target-name " on da snoot :3" #\Newline)))
-(defmethod attack ((target yadfa-enemies:skunk-boop-mixin) (user base-character) (attack boop))
- (let* ((user-name (name-of user))
- (target-name (name-of target))
- (target-male-p (malep target)))
- (f:fmt t target-name " blushes as " user-name " boops " target-name " on da snoot :3" #\Newline
- target-name " immediately squats down and messes " (if target-male-p "his" "her") " pamps." #\Newline
- "It's like a mess button." #\Newline)
- (mess :force-fill-amount (bowels/maximum-limit-of target))
- (set-status-condition 'yadfa-status-conditions:messing target)))
+(s:defmethods boop (attack)
+ (:method attack ((target base-character) (user base-character) attack)
+ (let ((user-name (name-of user))
+ (target-name (name-of target)))
+ (f:fmt t target-name " blushes as " user-name " boops " target-name " on da snoot :3" #\Newline)))
+ (:method attack ((target yadfa-enemies:skunk-boop-mixin) (user base-character) attack)
+ (let* ((user-name (name-of user))
+ (target-name (name-of target))
+ (target-male-p (malep target)))
+ (f:fmt t target-name " blushes as " user-name " boops " target-name " on da snoot :3" #\Newline
+ target-name " immediately squats down and messes " (if target-male-p "his" "her") " pamps." #\Newline
+ "It's like a mess button." #\Newline)
+ (mess :force-fill-amount (bowels/maximum-limit-of target))
+ (set-status-condition 'yadfa-status-conditions:messing target))))
(defclass fire-breath (damage-move) ()
(:default-initargs
:name "Fire Breath"
@@ -187,48 +189,49 @@
:description "Grosses out the enemies with gas. If poisoned or if desperate, you may end up messing yourself instead."
:energy-cost 10
:element-types '#.(coerce-element-types '(yadfa-element-types:abdl yadfa-element-types:poison))))
-(defmethod attack ((target base-character) (user base-character) (attack fart))
- (f:fmt t "But it failed." #\Newline))
-(defmethod attack :around ((target base-character) (user bowels-character) (attack fart))
- (let* ((padding (get-babyish-padding user))
- (name (name-of user))
- (malep (malep user))
- (his/her (if malep "his" "her"))
- (he/she (if malep "he" "she"))
- (himherself (if malep "himself" "herself")))
- (f:fmt t name " squats down and tries to use " (name-of attack) #\Newline)
- (flet ((fail ()
- (f:fmt t name " grabs the back of " (case padding
- (diaper (f:fmt nil his/her " diaper"))
- (pullup (f:fmt nil his/her " pullups"))
- (closed-bottoms (f:fmt nil his/her " pants"))
- (t (f:fmt nil himherself)))
- " with a bright red blush on " (if malep "his" "her") " face when " he/she " realized " he/she " just messed " himherself #\Newline)
- (iter (for i in (if (typep user 'team-member)
- (enemies-of *battle*)
- (team-of *game*)))
- (set-status-condition 'yadfa-status-conditions:laughing i)
- (f:fmt* t (name-of i) " is laughing at " name #\Newline))))
- (cond
- ((and (>= (bowels/contents-of user) (bowels/need-to-potty-limit-of user))
- (find 'yadfa-status-conditions:poisoned (getf (status-conditions-of *battle*) user)
- :test (lambda (o e)
- (typep e o))))
- (mess :messer user)
- (f:fmt t "*SPLORCH*" #\Newline)
- (fail))
- (t (let ((result (fart user)))
- (case result
- (:cant-go (f:fmt t "Nothing happened" #\Newline))
- (:success
- (f:fmt t "FRRRT" #\Newline
- (name-of user) " sighs with relief" #\Newline)
- (iter (for i in (if (typep user 'team-member)
- (enemies-of *battle*)
- (team-of *game*)))
- (set-status-condition 'yadfa-status-conditions:skunked i)
- (f:fmt* t (name-of i) " is grossed out by the smell" #\Newline)))
- (:fail (fail)))))))))
+(s:defmethods fart (attack)
+ (:method attack ((target base-character) (user base-character) attack)
+ (f:fmt t "But it failed." #\Newline))
+ (:method attack :around ((target base-character) (user bowels-character) attack)
+ (let* ((padding (get-babyish-padding user))
+ (name (name-of user))
+ (malep (malep user))
+ (his/her (if malep "his" "her"))
+ (he/she (if malep "he" "she"))
+ (himherself (if malep "himself" "herself")))
+ (f:fmt t name " squats down and tries to use " (name-of attack) #\Newline)
+ (flet ((fail ()
+ (f:fmt t name " grabs the back of " (case padding
+ (diaper (f:fmt nil his/her " diaper"))
+ (pullup (f:fmt nil his/her " pullups"))
+ (closed-bottoms (f:fmt nil his/her " pants"))
+ (t (f:fmt nil himherself)))
+ " with a bright red blush on " (if malep "his" "her") " face when " he/she " realized " he/she " just messed " himherself #\Newline)
+ (iter (for i in (if (typep user 'team-member)
+ (enemies-of *battle*)
+ (team-of *game*)))
+ (set-status-condition 'yadfa-status-conditions:laughing i)
+ (f:fmt* t (name-of i) " is laughing at " name #\Newline))))
+ (cond
+ ((and (>= (bowels/contents-of user) (bowels/need-to-potty-limit-of user))
+ (find 'yadfa-status-conditions:poisoned (getf (status-conditions-of *battle*) user)
+ :test (lambda (o e)
+ (typep e o))))
+ (mess :messer user)
+ (f:fmt t "*SPLORCH*" #\Newline)
+ (fail))
+ (t (let ((result (fart user)))
+ (case result
+ (:cant-go (f:fmt t "Nothing happened" #\Newline))
+ (:success
+ (f:fmt t "FRRRT" #\Newline
+ (name-of user) " sighs with relief" #\Newline)
+ (iter (for i in (if (typep user 'team-member)
+ (enemies-of *battle*)
+ (team-of *game*)))
+ (set-status-condition 'yadfa-status-conditions:skunked i)
+ (f:fmt* t (name-of i) " is grossed out by the smell" #\Newline)))
+ (:fail (fail))))))))))
(defclass spank (damage-move) ()
(:default-initargs
:name "Spank"
diff --git a/data/team-members/allies.lisp b/data/team-members/allies.lisp
index 91c261e..7c88f67 100644
--- a/data/team-members/allies.lisp
+++ b/data/team-members/allies.lisp
@@ -18,22 +18,27 @@
:skin '(:fur)
:description "Used to be one of the Diapered Raccoon Bandits. Was kicked out after he was forced to give the location of Pirate's Cove to the Navy. He was humiliated constantly by the Diapered Pirates until you rescued him. Is too embarrassed to admit when he as to go unless he's desperate"
:level 5))
-(defmethod fart-result-text ((user slynk) (result (eql :failure)) mess &key stream)
- (if (and (getf mess :leak-amount) (> (getf mess :leak-amount) 0))
- (f:fmt stream (name-of user) " gets a look of horror on " (if (malep user) "his" "her") " face as "
- (if (malep user) "he" "she") " ends up messing " (if (malep user) "himself" "herself")
- " and has a blowout" #\Newline)
- (f:fmt stream (name-of user) "tries to fart to relieve the pressure but ends up messing " (if (malep user) "his" "her")
- "pamps, doesn't seem to realize it wasn't a fart and just continues on in a messy diaper" #\Newline)))
-(defmethod initialize-instance :after
- ((c slynk) &key (bladder/contents nil bladderp) (bowels/contents nil bowelsp) &allow-other-keys)
- (declare (ignore bladder/contents bowels/contents))
- (unless bladderp
- (setf (bladder/contents-of c)
- (random (coerce (+ (bladder/potty-desperate-limit-of c) (/ (- (bladder/potty-desperate-limit-of c) (bladder/potty-dance-limit-of c)))) 'long-float))))
- (unless bowelsp
- (setf (bowels/contents-of c)
- (random (coerce (+ (bowels/potty-desperate-limit-of c) (/ (- (bowels/potty-desperate-limit-of c) (bowels/potty-dance-limit-of c)))) 'long-float)))))
+(s:defmethods slynk (user)
+ (:method fart-result-text (user (result (eql :failure)) mess &key stream)
+ (if (and (getf mess :leak-amount) (> (getf mess :leak-amount) 0))
+ (f:fmt stream (name-of user) " gets a look of horror on " (if (malep user) "his" "her") " face as "
+ (if (malep user) "he" "she") " ends up messing " (if (malep user) "himself" "herself")
+ " and has a blowout" #\Newline)
+ (f:fmt stream (name-of user) "tries to fart to relieve the pressure but ends up messing " (if (malep user) "his" "her")
+ "pamps, doesn't seem to realize it wasn't a fart and just continues on in a messy diaper" #\Newline)))
+ (:method initialize-instance :after
+ (user &key (bladder/contents nil bladderp) (bowels/contents nil bowelsp) &allow-other-keys)
+ (declare (ignore bladder/contents bowels/contents))
+ (unless bladderp
+ (setf (bladder/contents-of user)
+ (random (coerce (+ (bladder/potty-desperate-limit-of user)
+ (/ (- (bladder/potty-desperate-limit-of user) (bladder/potty-dance-limit-of user))))
+ 'long-float))))
+ (unless bowelsp
+ (setf (bowels/contents-of user)
+ (random (coerce (+ (bowels/potty-desperate-limit-of user)
+ (/ (- (bowels/potty-desperate-limit-of user) (bowels/potty-dance-limit-of user))))
+ 'long-float))))))
(defclass chris (playable-ally ally-rebel-potty-training) ()
(:default-initargs
:name "Chris"
diff --git a/packages.lisp b/packages.lisp
index 99a14ad..0a2a221 100644
--- a/packages.lisp
+++ b/packages.lisp
@@ -11,7 +11,6 @@
#:insert
#:insertf
#:substitutef
- #:random-from-range
#:type-specifier
#:coerced-function
#:removef-if