aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Pouar <pouar@pouar.net>2020-09-10 13:58:33 -0500
committerGravatar Pouar <pouar@pouar.net>2020-09-10 13:58:33 -0500
commiteec08d83d48e2d1b6ae9080e9601c35535740c1b (patch)
treed6ae79b63259f95d34484b257bda28714aaab504
parentadd multiplier and cooldown to fill-bladder and fill-bowels (diff)
add fart mechanic
-rw-r--r--core/bin/world.lisp16
-rw-r--r--core/classes.lisp8
-rw-r--r--core/libexec/generic-functions.lisp22
-rw-r--r--core/libexec/methods.lisp8
-rw-r--r--data/moves/regular.lisp92
-rw-r--r--data/team-members/allies.lisp7
-rw-r--r--packages.lisp6
7 files changed, 96 insertions, 63 deletions
diff --git a/core/bin/world.lisp b/core/bin/world.lisp
index af6313e..0ee2fab 100644
--- a/core/bin/world.lisp
+++ b/core/bin/world.lisp
@@ -371,3 +371,19 @@ You can also specify multiple directions, for example @code{(move :south :south)
(write-line "Those refer to the same team member")
(return-from yadfa-world:swap-team-member))
(t (rotatef (nth team-index-1 (team-of *game*)) (nth team-index-2 (team-of *game*))))))
+(defunassert yadfa-world:fart (&optional user)
+ (user (or unsigned-byte type-specifier))
+ (handle-user-input ((selected-user (typecase user
+ (null (player-of *game*))
+ (unsigned-byte (nth user (allies-of *game*)))
+ (type-specifier (find user (cons (player-of *game*) (allies-of *game*))
+ :test (lambda (o e)
+ (typep e o)))))))
+ (*query-io* ((null selected-user)
+ (user)
+ :prompt-text "Enter a different user"
+ :error-text (typecase user
+ (unsigned-byte (f:fmt nil "You only have " (length (allies-of *game*)) " allies"))
+ (type-specifier "you don't have that ally"))))
+ (multiple-value-bind (result mess) (fart user)
+ (fart-result-text selected-user result mess))))
diff --git a/core/classes.lisp b/core/classes.lisp
index 4671f71..81fbd7c 100644
--- a/core/classes.lisp
+++ b/core/classes.lisp
@@ -401,7 +401,13 @@
:initform 800
:type (real 0)
:accessor bowels/maximum-limit-of
- :documentation "When the character's bowels gets this full, @{he,she@} messes @{him,her@}self")))
+ :documentation "When the character's bowels gets this full, @{he,she@} messes @{him,her@}self")
+ (fart-count
+ :initarg :fart-count
+ :initform 0
+ :type unsigned-byte
+ :accessor fart-count-of
+ :documentation "How many times the character has farted to reduce the pressure since the last mess. Used to calculate how much pressure this relieves and the chance the character might end up messing himself/herself instead.")))
(defclass potty-character (bladder-character bowels-character)
())
(defclass team-member (base-character)
diff --git a/core/libexec/generic-functions.lisp b/core/libexec/generic-functions.lisp
index b2ebbd9..ec2bb37 100644
--- a/core/libexec/generic-functions.lisp
+++ b/core/libexec/generic-functions.lisp
@@ -283,3 +283,25 @@
(bowels/fill-rate/multiplier-of user) multiplier))))
(:method ((user base-character) &key &allow-other-keys)
0))
+(defgeneric fart (user)
+ (:method ((user bowels-character) &aux (fart-count (fart-count-of user)) (bowels (bowels/contents-of user))
+ (maximum-limit (bowels/maximum-limit-of user)) (rate (bowels/fill-rate-of user)))
+ (cond ((< (bowels/contents-of user) (bowels/need-to-potty-limit-of user))
+ :cant-go)
+ ((= 0 (random (expt 2 fart-count)))
+ (decf (bowels/contents-of user)
+ (cond ((>= bowels (/ maximum-limit 2))
+ (/ maximum-limit (expt 2 (+ 2 fart-count))))
+ ((> (- bowels (* (/ 100 (expt 2 fart-count)) rate)) 0)
+ (* (/ 100 (expt 2 fart-count)) rate))
+ (t bowels)))
+ :success)
+ (t (values :fail (mess :messer user))))))
+(defgeneric fart-result-text (user result mess &key stream)
+ (:method ((user bowels-character) (result (eql :cant-go)) mess &key (stream *standard-output*))
+ (f:fmt stream (name-of user) " Doesn't have to go" #\Newline))
+ (:method ((user bowels-character) (result (eql :success)) mess &key (stream *standard-output*))
+ (f:fmt stream (name-of user) " farts to relieve the pressure" #\Newline))
+ (:method ((user bowels-character) (result (eql :failure)) mess &key (stream *standard-output*))
+ (f:fmt stream (name-of user) "tries to fart to relive the pressure then 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") " instead" #\Newline)))
diff --git a/core/libexec/methods.lisp b/core/libexec/methods.lisp
index 53b0cd2..5251025 100644
--- a/core/libexec/methods.lisp
+++ b/core/libexec/methods.lisp
@@ -212,13 +212,11 @@
(format stream "~a~%"
(a:random-elt '("You feel like you're gonna mess yourself"
"You clench hard trying to avoid messing"
- "You fart a little due to the pressure"
"Aww, does the baby need to potty?"))))
(defmethod output-process-potty-text ((user player) padding (type (eql :mess)) (action (eql :desparate)) had-accident &key (stream *standard-output*))
(format stream "~a~%"
(a:random-elt '("You feel like you're gonna mess yourself"
"You clench hard trying to avoid messing"
- "You fart a little due to the pressure"
"Aww, does the baby need to potty?"))))
(defmethod output-process-potty-text ((user player) padding (type (eql :mess)) (action (eql :need-to-potty)) had-accident &key (stream *standard-output*))
(format stream "You need to poo~%"))
@@ -235,7 +233,6 @@
""))
,(format nil "Heh, the baby blorted ~a pamps." (if (malep user) "his" "her"))
"Your struggle to hold it in, but your bowels decide to empty themselves anyway"
- "You try to fart to relieve the pressure, except it wasn't a fart"
"You end up messing your self"
"The back of your diaper expands as you accidentally mess yourself")))
(when (filter-items (wear-of user) '(and diaper ab-clothing))
@@ -257,7 +254,6 @@
" with your tail up"
""))
"Your struggle to hold it in, but your bowels decide to empty themselves anyway"
- "You try to fart to relieve the pressure, except it wasn't a fart"
"You end up messing your self"
"The back of your pullups expands as you accidentally mess yourself")))
(when (filter-items (wear-of user) '(or ab-clothing pullup))
@@ -279,7 +275,6 @@
" with your tail up"
""))
"Your struggle to hold it in, but your bowels decide to empty themselves anyway"
- "You try to fart to relieve the pressure, except it wasn't a fart"
"You end up messing your self"
"a lump forms at the seat of your pants")))
(when (and (cdr had-accident) (> (getf (cdr had-accident) :leak-amount) 0))
@@ -300,7 +295,6 @@
" with your tail up"
""))
"Your struggle to hold it in, but your bowels decide to empty themselves anyway"
- "You try to fart to relieve the pressure, except it wasn't a fart"
"You end up messing your self")))
(when (and (cdr had-accident) (> (getf (cdr had-accident) :leak-amount) 0))
(format stream "~a~%"
@@ -792,8 +786,6 @@
(progn (with-output-to-string (s)
(format s "*~a is doing a potty dance like a 5 year old*~%~%" user-name))
(with-output-to-string (s)
- (format s "*~a farts to relieve the pressure*~%~%" user-name))
- (with-output-to-string (s)
(format s "*~a is bouncing up and down with ~a knees pressed together holding ~aself*~%~%"
user-name hisher (if male "him" "her")))
(with-output-to-string (s)
diff --git a/data/moves/regular.lisp b/data/moves/regular.lisp
index 6d7a797..7bc1d09 100644
--- a/data/moves/regular.lisp
+++ b/data/moves/regular.lisp
@@ -202,59 +202,45 @@
(f:fmt t (name-of user) " used " (name-of attack) #\Newline
"But it failed." #\Newline))
(defmethod attack ((target base-character) (user bowels-character) (attack fart))
- (f:fmt t (name-of user) " squats down and tries to use " (name-of attack) #\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)
- (let* ((padding (get-babyish-padding user))
- (malep (malep user))
- (name (name-of user))
- (his/her (if malep "his" "her"))
- (he/she (if malep "he" "she"))
- (himherself (if malep "himself" "herself")))
- (f:fmt t "*SPLORCH*" #\Newline
- 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))))
- ((and (>= (bowels/contents-of user) (bowels/potty-desperate-limit-of user)))
- (mess :messer user)
- (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 " 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))))
- ((>= (bowels/contents-of user) (bowels/need-to-potty-limit-of user))
- (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)))
- (t (f:fmt t "Nothing happened" #\Newline))))
+ (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 (move) ()
(:default-initargs
:name "Spank"
diff --git a/data/team-members/allies.lisp b/data/team-members/allies.lisp
index ae086e5..a4de269 100644
--- a/data/team-members/allies.lisp
+++ b/data/team-members/allies.lisp
@@ -18,6 +18,13 @@
: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) &rest args &key &allow-other-keys)
(destructuring-bind (&key (bladder/contents nil bladderp) (bowels/contents nil bowelsp) &allow-other-keys)
diff --git a/packages.lisp b/packages.lisp
index 488e3b3..c4f5482 100644
--- a/packages.lisp
+++ b/packages.lisp
@@ -132,6 +132,8 @@
#:fill-bowels
#:bladder/fill-rate
#:bowels/fill-rate
+ #:fart
+ #:fart-result-text
;;constructors
#:make-action
;;classes
@@ -230,6 +232,7 @@
#:bowels/potty-dance-limit-of
#:bowels/potty-desperate-limit-of
#:bowels/maximum-limit-of
+ #:fart-count-of
#:moves-of
#:exp-of
#:user-of
@@ -359,7 +362,8 @@
#:place
#:reload
#:place-prop
- #:take-prop)
+ #:take-prop
+ #:fart)
(: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