aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Pouar <pouar@pouar.net>2020-08-31 09:46:33 -0500
committerGravatar Pouar <pouar@pouar.net>2020-08-31 09:46:33 -0500
commite1d15bba0d28b177f28989a4b493fc993bb95598 (patch)
tree8be08984d3dbccf91db4f210cbc3abcb64bdf61a
parentStart making use of &aux. (diff)
indention
-rw-r--r--appveyor-build-docs.lisp8
-rw-r--r--appveyor-build.lisp10
-rw-r--r--asdf/yadfa-asdf.lisp38
-rw-r--r--build.lisp2
-rw-r--r--ci/ccl-init.lisp36
-rw-r--r--core/bin/battle.lisp92
-rw-r--r--core/bin/bin.lisp706
-rw-r--r--core/bin/world.lisp252
-rw-r--r--core/classes.lisp6
-rw-r--r--core/declt-patches.lisp2
-rw-r--r--core/init.lisp56
-rw-r--r--core/libexec/functions.lisp1512
-rw-r--r--core/libexec/generic-functions.lisp8
-rw-r--r--core/libexec/macros.lisp106
-rw-r--r--core/libexec/methods.lisp344
-rw-r--r--core/mcclim.lisp158
-rw-r--r--core/patches.lisp184
-rw-r--r--core/util.lisp34
-rw-r--r--data/element-types/abdl.lisp4
-rw-r--r--data/element-types/pokemon.lisp148
-rw-r--r--data/enemies/haunted.lisp24
-rw-r--r--data/enemies/navy.lisp18
-rw-r--r--data/enemies/pirates.lisp8
-rw-r--r--data/enemies/raccoon-bandits.lisp14
-rw-r--r--data/enemies/rpgmaker.lisp26
-rw-r--r--data/epilog/allies.lisp50
-rw-r--r--data/epilog/blackjack.lisp174
-rw-r--r--data/epilog/enemies.lisp6
-rw-r--r--data/epilog/items.lisp90
-rw-r--r--data/epilog/puzzle.lisp146
-rw-r--r--data/epilog/pyramid.lisp292
-rw-r--r--data/events/bandits-domain.lisp58
-rw-r--r--data/events/lukurbo.lisp28
-rw-r--r--data/events/pirates-cove.lisp20
-rw-r--r--data/events/pyramid.lisp16
-rw-r--r--data/items/clothes.lisp4
-rw-r--r--data/items/consumable.lisp6
-rw-r--r--data/items/diaper.lisp30
-rw-r--r--data/items/weapons.lisp2
-rw-r--r--data/map/bandits-domain.lisp378
-rw-r--r--data/map/debug-map.lisp100
-rw-r--r--data/map/haunted-forest.lisp306
-rw-r--r--data/map/haunted-house.lisp180
-rw-r--r--data/map/home.lisp82
-rw-r--r--data/map/ironside.lisp310
-rw-r--r--data/map/lukurbo.lisp10
-rw-r--r--data/map/peachs-castle-wannabe.lisp434
-rw-r--r--data/map/pirates-cove.lisp82
-rw-r--r--data/map/pyramid.lisp26
-rw-r--r--data/map/rpgmaker-dungeon.lisp34
-rw-r--r--data/map/secret-underground.lisp84
-rw-r--r--data/map/silver-cape.lisp420
-rw-r--r--data/map/sky.lisp328
-rw-r--r--data/map/your-ship.lisp300
-rw-r--r--data/moves/pokemon.lisp18
-rw-r--r--data/moves/regular.lisp68
-rw-r--r--data/prolog/enemies.lisp2
-rw-r--r--data/prolog/map.lisp28
-rw-r--r--data/props/base.lisp150
-rw-r--r--data/team-members/catchables.lisp2
-rwxr-xr-xrun.lisp2
-rw-r--r--t/main.lisp22
62 files changed, 4042 insertions, 4042 deletions
diff --git a/appveyor-build-docs.lisp b/appveyor-build-docs.lisp
index cda5ff3..dd7b7a4 100644
--- a/appveyor-build-docs.lisp
+++ b/appveyor-build-docs.lisp
@@ -12,10 +12,10 @@
:prompt nil)
#|
(when (and
- (ql-dist:find-dist "ultralisp")
- (ql-dist:installedp (ql-dist:find-dist "ultralisp")))
- (ql-dist:install-dist "http://dist.ultralisp.org/"
- :prompt nil))
+(ql-dist:find-dist "ultralisp")
+(ql-dist:installedp (ql-dist:find-dist "ultralisp")))
+(ql-dist:install-dist "http://dist.ultralisp.org/"
+:prompt nil))
|#
(ql:quickload :yadfa)
(in-package :yadfa)
diff --git a/appveyor-build.lisp b/appveyor-build.lisp
index 1d2a0aa..ca81db1 100644
--- a/appveyor-build.lisp
+++ b/appveyor-build.lisp
@@ -12,14 +12,14 @@
:prompt nil)
#|
(when (and
- (ql-dist:find-dist "ultralisp")
- (ql-dist:installedp (ql-dist:find-dist "ultralisp")))
- (ql-dist:install-dist "http://dist.ultralisp.org/"
- :prompt nil))
+(ql-dist:find-dist "ultralisp")
+(ql-dist:installedp (ql-dist:find-dist "ultralisp")))
+(ql-dist:install-dist "http://dist.ultralisp.org/"
+:prompt nil))
|#
(ql:quickload (loop for i in (asdf:system-depends-on (asdf:find-system :yadfa))
when (stringp i) collect i
- when (and (listp i) (eq (first i) :feature) (uiop:featurep (second i))) collect (third i)))
+ when (and (listp i) (eq (first i) :feature) (uiop:featurep (second i))) collect (third i)))
(declaim (optimize (debug 2) safety))
(setf *read-default-float-format* 'long-float)
(ql:quickload :yadfa)
diff --git a/asdf/yadfa-asdf.lisp b/asdf/yadfa-asdf.lisp
index a905e70..c4476d1 100644
--- a/asdf/yadfa-asdf.lisp
+++ b/asdf/yadfa-asdf.lisp
@@ -33,17 +33,17 @@
(defmethod asdf:output-files ((o asdf:compile-op) (c make))
(let ((input (car (asdf:input-files o c))))
(values (iter (for output in (outputs c))
- (collect (create-pathname output (uiop:pathname-directory-pathname input))))
+ (collect (create-pathname output (uiop:pathname-directory-pathname input))))
t)))
(defmethod asdf:output-files ((o asdf:compile-op) (c declt-texi))
(let ((input (first (asdf:input-files o c))))
(values (uiop:with-input-file (s input)
(iter (handler-case (collect (destructuring-bind (system-name &rest keys
- &key (texi-name (if (stringp system-name)
- system-name
- (string-downcase system-name)))
- (texi-directory #p"./")
- &allow-other-keys)
+ &key (texi-name (if (stringp system-name)
+ system-name
+ (string-downcase system-name)))
+ (texi-directory #p"./")
+ &allow-other-keys)
(read s)
(declare (ignore keys))
(merge-pathnames (make-pathname :name texi-name :type "texi")
@@ -57,13 +57,13 @@
(outputs (asdf:output-files o c)))
(uiop:with-input-file (s input)
(iter (for output in outputs)
- (handler-case (collect (destructuring-bind (system-name &rest keys &key &allow-other-keys)
- (read s)
- (let ((keys (copy-tree keys)))
- (setf (getf keys :texi-name) (pathname-name output))
- (setf (getf keys :texi-directory) (uiop:pathname-directory-pathname output))
- (apply 'net.didierverna.declt:declt system-name keys))))
- (end-of-file () (finish)))))))
+ (handler-case (collect (destructuring-bind (system-name &rest keys &key &allow-other-keys)
+ (read s)
+ (let ((keys (copy-tree keys)))
+ (setf (getf keys :texi-name) (pathname-name output))
+ (setf (getf keys :texi-directory) (uiop:pathname-directory-pathname output))
+ (apply 'net.didierverna.declt:declt system-name keys))))
+ (end-of-file () (finish)))))))
(defmethod asdf:output-files ((o asdf:compile-op) (c bibtex-texi))
(let ((path (first (asdf:input-files o c))))
(values (list (make-pathname :host (pathname-host path) :device (pathname-device path) :directory (pathname-directory path)
@@ -86,11 +86,11 @@
(format nil "@abbr{~a.} ~a@comma{} ~a"
(aref local-time:+short-month-names+ month) day year)))
("url" . (format nil "URL:@url{~a}" this))))
- (collect `(let ((this (bibtex-runtime:bib-entry-ref ,(car i) v)))
- (when this
- (if ',(cdr i) ,(cdr i) this))))))))
+ (collect `(let ((this (bibtex-runtime:bib-entry-ref ,(car i) v)))
+ (when this
+ (if ',(cdr i) ,(cdr i) this))))))))
(bibtex-runtime:read-bib-database in)
(iter (for (k v) in-hashtable bibtex-runtime:*bib-database*)
- (format out "@ifset ~aisref~%@item ~a @anchor{~a}~%~%~{~a.~^ ~}~%@end ifset~%" k k k
- (iter (for i in (generate-entries))
- (when i (collect i)))))))))))
+ (format out "@ifset ~aisref~%@item ~a @anchor{~a}~%~%~{~a.~^ ~}~%@end ifset~%" k k k
+ (iter (for i in (generate-entries))
+ (when i (collect i)))))))))))
diff --git a/build.lisp b/build.lisp
index f1fa4ce..31c83a2 100644
--- a/build.lisp
+++ b/build.lisp
@@ -34,7 +34,7 @@
(let ((*compile-verbose* nil) (*compile-print* nil))
(ql:quickload (loop for i in (asdf:system-depends-on (asdf:find-system :yadfa))
when (stringp i) collect i
- when (and (listp i) (eq (first i) :feature) (uiop:featurep (second i))) collect (third i)))
+ when (and (listp i) (eq (first i) :feature) (uiop:featurep (second i))) collect (third i)))
(declaim (optimize (debug 2) safety))
(ql:quickload :yadfa))
(when (find "immutable" (uiop:command-line-arguments) :test #'string=)
diff --git a/ci/ccl-init.lisp b/ci/ccl-init.lisp
index ea908cc..bdac054 100644
--- a/ci/ccl-init.lisp
+++ b/ci/ccl-init.lisp
@@ -11,17 +11,17 @@
(:socket
(rlet ((infds #>fd_set)
(tv :timeval :tv_sec 0 :tv_usec 0))
- (fd-zero infds)
- (fd-set fd infds)
- (when (and milliseconds (>= milliseconds 0))
- (multiple-value-bind (seconds millis)
- (floor milliseconds 1000)
- (setf (pref tv :timeval.tv_sec) seconds
- (pref tv :timeval.tv_usec) (* 1000 millis))))
- (let* ((result (#_select 1 infds (%null-ptr) (%null-ptr) (if (and milliseconds (>= milliseconds 0)) tv (%null-ptr)))))
- (cond ((> result 0) (values t 0))
- ((= result 0) (values nil 0))
- (t (values nil (- (#_GetLastError))))))))
+ (fd-zero infds)
+ (fd-set fd infds)
+ (when (and milliseconds (>= milliseconds 0))
+ (multiple-value-bind (seconds millis)
+ (floor milliseconds 1000)
+ (setf (pref tv :timeval.tv_sec) seconds
+ (pref tv :timeval.tv_usec) (* 1000 millis))))
+ (let* ((result (#_select 1 infds (%null-ptr) (%null-ptr) (if (and milliseconds (>= milliseconds 0)) tv (%null-ptr)))))
+ (cond ((> result 0) (values t 0))
+ ((= result 0) (values nil 0))
+ (t (values nil (- (#_GetLastError))))))))
(:pipe (if (data-available-on-pipe-p fd)
(values t 0)
(if (and milliseconds (> milliseconds 0))
@@ -29,19 +29,19 @@
(values nil 0))))
(:file (let* ((curpos (fd-tell fd))
(eofpos (%stack-block ((peofpos 8))
- (#_GetFileSizeEx (%int-to-ptr fd) peofpos)
- (%%get-unsigned-longlong peofpos 0))))
+ (#_GetFileSizeEx (%int-to-ptr fd) peofpos)
+ (%%get-unsigned-longlong peofpos 0))))
(values (< curpos eofpos) 0)))
;;(:character-special (windows-tty-input-available-p fd milliseconds))
(t (values nil 0)))
#-windows-target
(rlet ((pollfds (:array (:struct :pollfd) 1)))
- (setf (pref (paref pollfds (:* (:struct :pollfd)) 0) :pollfd.fd) fd
- (pref (paref pollfds (:* (:struct :pollfd)) 0) :pollfd.events) #$POLLIN)
- (let* ((res (int-errno-call (#_poll pollfds 1 (or milliseconds -1)))))
- (declare (fixnum res))
- (values (> res 0) res)))))
+ (setf (pref (paref pollfds (:* (:struct :pollfd)) 0) :pollfd.fd) fd
+ (pref (paref pollfds (:* (:struct :pollfd)) 0) :pollfd.events) #$POLLIN)
+ (let* ((res (int-errno-call (#_poll pollfds 1 (or milliseconds -1)))))
+ (declare (fixnum res))
+ (values (> res 0) res)))))
(in-package :cl-user)
;;; The following lines added by ql:add-to-init-file:
#-quicklisp
diff --git a/core/bin/battle.lisp b/core/bin/battle.lisp
index b519317..1662651 100644
--- a/core/bin/battle.lisp
+++ b/core/bin/battle.lisp
@@ -1,9 +1,9 @@
;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa"; coding: utf-8-unix; -*-
(in-package :yadfa)
(defunassert yadfa-battle:fight (attack &key target friendly-target)
- (target (or null unsigned-byte type-specifier)
- friendly-target (or null unsigned-byte type-specifier)
- attack (or symbol boolean))
+ (target (or null unsigned-byte type-specifier)
+ friendly-target (or null unsigned-byte type-specifier)
+ attack (or symbol boolean))
"Use a move on an enemy. @var{ATTACK} is either a keyword which is the indicator to select an attack that you know, or @code{T} for default. @var{TARGET} is the index or type specifier of the enemy you're attacking. @var{FRIENDLY-TARGET} is a member on your team you're using the move on instead. Only specify either a @var{FRIENDLY-TARGET} or @var{TARGET}. Setting both might make the game's code unhappy"
(let ((selected-target (cond (target
(let ((a (typecase target
@@ -26,12 +26,12 @@
(write-line "That target doesn't exist")
(return-from yadfa-battle:fight)))))
(t (iter (for i in (enemies-of *battle*))
- (when (>= (health-of i) 0)
- (leave i)))))))
+ (when (>= (health-of i) 0)
+ (leave i)))))))
(process-battle :attack attack :selected-target selected-target)))
(defunassert yadfa-battle:stats (&key user enemy)
- (user (or unsigned-byte null)
- enemy (or unsigned-byte null))
+ (user (or unsigned-byte null)
+ enemy (or unsigned-byte null))
"Prints the current stats in battle, essentially this game's equivalent of a health and energy bar in battle. @var{USER} is the index of the member in your team, @var{ENEMY} is the index of the enemy in battle. Set both to @code{NIL} to show the stats for everyone."
(cond (user
(present-stats (nth user (team-of *game*))))
@@ -40,10 +40,10 @@
(t
(format t "Your team:~%~%")
(iter (for i in (team-of *game*))
- (present-stats i))
+ (present-stats i))
(format t "Their team:~%~%")
(iter (for i in (enemies-of *battle*))
- (present-stats i)))))
+ (present-stats i)))))
(defun yadfa-battle:run ()
"Run away from a battle like a coward"
(cond ((continue-battle-of (get-zone (position-of (player-of *game*))))
@@ -80,9 +80,9 @@
(s:nix *battle*)
(switch-user-packages))
(defunassert yadfa-battle:use-item (item &key target enemy-target)
- (item (or unsigned-byte type-specifier)
- target (or null unsigned-byte type-specifier)
- enemy-target (or null unsigned-byte type-specifier))
+ (item (or unsigned-byte type-specifier)
+ target (or null unsigned-byte type-specifier)
+ enemy-target (or null unsigned-byte type-specifier))
"Uses an item. @var{ITEM} is an index of an item in your inventory. @var{TARGET} is an index or type specifier of a character in your team. Setting this to 0 will use it on yourself. @var{ENEMY-TARGET} is an index or type specifier of an enemy in battle if you're using it on an enemy in battle. Only specify either a @var{TARGET} or @var{ENEMY-TARGET}. Setting both might make the game's code unhappy"
(handle-user-input ((selected-item (typecase item
(unsigned-byte
@@ -107,25 +107,25 @@
:test (lambda (o e)
(typep e o)))))))
(t (iter (for i in (enemies-of *battle*))
- (when (>= (health-of i) 0)
- (leave i)))))))
- (*query-io* ((not selected-item)
- (item)
- :error-text (format nil "You don't have that item~%")
- :prompt-text "Enter a different item")
- ((and target (not selected-target))
- (target)
- :error-text "That target doesn't exist"
- :prompt-text "Enter a different TARGET")
- ((and enemy-target (not selected-target))
- (enemy-target)
- :error-text "That target doesn't exist"
- :prompt-text "Enter a different ENEMY-TARGET"))
- (process-battle
- :item selected-item
- :selected-target selected-target)))
+ (when (>= (health-of i) 0)
+ (leave i)))))))
+ (*query-io* ((not selected-item)
+ (item)
+ :error-text (format nil "You don't have that item~%")
+ :prompt-text "Enter a different item")
+ ((and target (not selected-target))
+ (target)
+ :error-text "That target doesn't exist"
+ :prompt-text "Enter a different TARGET")
+ ((and enemy-target (not selected-target))
+ (enemy-target)
+ :error-text "That target doesn't exist"
+ :prompt-text "Enter a different ENEMY-TARGET"))
+ (process-battle
+ :item selected-item
+ :selected-target selected-target)))
(defunassert yadfa-battle:reload (&optional ammo-type)
- (ammo-type (or null type-specifier))
+ (ammo-type (or null type-specifier))
(let* ((inventory (inventory-of (player-of *game*)))
(user (first (turn-queue-of *battle*)))
(user-name (name-of user))
@@ -145,21 +145,21 @@
(return-from yadfa-battle:reload))
(handle-user-input ((selected-ammo-type (or ammo-type
(iter (for i in inventory)
- (when (typep i weapon-ammo-type)
- (leave i)))
+ (when (typep i weapon-ammo-type)
+ (leave i)))
(progn (format t "~a doesn't have any ammo~%" (name-of user))
(return-from yadfa-battle:reload)))))
- (*query-io*
- ((and ammo-type (not (subtypep ammo-type weapon-ammo-type)))
- (ammo-type)
- :error-text (format nil "~a ~a doesn't take that ammo"
- user-name
- weapon-name)
- :prompt-text "Select different ammo")
- ((and ammo-type (iter (for i in inventory)
- (when (typep i ammo-type)
- (leave t))))
- (ammo-type)
- :error-text (format nil "~a doesn't have that ammo" user-name)
- :prompt-text "Select different ammo"))
- (process-battle :reload selected-ammo-type))))
+ (*query-io*
+ ((and ammo-type (not (subtypep ammo-type weapon-ammo-type)))
+ (ammo-type)
+ :error-text (format nil "~a ~a doesn't take that ammo"
+ user-name
+ weapon-name)
+ :prompt-text "Select different ammo")
+ ((and ammo-type (iter (for i in inventory)
+ (when (typep i ammo-type)
+ (leave t))))
+ (ammo-type)
+ :error-text (format nil "~a doesn't have that ammo" user-name)
+ :prompt-text "Select different ammo"))
+ (process-battle :reload selected-ammo-type))))
diff --git a/core/bin/bin.lisp b/core/bin/bin.lisp
index b37a050..5462fe3 100644
--- a/core/bin/bin.lisp
+++ b/core/bin/bin.lisp
@@ -1,7 +1,7 @@
;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa"; coding: utf-8-unix; -*-
(in-package :yadfa)
(defunassert yadfa-bin:get-inventory-of-type (type)
- (type type-specifier)
+ (type type-specifier)
(get-positions-of-type type (inventory-of (player-of *game*))))
(defun yadfa-bin:reload-files (&rest keys &key compiler-verbose &allow-other-keys)
"Intended for developers. Use this to recompile the game without having to close it. Accepts the same keyword arguments as @code{ASDF:LOAD-SYSTEM} and @code{ASDF:OPERATE}. Set @var{COMPILER-VERBOSE} to @code{T} to print the compiling messages. setting @var{LOAD-SOURCE} to @code{T} will avoid creating fasls"
@@ -15,7 +15,7 @@
~a."
(xref yadfa-bin:disable-mods :function))
(let ((systems (iter (for i in (a:ensure-list systems))
- (collect (asdf:coerce-name i)))))
+ (collect (asdf:coerce-name i)))))
(dolist (system (remove-duplicates systems :test #'string=))
(asdf:find-system system))
(dolist (system systems)
@@ -32,7 +32,7 @@
~a."
(xref yadfa-bin:enable-mods :function))
(let ((systems (delete-duplicates (iter (for i in (a:ensure-list systems))
- (collect (asdf:coerce-name i)))
+ (collect (asdf:coerce-name i)))
:test #'string=)))
(a:deletef *mods* systems :test (lambda (o e)
(member e o :test #'string=)))
@@ -42,7 +42,7 @@
(write *mods* :stream stream)))
systems)
(defunassert yadfa-bin:toggle-onesie (&key wear user)
- (wear (or type-specifier unsigned-byte null) user (or type-specifier unsigned-byte null))
+ (wear (or type-specifier unsigned-byte null) user (or type-specifier unsigned-byte null))
"Open or closes your onesie. @var{WEAR} is the index of a onesie. Leave @code{NIL} for the outermost onesie. @var{USER} is the index of an ally. Leave @code{NIL} to refer to yourself"
(handle-user-input ((allies-length (list-length (allies-of *game*)))
(inventory-length (list-length (wear-of (player-of *game*))))
@@ -55,109 +55,109 @@
(nthcdr wear (wear-of (player-of *game*)))
(member wear (wear-of (player-of *game*)) :test (lambda (o e)
(typep e o)))))))
- (*query-io* ((and user (numberp user) (>= user allies-length))
- (user)
- :prompt-text "Enter a different ally"
- :error-text (format nil "You only have ~d allies" allies-length))
- ((and user (typep user 'type-specifier) (not selected-user))
- (user)
- :prompt-text "Enter a different ally"
- :error-text (format nil "Ally ~s doesn't exist" user))
- ((and wear (numberp wear) (>= wear inventory-length))
- (wear)
- :prompt-text "Select a different clothing"
- :error-text (format nil "You're only wearing ~a items" inventory-length))
- ((and wear (typep wear 'type-specifier) (not selected-wear))
- (wear)
- :prompt-text "Select a different clothing"
- :error-text (format nil "You're not wearing that item"))
- ((let ((selected-wear (if wear
- selected-wear
- (iter (for item on (wear-of selected-user))
- (when (typep (car item) 'onesie)
- (leave item))
- (finally (format t "~a isn't wearing a onesie"
- (name-of selected-user)))))))
- (handler-case (progn (toggle-onesie (car selected-wear) selected-wear selected-user)
- (let* ((male (malep selected-user))
- (hisher (if male "his" "her"))
- (onesie (car selected-wear)))
- (if (typep (car selected-wear) 'onesie/closed)
- (format t "~a snaps ~a ~a~%~%"
- (name-of selected-user)
- hisher
- (name-of onesie))
- (format t "~a unsnaps ~a ~a~%~%"
- (name-of selected-user)
- hisher
- (name-of onesie)))))
- (onesie-too-thick (c)
- (let* ((user (user-of c))
- (clothes (clothes-of c))
- (male (malep user))
- (hisher (if male "his" "her")))
- (format t "~a struggles to snap the bottom of ~a ~a like a toddler who can't dress ~aself but ~a ~a is too thick~%~%"
- (name-of user)
- hisher
- (name-of (car clothes))
- (if male "him" "her")
- hisher
- (name-of (thickest (cdr clothes))))))
- (onesie-locked (c)
- (let ((user (user-of c)))
- (format t "~a can't unsnap ~a ~a as it's locked~%~%"
- (name-of user)
- (if (malep user) "his" "her")
- (name-of (car (clothes-of c)))))))
- nil)
- (wear)
- :prompt-text "Select a different clothing"))))
+ (*query-io* ((and user (numberp user) (>= user allies-length))
+ (user)
+ :prompt-text "Enter a different ally"
+ :error-text (format nil "You only have ~d allies" allies-length))
+ ((and user (typep user 'type-specifier) (not selected-user))
+ (user)
+ :prompt-text "Enter a different ally"
+ :error-text (format nil "Ally ~s doesn't exist" user))
+ ((and wear (numberp wear) (>= wear inventory-length))
+ (wear)
+ :prompt-text "Select a different clothing"
+ :error-text (format nil "You're only wearing ~a items" inventory-length))
+ ((and wear (typep wear 'type-specifier) (not selected-wear))
+ (wear)
+ :prompt-text "Select a different clothing"
+ :error-text (format nil "You're not wearing that item"))
+ ((let ((selected-wear (if wear
+ selected-wear
+ (iter (for item on (wear-of selected-user))
+ (when (typep (car item) 'onesie)
+ (leave item))
+ (finally (format t "~a isn't wearing a onesie"
+ (name-of selected-user)))))))
+ (handler-case (progn (toggle-onesie (car selected-wear) selected-wear selected-user)
+ (let* ((male (malep selected-user))
+ (hisher (if male "his" "her"))
+ (onesie (car selected-wear)))
+ (if (typep (car selected-wear) 'onesie/closed)
+ (format t "~a snaps ~a ~a~%~%"
+ (name-of selected-user)
+ hisher
+ (name-of onesie))
+ (format t "~a unsnaps ~a ~a~%~%"
+ (name-of selected-user)
+ hisher
+ (name-of onesie)))))
+ (onesie-too-thick (c)
+ (let* ((user (user-of c))
+ (clothes (clothes-of c))
+ (male (malep user))
+ (hisher (if male "his" "her")))
+ (format t "~a struggles to snap the bottom of ~a ~a like a toddler who can't dress ~aself but ~a ~a is too thick~%~%"
+ (name-of user)
+ hisher
+ (name-of (car clothes))
+ (if male "him" "her")
+ hisher
+ (name-of (thickest (cdr clothes))))))
+ (onesie-locked (c)
+ (let ((user (user-of c)))
+ (format t "~a can't unsnap ~a ~a as it's locked~%~%"
+ (name-of user)
+ (if (malep user) "his" "her")
+ (name-of (car (clothes-of c)))))))
+ nil)
+ (wear)
+ :prompt-text "Select a different clothing"))))
(defunassert yadfa-bin:lst (&key inventory inventory-group props wear user directions moves position map descriptions describe-zone)
- (user (or unsigned-byte boolean)
- map (or boolean integer)
- inventory type-specifier)
+ (user (or unsigned-byte boolean)
+ map (or boolean integer)
+ inventory type-specifier)
"used to list various objects and properties, @var{INVENTORY} takes a type specifier for the items you want to list in your inventory. setting @var{INVENTORY} to @code{T} will list all the items. @var{INVENTORY-GROUP} is similar to @var{INVENTORY}, but will group the items by class name. @var{WEAR} is similar to @var{INVENTORY} but lists clothes you're wearing instead. setting @var{DIRECTIONS} to non-NIL will list the directions you can walk.setting @var{MOVES} to non-NIL will list the moves you know. setting @var{USER} to @code{T} will cause @var{MOVES} and @var{WEAR} to apply to the player, setting it to an integer will cause it to apply it to an ally. Leaving it at @code{NIL} will cause it to apply to everyone. setting @var{POSITION} to true will print your current position. Setting @var{MAP} to a number will print the map with the floor number set to @var{MAP}, setting @var{MAP} to @code{T} will print the map of the current floor you're on. When printing the map in McCLIM, red means there's a warp point, dark green is the zone with the player, blue means there are stairs. These 3 colors will blend with each other to make the final color"
(let ((allies-length (list-length (allies-of *game*))))
(labels ((format-table (header &rest body)
(c:formatting-table (t :x-spacing 20)
- (c:with-text-style (*query-io* (c:make-text-style nil :bold nil))
- (c:formatting-row ()
- (iter (for cell in header)
- (c:formatting-cell ()
- (typecase cell
- (string (write-string cell))
- (t (write cell)))))))
- (iter (for row in body)
- (c:formatting-row ()
- (iter (for cell in row)
- (c:formatting-cell ()
- (typecase cell
- (string (write-string cell))
- (t (write cell)))))))))
+ (c:with-text-style (*query-io* (c:make-text-style nil :bold nil))
+ (c:formatting-row ()
+ (iter (for cell in header)
+ (c:formatting-cell ()
+ (typecase cell
+ (string (write-string cell))
+ (t (write cell)))))))
+ (iter (for row in body)
+ (c:formatting-row ()
+ (iter (for cell in row)
+ (c:formatting-cell ()
+ (typecase cell
+ (string (write-string cell))
+ (t (write cell)))))))))
(format-items (list item &optional user)
(format t "Number of items listed: ~a~%~%" (iter (with j = 0)
- (for i in list)
- (when (typep i item)
- (incf j))
- (finally (return j))))
+ (for i in list)
+ (when (typep i item)
+ (incf j))
+ (finally (return j))))
(when user
(format t "~a:~%~%" (name-of user)))
(apply #'format-table '("Index" "Name" "Class" "Wet" "Wetcap" "Mess" "Messcap")
(let ((j 0)) (iter (for i in list)
- (when (typep i item)
- (collect (list j
- (name-of i)
- (type-of i)
- (if (typep i 'closed-bottoms) (coerce (sogginess-of i) 'long-float) nil)
- (if (typep i 'closed-bottoms) (coerce (sogginess-capacity-of i) 'long-float) nil)
- (if (typep i 'closed-bottoms) (coerce (messiness-of i) 'long-float) nil)
- (if (typep i 'closed-bottoms) (coerce (messiness-capacity-of i) 'long-float) nil))))
- (incf j)))))
+ (when (typep i item)
+ (collect (list j
+ (name-of i)
+ (type-of i)
+ (if (typep i 'closed-bottoms) (coerce (sogginess-of i) 'long-float) nil)
+ (if (typep i 'closed-bottoms) (coerce (sogginess-capacity-of i) 'long-float) nil)
+ (if (typep i 'closed-bottoms) (coerce (messiness-of i) 'long-float) nil)
+ (if (typep i 'closed-bottoms) (coerce (messiness-capacity-of i) 'long-float) nil))))
+ (incf j)))))
(format-moves (user)
(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 (class-name (class-of i)) (name-of i) (description-of i)))))))
(format-user (user)
(format t "Name: ~a~%Species: ~a~%Description: ~a~%~%"
(name-of user)
@@ -170,7 +170,7 @@
(check-allies)
(when inventory
(with-effective-frame
- (format-items (inventory-of (player-of *game*)) inventory)))
+ (format-items (inventory-of (player-of *game*)) inventory)))
(when describe-zone
(format t "~a~%" (get-zone-text (description-of (typecase describe-zone
(zone describe-zone)
@@ -178,43 +178,43 @@
(t (get-zone (position-of (player-of *game*)))))))))
(when inventory-group
(with-effective-frame
- (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)))))
- (apply #'format-table '("Class Name" "Name" "Quantity")
- (iter (for (key value) on a by #'cddr)
- (collect (apply 'list key value)))))))
+ (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)))))
+ (apply #'format-table '("Class Name" "Name" "Quantity")
+ (iter (for (key value) on a by #'cddr)
+ (collect (apply 'list key value)))))))
(when wear
(with-effective-frame
- (cond ((not user)
- (format-items (wear-of (player-of *game*)) wear (player-of *game*))
- (iter (for k in (allies-of *game*))
- (format-items (wear-of k) wear k)))
- ((typep user 'integer)
- (let ((selected-ally (nth user (allies-of *game*))))
- (check-allies)
- (format-items (wear-of selected-ally) wear selected-ally)))
- (t
- (format-items (wear-of (player-of *game*)) wear (player-of *game*))))))
+ (cond ((not user)
+ (format-items (wear-of (player-of *game*)) wear (player-of *game*))
+ (iter (for k in (allies-of *game*))
+ (format-items (wear-of k) wear k)))
+ ((typep user 'integer)
+ (let ((selected-ally (nth user (allies-of *game*))))
+ (check-allies)
+ (format-items (wear-of selected-ally) wear selected-ally)))
+ (t
+ (format-items (wear-of (player-of *game*)) wear (player-of *game*))))))
(when moves
(with-effective-frame
- (cond ((typep user 'real)
- (let ((selected-ally (nth user (allies-of *game*))))
- (format-moves selected-ally)))
- ((not user)
- (format-moves (player-of *game*))
- (iter (for k in (allies-of *game*))
- (format-moves k)))
- (t (format-moves (player-of *game*))))))
+ (cond ((typep user 'real)
+ (let ((selected-ally (nth user (allies-of *game*))))
+ (format-moves selected-ally)))
+ ((not user)
+ (format-moves (player-of *game*))
+ (iter (for k in (allies-of *game*))
+ (format-moves k)))
+ (t (format-moves (player-of *game*))))))
(when props
(with-effective-frame
- (apply #'format-table '("Keyword" "Object")
- (iter (for (a b) on (get-props-from-zone (position-of (player-of *game*))) by #'cddr)
- (when b
- (collect (list a (name-of b))))))))
+ (apply #'format-table '("Keyword" "Object")
+ (iter (for (a b) on (get-props-from-zone (position-of (player-of *game*))) by #'cddr)
+ (when b
+ (collect (list a (name-of b))))))))
(let ((player-position (position-of (player-of *game*))))
(declare (type list player-position))
(destructuring-bind (x y z map) player-position
@@ -246,8 +246,8 @@
(z '(0 0 -1) :down x-y-z player-position map)
(when (warp-points-of (get-zone (position-of (player-of *game*))))
(iter (for (a b) on (warp-points-of (get-zone (position-of (player-of *game*)))) by #'cddr)
- (when (and (get-zone b) (not (hiddenp (get-zone b))))
- (format t "~s ~a~%" a (name-of (get-zone b)))))))))))
+ (when (and (get-zone b) (not (hiddenp (get-zone b))))
+ (format t "~s ~a~%" a (name-of (get-zone b)))))))))))
(when position
(format t "Your current position is ~s~%" (position-of (player-of *game*))))
(when map
@@ -267,12 +267,12 @@
(t
(format-user (player-of *game*))
(iter (for i in (allies-of *game*))
- (format t "Name: ~a~%Species: ~a~%Description: ~a~%~%" (name-of i) (species-of i) (description-of i)))))))))
+ (format t "Name: ~a~%Species: ~a~%Description: ~a~%~%" (name-of i) (species-of i) (description-of i)))))))))
(defunassert yadfa-bin:get-stats (&key inventory wear prop item attack ally wield enemy)
- (ally (or null unsigned-byte type-specifier)
- wear (or null unsigned-byte type-specifier)
- inventory (or null unsigned-byte type-specifier)
- enemy (or null unsigned-byte type-specifier))
+ (ally (or null unsigned-byte type-specifier)
+ wear (or null unsigned-byte type-specifier)
+ inventory (or null unsigned-byte type-specifier)
+ enemy (or null unsigned-byte type-specifier))
"lists stats about various items in various places. @var{INVENTORY} is the index of an item in your inventory. @var{WEAR} is the index of what you or your ally is wearing. @var{PROP} is a keyword that refers to the prop you're selecting. @var{ITEM} is the index of an item that a prop has and is used to print information about that prop. @var{ATTACK} is a keyword referring to the move you or your ally has when showing that move. @var{ALLY} is the index of an ally on your team when selecting @var{INVENTORY} or @var{MOVE}, don't set @var{ALLY} if you want to select yourself."
(when (and ally (list-length-> ally (allies-of *game*)))
(write-line "That ally doesn't exist")
@@ -314,22 +314,22 @@
(energy-cost-of (get-move attack selected-user))))
(when prop
(handle-user-input ()
- (*query-io* ((or (check-type prop (and (not null) symbol)) (null (getf (get-props-from-zone (position-of (player-of *game*))) prop)))
- (prop)
- :prompt-text "Enter a different prop, or exit and use (lst :props t) to get the list of props and try again"
- :error-text "That prop doesn't exist")
- ((null (nth item (items-of (getf (get-props-from-zone (position-of (player-of *game*)))
- (the (and (not null) symbol) prop)))))
- (item)
- :prompt-text "Enter a different item"
- :error-text "That item doesn't exist"))
- (describe-item (nth (the unsigned-byte item)
- (items-of (getf (get-props-from-zone (position-of (player-of *game*)))
- (the (and (not null) symbol) prop)))))))))
+ (*query-io* ((or (check-type prop (and (not null) symbol)) (null (getf (get-props-from-zone (position-of (player-of *game*))) prop)))
+ (prop)
+ :prompt-text "Enter a different prop, or exit and use (lst :props t) to get the list of props and try again"
+ :error-text "That prop doesn't exist")
+ ((null (nth item (items-of (getf (get-props-from-zone (position-of (player-of *game*)))
+ (the (and (not null) symbol) prop)))))
+ (item)
+ :prompt-text "Enter a different item"
+ :error-text "That item doesn't exist"))
+ (describe-item (nth (the unsigned-byte item)
+ (items-of (getf (get-props-from-zone (position-of (player-of *game*)))
+ (the (and (not null) symbol) prop)))))))))
(defunassert yadfa-bin:wear (&key (inventory 0) (wear 0) user)
- (user (or null unsigned-byte)
- wear unsigned-byte
- inventory (or type-specifier unsigned-byte))
+ (user (or null unsigned-byte)
+ wear unsigned-byte
+ inventory (or type-specifier unsigned-byte))
#.(format nil "Wear an item in your inventory. @var{WEAR} is the index you want to place this item. Smaller index refers to outer clothing. @var{INVENTORY} is an index in your inventory of the item you want to wear. You can also give it a type specifier which will pick the first item in your inventory of that type. @var{USER} is an index of an ally. Leave this at @code{NIL} to refer to yourself.
~a, ~a, and ~a."
@@ -346,62 +346,62 @@
(typep obj type-specifier))))))
i a
(wear-length (list-length (wear-of selected-user))))
- (*query-io* ((when (list-length-> 1 (inventory-of (player-of *game*)))
- (format t "~a doesn't have any clothes to put on~%" (name-of selected-user))
- (return-from yadfa-bin:wear))
- ())
- ((not item)
- (inventory)
- :prompt-text "Enter a different item"
- :error-text "INVENTORY isn't a valid item")
- ((not (typep item 'clothing))
- (inventory)
- :prompt-text "Enter a different item"
- :error-text (format nil "That ~a isn't something you can wear~%" (name-of item)))
- ((< wear-length wear)
- (wear)
- :prompt-text "Enter a different index"
- :error-text (format nil "“:WEAR ~d” doesn't refer to a valid position as it can't go past the items you're current wearing which is currently ~d"
- wear
- wear-length)))
- (cond ((let ((not-wear (typecase (must-not-wear*-of (get-zone (position-of (player-of *game*))))
- (cons (must-not-wear*-of (get-zone (position-of (player-of *game*)))))
- (symbol (gethash (must-not-wear*-of *game*) (must-not-wear*-of (get-zone (position-of (player-of *game*)))))))))
- (and (typep item (car not-wear)) (not (funcall (coerce (cdr not-wear) 'function) selected-user))))
- (return-from yadfa-bin:wear))
- ((and (> wear 0) (iter (for i in (butlast (wear-of selected-user) (- wear-length wear)))
- (when (and (typep i 'closed-bottoms) (lockedp i))
- (format t "~a can't remove ~a ~a to put on ~a ~a as it's locked~%"
- (name-of selected-user)
- (if (malep selected-user) "his" "her")
- (name-of i)
- (if (malep selected-user) "his" "her")
- (name-of item))
- (leave t))))
- (return-from yadfa-bin:wear)))
- (setf a (insert (wear-of selected-user) item wear)
- i (iter (for outer in (reverse (subseq a 0 (1+ wear))))
- (with b = (reverse a))
- (when (and (typep outer 'bottoms) (thickness-capacity-of outer) (> (fast-thickness b outer) (thickness-capacity-of outer)))
- (leave (thickest (cdr (s:memq outer a)))))))
- (if i
- (format t "~a struggles to fit ~a ~a over ~a ~a in a hilarious fashion but fail to do so.~%"
- (name-of selected-user)
- (if (malep selected-user) "his" "her")
- (name-of item)
- (if (malep selected-user) "his" "her")
- (name-of i))
- (progn (when *battle*
- (format t "The ~a you're battling stops and waits for you to put on your ~a because Pouar never prevented this function from being called in battle~%"
- (if (list-length-< 1 (enemies-of *battle*)) "enemies" "enemy")
- (name-of item)))
- (format t "~a puts on ~a ~a~%" (name-of selected-user) (if (malep selected-user) "his" "her") (name-of item))
- (a:deletef (inventory-of (player-of *game*)) item :count 1)
- (setf (wear-of selected-user) a)))))
+ (*query-io* ((when (list-length-> 1 (inventory-of (player-of *game*)))
+ (format t "~a doesn't have any clothes to put on~%" (name-of selected-user))
+ (return-from yadfa-bin:wear))
+ ())
+ ((not item)
+ (inventory)
+ :prompt-text "Enter a different item"
+ :error-text "INVENTORY isn't a valid item")
+ ((not (typep item 'clothing))
+ (inventory)
+ :prompt-text "Enter a different item"
+ :error-text (format nil "That ~a isn't something you can wear~%" (name-of item)))
+ ((< wear-length wear)
+ (wear)
+ :prompt-text "Enter a different index"
+ :error-text (format nil "“:WEAR ~d” doesn't refer to a valid position as it can't go past the items you're current wearing which is currently ~d"
+ wear
+ wear-length)))
+ (cond ((let ((not-wear (typecase (must-not-wear*-of (get-zone (position-of (player-of *game*))))
+ (cons (must-not-wear*-of (get-zone (position-of (player-of *game*)))))
+ (symbol (gethash (must-not-wear*-of *game*) (must-not-wear*-of (get-zone (position-of (player-of *game*)))))))))
+ (and (typep item (car not-wear)) (not (funcall (coerce (cdr not-wear) 'function) selected-user))))
+ (return-from yadfa-bin:wear))
+ ((and (> wear 0) (iter (for i in (butlast (wear-of selected-user) (- wear-length wear)))
+ (when (and (typep i 'closed-bottoms) (lockedp i))
+ (format t "~a can't remove ~a ~a to put on ~a ~a as it's locked~%"
+ (name-of selected-user)
+ (if (malep selected-user) "his" "her")
+ (name-of i)
+ (if (malep selected-user) "his" "her")
+ (name-of item))
+ (leave t))))
+ (return-from yadfa-bin:wear)))
+ (setf a (insert (wear-of selected-user) item wear)
+ i (iter (for outer in (reverse (subseq a 0 (1+ wear))))
+ (with b = (reverse a))
+ (when (and (typep outer 'bottoms) (thickness-capacity-of outer) (> (fast-thickness b outer) (thickness-capacity-of outer)))
+ (leave (thickest (cdr (s:memq outer a)))))))
+ (if i
+ (format t "~a struggles to fit ~a ~a over ~a ~a in a hilarious fashion but fail to do so.~%"
+ (name-of selected-user)
+ (if (malep selected-user) "his" "her")
+ (name-of item)
+ (if (malep selected-user) "his" "her")
+ (name-of i))
+ (progn (when *battle*
+ (format t "The ~a you're battling stops and waits for you to put on your ~a because Pouar never prevented this function from being called in battle~%"
+ (if (list-length-< 1 (enemies-of *battle*)) "enemies" "enemy")
+ (name-of item)))
+ (format t "~a puts on ~a ~a~%" (name-of selected-user) (if (malep selected-user) "his" "her") (name-of item))
+ (a:deletef (inventory-of (player-of *game*)) item :count 1)
+ (setf (wear-of selected-user) a)))))
(defunassert yadfa-bin:unwear (&key (inventory 0) (wear 0) user)
- (user (or unsigned-byte null)
- inventory unsigned-byte
- wear (or type-specifier unsigned-byte))
+ (user (or unsigned-byte null)
+ inventory unsigned-byte
+ wear (or type-specifier unsigned-byte))
#.(format nil "Unwear an item you're wearing. @var{INVENTORY} is the index you want to place this item. @var{WEAR} is the index of the item you're wearing that you want to remove. You can also set @var{WEAR} to a type specifier for the outer most clothing of that type. @var{USER} is a integer referring to the index of an ally. Leave at @code{NIL} to refer to yourself
~a, ~a, and ~a."
@@ -417,58 +417,58 @@
:test #'(lambda (type-specifier obj)
(typep obj type-specifier))))))
(inventory-length (list-length (inventory-of (player-of *game*)))))
- (*query-io* ((when (list-length-> 1 (wear-of selected-user))
- (format t "~a isn't wearing any clothes to remove~%" (name-of selected-user))
- (return-from yadfa-bin:unwear))
- ())
- ((not item)
- (wear)
- :prompt-text "Enter a different item"
- :error-text "WEAR isn't a valid item")
- ((< inventory-length inventory)
- (inventory)
- :prompt-text "Enter a different index"
- :error-text (format nil "“:INVENTORY ~d” doesn't refer to a valid position as it can't go past the items you currently have in your inventory which is currently ~d~%"
- inventory inventory-length)))
- (cond ((and
- (not (eq (player-of *game*) selected-user))
- (typep item 'diaper)
- (typep user '(not potty-trained-team-member))
- (list-length-> 2 (filter-items (wear-of selected-user) 'diaper)))
- (format t "Letting ~a go without padding is a really bad idea. Don't do it.~%"
- (name-of selected-user))
- (return-from yadfa-bin:unwear))
- ((let ((wear (typecase (must-wear*-of (get-zone (position-of (player-of *game*))))
- (cons (must-wear*-of (get-zone (position-of (player-of *game*)))))
- (symbol (gethash (must-wear*-of *game*)
- (must-wear*-of (get-zone (position-of (player-of *game*)))))))))
- (and (typep item (car wear))
- (list-length->= 1 (filter-items (wear-of selected-user) (car wear)))
- (not (funcall (coerce (cdr wear) 'function) selected-user))))
- (return-from yadfa-bin:unwear))
- ((iter (for i in (butlast (wear-of selected-user) (- (list-length (wear-of selected-user)) (position item (wear-of selected-user)) 1)))
- (when (and (typep i 'closed-bottoms) (lockedp i))
- (format t "~a can't remove ~a ~a to take off ~a ~a as it's locked~%"
- (name-of selected-user)
- (if (malep selected-user) "his" "her")
- (name-of i)
- (if (malep selected-user) "his" "her")
- (name-of item))
- (leave t)))
- (return-from yadfa-bin:unwear)))
- (when *battle*
- (format t "The ~a you're battling stops and waits for you to take off your ~a because Pouar never prevented this function from being called in battle~%"
- (if (list-length-< 1 (enemies-of *battle*))
- "enemies"
- "enemy")
- (name-of item)))
- (format t "~a takes off ~a ~a~%" (name-of selected-user) (if (malep selected-user) "his" "her") (name-of item))
- (a:deletef (wear-of (player-of *game*)) item :count 1)
- (insertf (inventory-of (player-of *game*)) item inventory)))
+ (*query-io* ((when (list-length-> 1 (wear-of selected-user))
+ (format t "~a isn't wearing any clothes to remove~%" (name-of selected-user))
+ (return-from yadfa-bin:unwear))
+ ())
+ ((not item)
+ (wear)
+ :prompt-text "Enter a different item"
+ :error-text "WEAR isn't a valid item")
+ ((< inventory-length inventory)
+ (inventory)
+ :prompt-text "Enter a different index"
+ :error-text (format nil "“:INVENTORY ~d” doesn't refer to a valid position as it can't go past the items you currently have in your inventory which is currently ~d~%"
+ inventory inventory-length)))
+ (cond ((and
+ (not (eq (player-of *game*) selected-user))
+ (typep item 'diaper)
+ (typep user '(not potty-trained-team-member))
+ (list-length-> 2 (filter-items (wear-of selected-user) 'diaper)))
+ (format t "Letting ~a go without padding is a really bad idea. Don't do it.~%"
+ (name-of selected-user))
+ (return-from yadfa-bin:unwear))
+ ((let ((wear (typecase (must-wear*-of (get-zone (position-of (player-of *game*))))
+ (cons (must-wear*-of (get-zone (position-of (player-of *game*)))))
+ (symbol (gethash (must-wear*-of *game*)
+ (must-wear*-of (get-zone (position-of (player-of *game*)))))))))
+ (and (typep item (car wear))
+ (list-length->= 1 (filter-items (wear-of selected-user) (car wear)))
+ (not (funcall (coerce (cdr wear) 'function) selected-user))))
+ (return-from yadfa-bin:unwear))
+ ((iter (for i in (butlast (wear-of selected-user) (- (list-length (wear-of selected-user)) (position item (wear-of selected-user)) 1)))
+ (when (and (typep i 'closed-bottoms) (lockedp i))
+ (format t "~a can't remove ~a ~a to take off ~a ~a as it's locked~%"
+ (name-of selected-user)
+ (if (malep selected-user) "his" "her")
+ (name-of i)
+ (if (malep selected-user) "his" "her")
+ (name-of item))
+ (leave t)))
+ (return-from yadfa-bin:unwear)))
+ (when *battle*
+ (format t "The ~a you're battling stops and waits for you to take off your ~a because Pouar never prevented this function from being called in battle~%"
+ (if (list-length-< 1 (enemies-of *battle*))
+ "enemies"
+ "enemy")
+ (name-of item)))
+ (format t "~a takes off ~a ~a~%" (name-of selected-user) (if (malep selected-user) "his" "her") (name-of item))
+ (a:deletef (wear-of (player-of *game*)) item :count 1)
+ (insertf (inventory-of (player-of *game*)) item inventory)))
(defunassert yadfa-bin:change (&key (inventory 0) (wear 0) user)
- (user (or null unsigned-byte)
- inventory (or type-specifier unsigned-byte)
- wear (or type-specifier unsigned-byte))
+ (user (or null unsigned-byte)
+ inventory (or type-specifier unsigned-byte)
+ wear (or type-specifier unsigned-byte))
#.(format nil "Change one of the clothes you're wearing with one in your inventory. @var{WEAR} is the index of the clothing you want to replace. Smaller index refers to outer clothing. @var{INVENTORY} is an index in your inventory of the item you want to replace it with. You can also give @var{INVENTORY} and @var{WEAR} a quoted symbol which can act as a type specifier which will pick the first item in your inventory of that type. @var{USER} is an index of an ally. Leave this at @code{NIL} to refer to yourself.
~a, ~a, and ~a."
@@ -491,116 +491,116 @@
:test #'(lambda (type-specifier obj)
(typep obj type-specifier))))))
i a)
- (*query-io* ((when (list-length-> 1 (wear-of selected-user))
- (format t "~a isn't wearing any clothes to change~%" (name-of selected-user))
- (return-from yadfa-bin:change))
- ())
- ((not inventory)
- (inventory)
- :prompt-text "Enter a different item"
- :error-text "INVENTORY isn't valid")
- ((not wear)
- (inventory)
- :prompt-text "Enter a different item"
- :error-text "WEAR isn't valid")
- ((not (typep inventory 'clothing))
- (inventory)
- :prompt-text "Enter a different item"
- :error-text (format nil "That ~a isn't something you can wear" (name-of inventory))))
- (cond ((and
- (typep selected-user '(not potty-trained-team-member))
- (typep inventory 'pullup)
- (typep wear 'diaper)
- (list-length-> 2 (filter-items (wear-of selected-user) 'diaper)))
- (format t "Does ~a look ready for pullups to you?~%" (name-of selected-user))
- (return-from yadfa-bin:change))
- ((and
- (typep selected-user '(not potty-trained-team-member))
- (not (typep inventory 'diaper))
- (typep wear 'diaper)
- (list-length-> 2 (filter-items (wear-of selected-user) 'diaper)))
- (format t "letting ~a go without padding is a really bad idea. Don't do it.~%" (name-of selected-user))
- (return-from yadfa-bin:change))
- ((let ((wear (typecase (must-wear*-of (get-zone (position-of (player-of *game*))))
- (cons (must-wear*-of (get-zone (position-of (player-of *game*)))))
- (symbol (gethash (must-wear*-of *game*) (must-wear*-of (get-zone (position-of (player-of *game*))))))))
- (not-wear (typecase (must-not-wear*-of (get-zone (position-of (player-of *game*))))
- (cons (must-not-wear*-of (get-zone (position-of (player-of *game*)))))
- (symbol (gethash (must-not-wear*-of *game*) (must-not-wear*-of (get-zone (position-of (player-of *game*)))))))))
- (or (and (not (typep inventory (car wear)))
- (typep wear (car wear))
- (list-length->= 1 (filter-items (wear-of selected-user) (car wear)))
- (not (funcall (coerce (cdr not-wear) 'function) selected-user)))
- (and (typep inventory (car not-wear)) (not (funcall (coerce (cdr not-wear) 'function) selected-user)))))
- (return-from yadfa-bin:change))
- ((and
- (iter (for i in (butlast (wear-of selected-user) (- (list-length (wear-of selected-user)) (position wear (wear-of selected-user)) 1)))
- (when (and (typep i 'closed-bottoms) (lockedp i))
- (format t "~a can't remove ~a ~a to put on ~a ~a as it's locked~%"
- (name-of selected-user)
- (if (malep selected-user) "his" "her")
- (name-of i)
- (if (malep selected-user) "his" "her")
- (name-of inventory))
- (leave t))))
- (return-from yadfa-bin:change)))
- (setf a (substitute inventory wear (wear-of selected-user) :count 1)
- i (iter (for outer in (reverse (subseq a 0 (1+ (position inventory a)))))
- (with b = (reverse a))
- (when (and (typep outer 'bottoms) (thickness-capacity-of outer) (> (fast-thickness b outer) (thickness-capacity-of outer)))
- (leave outer))))
- (if i
- (format t
- "~a struggles to fit ~a ~a over ~a ~a in a hilarious fashion but fail to do so.~%"
- (name-of selected-user)
- (if (malep selected-user) "his" "her")
- (name-of i)
- (if (malep selected-user) "his" "her")
- (name-of inventory))
- (progn (when *battle*
- (format t "The ~a you're battling stops and waits for you to put on your ~a because Pouar never prevented this function from being called in battle~%"
- (if (list-length-< 1 (enemies-of *battle*)) "enemies" "enemy")
- (name-of inventory)))
- (format t "~a changes out of ~a ~a and into ~a ~a~%"
- (name-of selected-user)
- (if (malep selected-user) "his" "her")
- (name-of wear)
- (if (malep selected-user) "his" "her")
- (name-of inventory))
- (substitutef (inventory-of selected-user) wear inventory :count 1)
- (setf (wear-of selected-user) a)))))
+ (*query-io* ((when (list-length-> 1 (wear-of selected-user))
+ (format t "~a isn't wearing any clothes to change~%" (name-of selected-user))
+ (return-from yadfa-bin:change))
+ ())
+ ((not inventory)
+ (inventory)
+ :prompt-text "Enter a different item"
+ :error-text "INVENTORY isn't valid")
+ ((not wear)
+ (inventory)
+ :prompt-text "Enter a different item"
+ :error-text "WEAR isn't valid")
+ ((not (typep inventory 'clothing))
+ (inventory)
+ :prompt-text "Enter a different item"
+ :error-text (format nil "That ~a isn't something you can wear" (name-of inventory))))
+ (cond ((and
+ (typep selected-user '(not potty-trained-team-member))
+ (typep inventory 'pullup)
+ (typep wear 'diaper)
+ (list-length-> 2 (filter-items (wear-of selected-user) 'diaper)))
+ (format t "Does ~a look ready for pullups to you?~%" (name-of selected-user))
+ (return-from yadfa-bin:change))
+ ((and
+ (typep selected-user '(not potty-trained-team-member))
+ (not (typep inventory 'diaper))
+ (typep wear 'diaper)
+ (list-length-> 2 (filter-items (wear-of selected-user) 'diaper)))
+ (format t "letting ~a go without padding is a really bad idea. Don't do it.~%" (name-of selected-user))
+ (return-from yadfa-bin:change))
+ ((let ((wear (typecase (must-wear*-of (get-zone (position-of (player-of *game*))))
+ (cons (must-wear*-of (get-zone (position-of (player-of *game*)))))
+ (symbol (gethash (must-wear*-of *game*) (must-wear*-of (get-zone (position-of (player-of *game*))))))))
+ (not-wear (typecase (must-not-wear*-of (get-zone (position-of (player-of *game*))))
+ (cons (must-not-wear*-of (get-zone (position-of (player-of *game*)))))
+ (symbol (gethash (must-not-wear*-of *game*) (must-not-wear*-of (get-zone (position-of (player-of *game*)))))))))
+ (or (and (not (typep inventory (car wear)))
+ (typep wear (car wear))
+ (list-length->= 1 (filter-items (wear-of selected-user) (car wear)))
+ (not (funcall (coerce (cdr not-wear) 'function) selected-user)))
+ (and (typep inventory (car not-wear)) (not (funcall (coerce (cdr not-wear) 'function) selected-user)))))
+ (return-from yadfa-bin:change))
+ ((and
+ (iter (for i in (butlast (wear-of selected-user) (- (list-length (wear-of selected-user)) (position wear (wear-of selected-user)) 1)))
+ (when (and (typep i 'closed-bottoms) (lockedp i))
+ (format t "~a can't remove ~a ~a to put on ~a ~a as it's locked~%"
+ (name-of selected-user)
+ (if (malep selected-user) "his" "her")
+ (name-of i)
+ (if (malep selected-user) "his" "her")
+ (name-of inventory))
+ (leave t))))
+ (return-from yadfa-bin:change)))
+ (setf a (substitute inventory wear (wear-of selected-user) :count 1)
+ i (iter (for outer in (reverse (subseq a 0 (1+ (position inventory a)))))
+ (with b = (reverse a))
+ (when (and (typep outer 'bottoms) (thickness-capacity-of outer) (> (fast-thickness b outer) (thickness-capacity-of outer)))
+ (leave outer))))
+ (if i
+ (format t
+ "~a struggles to fit ~a ~a over ~a ~a in a hilarious fashion but fail to do so.~%"
+ (name-of selected-user)
+ (if (malep selected-user) "his" "her")
+ (name-of i)
+ (if (malep selected-user) "his" "her")
+ (name-of inventory))
+ (progn (when *battle*
+ (format t "The ~a you're battling stops and waits for you to put on your ~a because Pouar never prevented this function from being called in battle~%"
+ (if (list-length-< 1 (enemies-of *battle*)) "enemies" "enemy")
+ (name-of inventory)))
+ (format t "~a changes out of ~a ~a and into ~a ~a~%"
+ (name-of selected-user)
+ (if (malep selected-user) "his" "her")
+ (name-of wear)
+ (if (malep selected-user) "his" "her")
+ (name-of inventory))
+ (substitutef (inventory-of selected-user) wear inventory :count 1)
+ (setf (wear-of selected-user) a)))))
(defunassert yadfa-bin:toss (&rest items)
- (items list)
+ (items list)
"Throw an item in your inventory away. @var{ITEM} is the index of the item in your inventory"
(let ((value (iter (for i in items)
- (unless (typep i 'unsigned-byte)
- (leave i)))))
+ (unless (typep i 'unsigned-byte)
+ (leave i)))))
(when value
(error 'type-error :datum value :expected-type 'unsigned-byte)))
(let ((items (sort (remove-duplicates items) #'<)))
(setf items (iter (generate i in items)
- (for j in (inventory-of (player-of *game*)))
- (for (the fixnum k) upfrom 0)
- (when (first-iteration-p)
- (next i))
- (when (= k i)
- (collect j)
- (next i))))
+ (for j in (inventory-of (player-of *game*)))
+ (for (the fixnum k) upfrom 0)
+ (when (first-iteration-p)
+ (next i))
+ (when (= k i)
+ (collect j)
+ (next i))))
(unless items
(format t "Those items aren't valid")
(return-from yadfa-bin:toss))
(iter (for i in items)
- (unless (tossablep i)
- (format t "To avoid breaking the game, you can't toss your ~a." (name-of i))
- (return-from yadfa-bin:toss)))
+ (unless (tossablep i)
+ (format t "To avoid breaking the game, you can't toss your ~a." (name-of i))
+ (return-from yadfa-bin:toss)))
(iter (for i in items)
- (format t "You send ~a straight to /dev/null~%" (name-of i)))
+ (format t "You send ~a straight to /dev/null~%" (name-of i)))
(a:deletef (inventory-of (player-of *game*)) items
:test (lambda (o e)
(s:memq e o)))))
(defunassert yadfa-bin:wield (&key user inventory)
- (user (or unsigned-byte null)
- inventory (or unsigned-byte type-specifier))
+ (user (or unsigned-byte null)
+ inventory (or unsigned-byte type-specifier))
"Wield an item. Set @var{INVENTORY} to the index or a type specifier of an item in your inventory to wield that item. Set @var{USER} to the index of an ally to have them to equip it or leave it @code{NIL} for the player."
(let* ((selected-user (if user
(nth user (allies-of *game*))
@@ -628,7 +628,7 @@
(push (wield-of selected-user) (inventory-of (player-of *game*))))
(setf (wield-of selected-user) item)))
(defunassert yadfa-bin:unwield (&key user)
- (user (or integer null))
+ (user (or integer null))
"Unwield an item. Set @var{USER} to the index of an ally to have them to unequip it or leave it @code{NIL} for the player."
(let ((selected-user
(if user
@@ -640,7 +640,7 @@
(setf (wield-of selected-user) nil))
(format t "~a hasn't equiped a weapon~%" (name-of selected-user)))))
(defunassert yadfa-bin:pokedex (&optional enemy)
- (enemy symbol)
+ (enemy symbol)
"Browse enemies in your pokedex, @var{ENEMY} is a quoted symbol that is the same as the class name of the enemy you want to view. Leave it to @code{NIL} to list available entries"
(if enemy
(let ((a (if (s:memq enemy (seen-enemies-of *game*))
@@ -650,12 +650,12 @@
(format t "Name: ~a~%Species: ~a~%Description: ~a~%" (name-of a) (species-of a) (description-of a)))
(progn (format t "~30a~30a~%" "ID" "Name")
(iter (for i in (seen-enemies-of *game*))
- (let ((a (make-instance i)))
- (format t "~30a~30a~%" i (name-of a)))))))
+ (let ((a (make-instance i)))
+ (format t "~30a~30a~%" i (name-of a)))))))
(defunassert yadfa-bin:toggle-lock (wear key &optional user)
- (wear unsigned-byte
- key unsigned-byte
- user (or unsigned-byte null))
+ (wear unsigned-byte
+ key unsigned-byte
+ user (or unsigned-byte null))
"Toggle the lock on one of the clothes a user is wearing. @var{WEAR} is the index of an item a user is wearing, @var{KEY} is the index of a key in your inventory, @var{USER} is a number that is the index of an ally, leave this to @code{NIL} to select the player."
(let* ((selected-user (if user (nth user (allies-of *game*)) (player-of *game*)))
(wear-length (list-length (wear-of selected-user)))
diff --git a/core/bin/world.lisp b/core/bin/world.lisp
index 5fff2e4..af6313e 100644
--- a/core/bin/world.lisp
+++ b/core/bin/world.lisp
@@ -1,7 +1,7 @@
;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa"; coding: utf-8-unix; -*-
(in-package :yadfa)
(defunassert yadfa-world:save-game (path)
- (path (or simple-string pathname))
+ (path (or simple-string pathname))
#.(format nil "This function saves current game to @var{PATH}
~a."
@@ -16,7 +16,7 @@
(type-error () (parse-namestring path))
(file-error () nil)))))
(defunassert yadfa-world:load-game (path)
- (path (or simple-string pathname))
+ (path (or simple-string pathname))
#.(format nil "This function loads a saved game from @var{PATH}
~a."
@@ -30,54 +30,54 @@
(type-error () (parse-namestring path))
(file-error () nil)))))
(defunassert yadfa-world:move (&rest directions)
- (directions list)
+ (directions list)
#.(format nil "type in the direction as a keyword to move in that direction, valid directions can be found with @code{(lst :directions t)}.
You can also specify multiple directions, for example @code{(move :south :south)} will move 2 zones south. @code{(move :south :west :south)} will move south, then west, then south.
~a."
(xref yadfa-bin:lst :function))
(iter (for direction in directions)
- (multiple-value-bind (new-position error) (get-path-end (get-destination direction (position-of (player-of *game*))) (position-of (player-of *game*)) direction)
- (let* ((old-position (position-of (player-of *game*))))
- (unless new-position
- (format t "~a" error)
- (return-from yadfa-world:move))
- (move-to-zone new-position :direction direction :old-position old-position)))))
+ (multiple-value-bind (new-position error) (get-path-end (get-destination direction (position-of (player-of *game*))) (position-of (player-of *game*)) direction)
+ (let* ((old-position (position-of (player-of *game*))))
+ (unless new-position
+ (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)
+ (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)))
+ ((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)
+ (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)))
+ (*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)
- prop symbol
- describe boolean
- take (or null keyword list))
+ (action (or keyword null)
+ describe-action (or keyword null)
+ prop symbol
+ describe boolean
+ take (or null keyword list))
#.(format nil "interacts with @var{PROP}. @var{PROP} is a keyword, you can get these with @code{LST} with the @var{PROPS} parameter. setting @var{LIST} to non-NIL will list all the items and actions in the prop. you can take the items with the @var{TAKE} parameter. Setting this to an integer will take the item at that index, while setting it to @code{:ALL} will take all the items, setting it to @code{:BITCOINS} will take just the bitcoins. You can get this index with the @var{LIST} parameter. @var{ACTION} is a keyword referring to an action to perform, can also be found with the @var{LIST} parameter. You can also specify other keys when using @var{ACTION} and this function will pass those keys to that function. set @var{DESCRIBE-ACTION} to the keyword of the action to find out how to use it. Set @var{DESCRIBE} to @code{T} to print the prop's description.
~a."
@@ -85,32 +85,32 @@ You can also specify multiple directions, for example @code{(move :south :south)
(when (typep take 'list) (loop for i in take do (check-type i unsigned-byte)))
(flet ((format-table (header &rest body)
(c:formatting-table (t :x-spacing 20)
- (c:with-text-style (*query-io* (c:make-text-style nil :bold nil))
- (c:formatting-row ()
- (iter (for cell in header)
- (c:formatting-cell ()
- (typecase cell
- (string (write-string cell))
- (t (write cell)))))))
- (iter (for row in body)
- (c:formatting-row ()
- (iter (for cell in row)
- (c:formatting-cell ()
- (typecase cell
- (string (write-string cell))
- (t (write cell))))))))))
+ (c:with-text-style (*query-io* (c:make-text-style nil :bold nil))
+ (c:formatting-row ()
+ (iter (for cell in header)
+ (c:formatting-cell ()
+ (typecase cell
+ (string (write-string cell))
+ (t (write cell)))))))
+ (iter (for row in body)
+ (c:formatting-row ()
+ (iter (for cell in row)
+ (c:formatting-cell ()
+ (typecase cell
+ (string (write-string cell))
+ (t (write cell))))))))))
(when list
(with-effective-frame
- (format t "Bitcoins: ~a~%~%" (get-bitcoins-from-prop prop (position-of (player-of *game*))))
+ (format t "Bitcoins: ~a~%~%" (get-bitcoins-from-prop prop (position-of (player-of *game*))))
(apply #'format-table '("Index" "Name" "Class")
(iter (for i in (get-items-from-prop prop (position-of (player-of *game*))))
- (for (the fixnum j) upfrom 0)
- (collect (list j (name-of i) (type-of i)))))
+ (for (the fixnum j) upfrom 0)
+ (collect (list j (name-of i) (type-of i)))))
(format t "~%~%Actions: ")
(iter (for (key value) on (actions-of (getf (get-props-from-zone (position-of (player-of *game*))) prop)) by #'cddr)
- (when value
- (format t "~s " key)
- (finally (write-char #\Newline))))))
+ (when value
+ (format t "~s " key)
+ (finally (write-char #\Newline))))))
(when take
(cond ((eq take :all)
(setf (inventory-of (player-of *game*)) (append* (get-items-from-prop prop (position-of (player-of *game*))) (inventory-of (player-of *game*))))
@@ -122,9 +122,9 @@ You can also specify multiple directions, for example @code{(move :south :south)
(setf (get-bitcoins-from-prop prop (position-of (player-of *game*))) 0))
(t
(iter (for i in take)
- (push (nth i (get-items-from-prop prop (position-of (player-of *game*)))) (inventory-of (player-of *game*))))
+ (push (nth i (get-items-from-prop prop (position-of (player-of *game*)))) (inventory-of (player-of *game*))))
(iter (for i in (sort (copy-tree take) #'>))
- (setf (get-items-from-prop prop (position-of (player-of *game*))) (remove-nth i (get-items-from-prop prop (position-of (player-of *game*)))))))))
+ (setf (get-items-from-prop prop (position-of (player-of *game*))) (remove-nth i (get-items-from-prop prop (position-of (player-of *game*)))))))))
(when action
(apply (coerce (action-lambda (getf-action-from-prop (position-of (player-of *game*)) prop action))
'function)
@@ -141,7 +141,7 @@ You can also specify multiple directions, for example @code{(move :south :south)
(when describe
(format t "~a~%" (description-of (getf (get-props-from-zone (position-of (player-of *game*))) prop))))))
(defunassert yadfa-world:stats (&optional user)
- (user (or unsigned-byte boolean))
+ (user (or unsigned-byte boolean))
"Prints the current stats, essentially this game's equivalent of a health and energy bar in battle. Set @var{USER} to the index of an ally to show that ally's stats or set it to @code{T} to show your stats, leave it at @code{NIL} to show everyone's stats"
(cond ((eq user t)
(present-stats (player-of *game*)))
@@ -149,12 +149,12 @@ You can also specify multiple directions, for example @code{(move :south :south)
(present-stats (nth user (allies-of *game*))))
(t
(iter (for i in (cons (player-of *game*) (allies-of *game*)))
- (present-stats i)))))
+ (present-stats i)))))
(defunassert yadfa-world:go-potty (&key prop wet mess pull-pants-down user)
- (user (or null real)
- prop (or null keyword)
- wet (or boolean real)
- mess (or boolean real))
+ (user (or null real)
+ prop (or null keyword)
+ wet (or boolean real)
+ mess (or boolean real))
"Go potty. @var{PROP} is a keyword identifying the prop you want to use. If it's a toilet, use the toilet like a big boy. if it's not. Go potty on it like an animal. If you want to wet yourself, leave @var{PROP} as @code{NIL}. @var{WET} is the amount you want to pee in ml. @var{MESS} is the amount in cg, set @var{WET} and/or @var{MESS} to @code{T} to empty yourself completely. set @var{PULL-PANTS-DOWN} to non-NIL to pull your pants down first. @var{USER} is the index value of an ALLY you have. Set this to @code{NIL} if you're referring to yourself"
(let ((this-prop (getf (get-props-from-zone (position-of (player-of *game*))) prop))
(selected-user (if user
@@ -177,7 +177,7 @@ You can also specify multiple directions, for example @code{(move :south :south)
:pants-down pull-pants-down
:user selected-user)))))
(defunassert yadfa-world:tickle (ally)
- (ally unsigned-byte)
+ (ally unsigned-byte)
"Tickle an ally. @var{ALLY} is an integer that is the index of you allies"
(when (list-length-> ally (allies-of *game*))
(write-line "That ally doesn't exist")
@@ -211,7 +211,7 @@ You can also specify multiple directions, for example @code{(move :south :south)
(name-of selected-ally)
(name-of selected-ally))))))
(defunassert yadfa-world:wash-all-in (&optional prop)
- (prop (or keyword null))
+ (prop (or keyword null))
"washes your dirty diapers and all the clothes you've ruined. @var{PROP} is a keyword identifying the washer you want to put it in. If you're washing it in a body of water, leave @var{PROP} out."
(cond
((and prop (not (typep (getf (get-props-from-zone (position-of (player-of *game*))) prop) 'yadfa-props:washer)))
@@ -222,12 +222,12 @@ You can also specify multiple directions, for example @code{(move :south :south)
(write-line "You washed all your soggy and messy clothing. Try not to wet and mess them next time"))
(t (wash-in-washer (getf (get-props-from-zone (position-of (player-of *game*))) prop)))))
(defunassert yadfa-world:place (prop &rest items)
- (items list
- prop symbol)
+ (items list
+ prop symbol)
"Store items in a prop. @var{ITEMS} is a list of indexes of the items in your inventory. @var{PROP} is a keyword"
(let ((value (iter (for i in items)
- (unless (typep i 'integer)
- (leave i)))))
+ (unless (typep i 'integer)
+ (leave i)))))
(when value
(error 'type-error :datum value :expected-type 'integer)))
(iter (for i in items) (check-type i integer))
@@ -239,26 +239,26 @@ You can also specify multiple directions, for example @code{(move :south :south)
(return-from yadfa-world:place))
(let ((items (sort (remove-duplicates items) #'<)))
(setf items (iter (generate i in items)
- (for j in (player-of *game*))
- (for (the fixnum k) upfrom 0)
- (when (first-iteration-p)
- (next i))
- (when (= k i)
- (collect j)
- (next i))))
+ (for j in (player-of *game*))
+ (for (the fixnum k) upfrom 0)
+ (when (first-iteration-p)
+ (next i))
+ (when (= k i)
+ (collect j)
+ (next i))))
(unless items
(format t "Those items aren't valid")
(return-from yadfa-world:place))
(iter (for i in items)
- (format t "You place your ~a on the ~a~%" (name-of i) (name-of (getf (get-props-from-zone (position-of (player-of *game*))) prop)))
- (push i (get-items-from-prop prop (position-of (player-of *game*)))))
+ (format t "You place your ~a on the ~a~%" (name-of i) (name-of (getf (get-props-from-zone (position-of (player-of *game*))) prop)))
+ (push i (get-items-from-prop prop (position-of (player-of *game*)))))
(a:deletef (inventory-of (player-of *game*)) items
:test (lambda (o e)
(s:memq e o)))))
(defunassert yadfa-world:use-item (item &rest keys &key user action &allow-other-keys)
- (item (or unsigned-byte type-specifier)
- action (or null keyword)
- user (or null unsigned-byte))
+ (item (or unsigned-byte type-specifier)
+ action (or null keyword)
+ user (or null unsigned-byte))
"Uses an item. @var{ITEM} is an index of an item in your inventory. @var{USER} is an index of an ally. Setting this to @code{NIL} will use it on yourself. @var{ACTION} is a keyword when specified will perform a special action with the item, all the other keys specified in this function will be passed to that action. @var{ACTION} doesn't work in battle."
(declare (ignorable action))
(handle-user-input ((selected-item (typecase item
@@ -269,37 +269,37 @@ You can also specify multiple directions, for example @code{(move :south :south)
:test #'(lambda (type-specifier obj)
(typep obj type-specifier))))))
(allies-length (list-length (allies-of *game*))))
- (*query-io* ((null selected-item)
- (item)
- :prompt-text "Enter a different item"
- :error-text (format nil "You only have ~a items" (length (inventory-of (player-of *game*)))))
- ((and user (< allies-length user))
- (user)
- :prompt-text "Enter a different user"
- :error-text (format nil "You only have ~d allies" allies-length)))
- (let ((this-user (if user (nth user (allies-of *game*)) (player-of *game*))))
- (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))))))
+ (*query-io* ((null selected-item)
+ (item)
+ :prompt-text "Enter a different item"
+ :error-text (format nil "You only have ~a items" (length (inventory-of (player-of *game*)))))
+ ((and user (< allies-length user))
+ (user)
+ :prompt-text "Enter a different user"
+ :error-text (format nil "You only have ~d allies" allies-length)))
+ (let ((this-user (if user (nth user (allies-of *game*)) (player-of *game*))))
+ (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))
+ (ammo-type (and type-specifier (not null))
+ user (or unsigned-byte null))
(let* ((user (if user
(nth user (allies-of *game*))
(player-of *game*)))
@@ -323,21 +323,21 @@ You can also specify multiple directions, for example @code{(move :south :south)
(format t "~a ~a doesn't take that ammo~%" user-name weapon-name)
(return-from yadfa-world:reload))
(unless (iter (for i in (inventory-of player))
- (when (typep i ammo-type)
- (leave t)))
+ (when (typep i ammo-type)
+ (leave t)))
(format t "~a doesn't have that ammo~%" user-name)
(return-from yadfa-world:reload))
(format t "~a reloaded ~a ~a" user-name (if (malep user) "his" "her") weapon-name)
(iter (with count = 0)
- (for item in (inventory-of player))
- (when (or (list-length-<= weapon-capacity (ammo-of weapon))
- (and reload-count (>= count reload-count)))
- (leave t))
- (when (and (typep item ammo-type) (typep item weapon-ammo-type))
- (push item (ammo-of weapon))
- (a:deletef item (inventory-of player) :count 1)))))
+ (for item in (inventory-of player))
+ (when (or (list-length-<= weapon-capacity (ammo-of weapon))
+ (and reload-count (>= count reload-count)))
+ (leave t))
+ (when (and (typep item ammo-type) (typep item weapon-ammo-type))
+ (push item (ammo-of weapon))
+ (a:deletef item (inventory-of player) :count 1)))))
(defunassert yadfa-world:add-ally-to-team (ally-index)
- (ally-index unsigned-byte)
+ (ally-index unsigned-byte)
"Adds an ally to your battle team. @var{ALLY-INDEX} is the index of an ally in your list of allies"
(let ((allies-length (list-length (allies-of *game*))))
(if (< allies-length ally-index)
@@ -349,7 +349,7 @@ You can also specify multiple directions, for example @code{(move :south :south)
(format t "~a is already on the battle team~%" (name-of ally))
(format t "~a has joined the battle team~%" (name-of ally)))))))
(defunassert yadfa-world:remove-ally-from-team (team-index)
- (team-index unsigned-byte)
+ (team-index unsigned-byte)
"Removes an ally to your battle team. @var{TEAM-INDEX} is the index of an ally in your battle team list"
(let ((team-length (list-length (team-of *game*))))
(cond
@@ -361,8 +361,8 @@ You can also specify multiple directions, for example @code{(move :south :south)
(return-from yadfa-world:remove-ally-from-team))
(t (setf (team-of *game*) (remove-nth team-index (team-of *game*)))))))
(defunassert yadfa-world:swap-team-member (team-index-1 team-index-2)
- (team-index-1 unsigned-byte
- team-index-2 unsigned-byte)
+ (team-index-1 unsigned-byte
+ team-index-2 unsigned-byte)
"swap the positions of 2 battle team members. @var{TEAM-INDEX-1} and @var{TEAM-INDEX-2} are the index numbers of these members in your battle team list"
(cond ((or (list-length-> team-index-1 (team-of *game*)) (list-length-> team-index-2 (team-of *game*)))
(format t "You only have ~d members in your team~%" (list-length (team-of *game*)))
diff --git a/core/classes.lisp b/core/classes.lisp
index 4051651..d8dba72 100644
--- a/core/classes.lisp
+++ b/core/classes.lisp
@@ -427,8 +427,8 @@
(defmethod initialize-instance :after
((c base-character) &rest initargs &key &allow-other-keys)
(destructuring-bind (&key (health nil healthp) (energy nil energyp)
- (base-health nil base-health-p) (base-attack nil base-attack-p)
- (base-defense nil base-defense-p) (base-speed nil base-speed-p) (base-energy nil base-energy-p)&allow-other-keys)
+ (base-health nil base-health-p) (base-attack nil base-attack-p)
+ (base-defense nil base-defense-p) (base-speed nil base-speed-p) (base-energy nil base-energy-p)&allow-other-keys)
initargs
(declare (ignore health energy))
(when base-health-p
@@ -1047,7 +1047,7 @@
(enter-battle-text-of c)
(with-output-to-string (s)
(iter (for i in (enemies-of c))
- (format s "A Wild ~a Appeared!!!~%" (name-of i))))))
+ (format s "A Wild ~a Appeared!!!~%" (name-of i))))))
(setf (turn-queue-of c) (sort (append* (enemies-of c) (team-npcs-of c) (team-of *game*)) '>
:key (lambda (a)
(calculate-stat a :speed))))
diff --git a/core/declt-patches.lisp b/core/declt-patches.lisp
index cbec068..c783a24 100644
--- a/core/declt-patches.lisp
+++ b/core/declt-patches.lisp
@@ -4,7 +4,7 @@
"Render ITEM's documentation string.
Rendering is done on *standard-output*."
(when-let ((docstring (docstring item)))
- (write-string docstring *standard-output*)))
+ (write-string docstring *standard-output*)))
(defun render-header (library-name tagline version contact-names contact-emails
copyright-years license
texi-name info-name declt-notice
diff --git a/core/init.lisp b/core/init.lisp
index 5cad4c5..f991438 100644
--- a/core/init.lisp
+++ b/core/init.lisp
@@ -4,34 +4,34 @@
(defconstant +stat-view+ (make-instance 'stat-view))
(in-package :yadfa)
(s:eval-always
- (defmacro ref (symbol type)
- `(if (asdf:component-loaded-p "yadfa/docs")
- (format nil "@ref{~a,@code{~a} in @code{~a},@code{~a}∶@code{~a}}"
- (uiop:symbol-call '#:net.didierverna.declt '#:escape-anchor
- (uiop:symbol-call '#:net.didierverna.declt '#:anchor-name
- (uiop:symbol-call '#:net.didierverna.declt '
- ,(make-symbol (string-upcase (format nil "make-~a-definition" type)))
- :symbol ',symbol)))
- (uiop:symbol-call '#:net.didierverna.declt '#:escape ',symbol)
- (uiop:symbol-call '#:net.didierverna.declt '#:escape ,(package-name (symbol-package symbol)))
- (uiop:symbol-call '#:net.didierverna.declt '#:escape ,(package-name (symbol-package symbol)))
- (uiop:symbol-call '#:net.didierverna.declt '#:escape ',symbol))
- (let ((*package* (find-package :cl)))
- (format nil "~s" ',symbol))))
- (defmacro xref (symbol type)
- `(if (asdf:component-loaded-p "yadfa/docs")
- (format nil "@xref{~a,@code{~a} in @code{~a},@code{~a}∶@code{~a}}"
- (uiop:symbol-call '#:net.didierverna.declt '#:escape-anchor
- (uiop:symbol-call '#:net.didierverna.declt '#:anchor-name
- (uiop:symbol-call '#:net.didierverna.declt
- ',(make-symbol (string-upcase (format nil "make-~a-definition" type)))
- :symbol ',symbol)))
- (uiop:symbol-call '#:net.didierverna.declt '#:escape ',symbol)
- (uiop:symbol-call '#:net.didierverna.declt '#:escape ,(package-name (symbol-package symbol)))
- (uiop:symbol-call '#:net.didierverna.declt '#:escape ,(package-name (symbol-package symbol)))
- (uiop:symbol-call '#:net.didierverna.declt '#:escape ',symbol))
- (let ((*package* (find-package :cl)))
- (format nil "See ~s" ',symbol)))))
+ (defmacro ref (symbol type)
+ `(if (asdf:component-loaded-p "yadfa/docs")
+ (format nil "@ref{~a,@code{~a} in @code{~a},@code{~a}∶@code{~a}}"
+ (uiop:symbol-call '#:net.didierverna.declt '#:escape-anchor
+ (uiop:symbol-call '#:net.didierverna.declt '#:anchor-name
+ (uiop:symbol-call '#:net.didierverna.declt '
+ ,(make-symbol (string-upcase (format nil "make-~a-definition" type)))
+ :symbol ',symbol)))
+ (uiop:symbol-call '#:net.didierverna.declt '#:escape ',symbol)
+ (uiop:symbol-call '#:net.didierverna.declt '#:escape ,(package-name (symbol-package symbol)))
+ (uiop:symbol-call '#:net.didierverna.declt '#:escape ,(package-name (symbol-package symbol)))
+ (uiop:symbol-call '#:net.didierverna.declt '#:escape ',symbol))
+ (let ((*package* (find-package :cl)))
+ (format nil "~s" ',symbol))))
+ (defmacro xref (symbol type)
+ `(if (asdf:component-loaded-p "yadfa/docs")
+ (format nil "@xref{~a,@code{~a} in @code{~a},@code{~a}∶@code{~a}}"
+ (uiop:symbol-call '#:net.didierverna.declt '#:escape-anchor
+ (uiop:symbol-call '#:net.didierverna.declt '#:anchor-name
+ (uiop:symbol-call '#:net.didierverna.declt
+ ',(make-symbol (string-upcase (format nil "make-~a-definition" type)))
+ :symbol ',symbol)))
+ (uiop:symbol-call '#:net.didierverna.declt '#:escape ',symbol)
+ (uiop:symbol-call '#:net.didierverna.declt '#:escape ,(package-name (symbol-package symbol)))
+ (uiop:symbol-call '#:net.didierverna.declt '#:escape ,(package-name (symbol-package symbol)))
+ (uiop:symbol-call '#:net.didierverna.declt '#:escape ',symbol))
+ (let ((*package* (find-package :cl)))
+ (format nil "See ~s" ',symbol)))))
(declaim (type (or null battle) *battle*)
(type list yadfa-clim::*records* *mods* *cheat-hooks*)
(type (or null game) *game*)
diff --git a/core/libexec/functions.lisp b/core/libexec/functions.lisp
index 9e37843..f945bea 100644
--- a/core/libexec/functions.lisp
+++ b/core/libexec/functions.lisp
@@ -33,10 +33,10 @@
t)
(defunassert get-event (event-id)
- (event-id symbol)
+ (event-id symbol)
(gethash event-id *events*))
(defunassert (setf get-event) (new-value event-id)
- (event-id symbol)
+ (event-id symbol)
(setf (gethash event-id *events*) new-value))
(defun get-zone (position)
(declare (type list position))
@@ -47,52 +47,52 @@
(setf (position-of new-value) position
(gethash position (slot-value *game* 'zones)) new-value))
(s:eval-always
- (defun set-logical-pathnames ()
- (setf (logical-pathname-translations "YADFA")
- `(("yadfa:data;**;*.*.*" ,(uiop:merge-pathnames*
- (make-pathname
- :directory '(:relative "YADFA" :wild-inferiors)
- :name :wild
- :type :wild
- :version :wild
- :case :common)
- (uiop:xdg-data-home)))
- ("yadfa:config;**;*.*.*" ,(uiop:merge-pathnames*
- (make-pathname
- :directory '(:relative "YADFA" :wild-inferiors)
- :name :wild
- :type :wild
- :version :wild
- :case :common)
- (uiop:xdg-config-home)))
- ("yadfa:home;**;*.*.*" ,(uiop:merge-pathnames*
- (make-pathname
- :directory '(:relative :wild-inferiors)
- :type :wild
- :name :wild
- :version :wild
- :case :common)
- (if uiop:*image-dumped-p*
- (make-pathname
- :device (pathname-device (truename (uiop:argv0)))
- :directory (pathname-directory (truename (uiop:argv0))))
- (asdf:component-pathname (asdf:find-system "yadfa")))))))
- (illogical-pathnames:define-illogical-host :yadfa.data (uiop:merge-pathnames*
- (make-pathname
- :directory '(:relative "YADFA")
- :case :common)
- (uiop:xdg-data-home)))
- (illogical-pathnames:define-illogical-host :yadfa.config (uiop:merge-pathnames*
+ (defun set-logical-pathnames ()
+ (setf (logical-pathname-translations "YADFA")
+ `(("yadfa:data;**;*.*.*" ,(uiop:merge-pathnames*
+ (make-pathname
+ :directory '(:relative "YADFA" :wild-inferiors)
+ :name :wild
+ :type :wild
+ :version :wild
+ :case :common)
+ (uiop:xdg-data-home)))
+ ("yadfa:config;**;*.*.*" ,(uiop:merge-pathnames*
+ (make-pathname
+ :directory '(:relative "YADFA" :wild-inferiors)
+ :name :wild
+ :type :wild
+ :version :wild
+ :case :common)
+ (uiop:xdg-config-home)))
+ ("yadfa:home;**;*.*.*" ,(uiop:merge-pathnames*
+ (make-pathname
+ :directory '(:relative :wild-inferiors)
+ :type :wild
+ :name :wild
+ :version :wild
+ :case :common)
+ (if uiop:*image-dumped-p*
+ (make-pathname
+ :device (pathname-device (truename (uiop:argv0)))
+ :directory (pathname-directory (truename (uiop:argv0))))
+ (asdf:component-pathname (asdf:find-system "yadfa")))))))
+ (illogical-pathnames:define-illogical-host :yadfa.data (uiop:merge-pathnames*
+ (make-pathname
+ :directory '(:relative "YADFA")
+ :case :common)
+ (uiop:xdg-data-home)))
+ (illogical-pathnames:define-illogical-host :yadfa.config (uiop:merge-pathnames*
+ (make-pathname
+ :directory '(:relative "YADFA")
+ :case :common)
+ (uiop:xdg-config-home)))
+ (illogical-pathnames:define-illogical-host :yadfa.home (if uiop:*image-dumped-p*
(make-pathname
- :directory '(:relative "YADFA")
- :case :common)
- (uiop:xdg-config-home)))
- (illogical-pathnames:define-illogical-host :yadfa.home (if uiop:*image-dumped-p*
- (make-pathname
- :device (pathname-device (truename (uiop:argv0)))
- :directory (pathname-directory (truename (uiop:argv0))))
- (asdf:system-source-directory "yadfa"))))
- (set-logical-pathnames))
+ :device (pathname-device (truename (uiop:argv0)))
+ :directory (pathname-directory (truename (uiop:argv0))))
+ (asdf:system-source-directory "yadfa"))))
+ (set-logical-pathnames))
(defun process-potty-dance-check (character attack)
(and (or
(>= (bladder/contents-of character) (bladder/potty-dance-limit-of character))
@@ -111,37 +111,37 @@
1)
(or (eq attack t) (not (typep (get-move attack character) '(or mess-move-mixin wet-move-mixin))))))
(defunassert get-positions-of-type (type list)
- (type type-specifier
- list list)
+ (type type-specifier
+ list list)
(iter (for i in list)
- (for (the fixnum j) upfrom 0)
- (when (typep i type)
- (collect j))))
+ (for (the fixnum j) upfrom 0)
+ (when (typep i type)
+ (collect j))))
(defunassert finished-events (events)
- (events (or list symbol))
+ (events (or list symbol))
(iter (for (the (or list symbol) event) in (a:ensure-list events))
- #-(or sbcl ccl)
- (check-type event (or list symbol))
- (unless (gethash (a:ensure-list event) (finished-events-of *game*))
- (leave))
- (finally (return t))))
+ #-(or sbcl ccl)
+ (check-type event (or list symbol))
+ (unless (gethash (a:ensure-list event) (finished-events-of *game*))
+ (leave))
+ (finally (return t))))
(defunassert unfinished-events (events)
- (events (or list symbol))
+ (events (or list symbol))
(iter (for (the (or list symbol) event) in (a:ensure-list events))
- #-(or sbcl ccl)
- (check-type event (or list symbol))
- (when (gethash (a:ensure-list event) (finished-events-of *game*))
- (leave))
- (finally (return t))))
+ #-(or sbcl ccl)
+ (check-type event (or list symbol))
+ (when (gethash (a:ensure-list event) (finished-events-of *game*))
+ (leave))
+ (finally (return t))))
(defunassert finish-events (events)
- (events (or list symbol))
+ (events (or list symbol))
(iter (for (the symbol event) in (a:ensure-list events))
- #-(or sbcl ccl)
- (check-type event symbol)
- (remhash event (current-events-of *game*))
- (setf (gethash `(,event) (finished-events-of *game*)) t)))
+ #-(or sbcl ccl)
+ (check-type event symbol)
+ (remhash event (current-events-of *game*))
+ (setf (gethash `(,event) (finished-events-of *game*)) t)))
(defunassert get-diaper-expansion (item)
- (item closed-bottoms)
+ (item closed-bottoms)
(+ (* 10 (/ (+ (sogginess-of item) (messiness-of item))
(- (* 72 36) (* (/ (* 72 5/7) 2) 18/2 pi))))
(thickness-of item)))
@@ -162,13 +162,13 @@
(t new))))
(iter (for i in (uiop:directory*
#P((:common :yadfa.data) ("MODS" :**) (:* "ASD") :newest)))
- (setf (gethash (pathname-name i) *mod-registry*)
- (preferred-mod (gethash (pathname-name i) *mod-registry*)
- i)))))
+ (setf (gethash (pathname-name i) *mod-registry*)
+ (preferred-mod (gethash (pathname-name i) *mod-registry*)
+ i)))))
(defun clear-pattern-cache ()
(clrhash *pattern-cache*))
(defunassert find-mod (system)
- (system (or symbol simple-string))
+ (system (or symbol simple-string))
(gethash (asdf:primary-system-name system) *mod-registry*))
(defun clear-configuration-hook ()
(set-logical-pathnames)
@@ -193,16 +193,16 @@
(if (and
(typep mods 'list)
(iter (for i in mods)
- (unless (typep i '(or string symbol asdf/component:component))
- (leave nil))
- (finally (return t))))
+ (unless (typep i '(or string symbol asdf/component:component))
+ (leave nil))
+ (finally (return t))))
(setf *mods* mods)
(write-line "The configuration file containing the list of enabled mods isn't valid, ignoring")))
(let ((*compile-verbose* compiler-verbose)
(*compile-print* compiler-verbose))
(iter (for i in *mods*)
- (when (asdf:find-system i nil)
- (apply #'asdf:load-system i :allow-other-keys t keys))))))
+ (when (asdf:find-system i nil)
+ (apply #'asdf:load-system i :allow-other-keys t keys))))))
(defun (setf getf-direction) (new-value position direction attribute)
(setf (getf (getf (direction-attributes-of (get-zone position)) direction) attribute) new-value))
(defun getf-direction (position direction attribute)
@@ -213,8 +213,8 @@
(remf (direction-attributes-of (get-zone position)) direction)))
(defun set-status-condition (status-condition user &key duration test key
&aux (status-conditions (iter (for i in (getf (status-conditions-of *battle*) user))
- (when (eq (type-of i) status-condition)
- (collect i))))
+ (when (eq (type-of i) status-condition)
+ (collect i))))
(i (if (or (eq (accumulative-of (make-instance status-condition)) t)
(list-length-> (accumulative-of (make-instance status-condition)) status-conditions))
(make-instance status-condition)
@@ -231,34 +231,34 @@
(setf (duration-of i) duration))
t)
(defunassert trigger-event (event-ids)
- (event-ids (or symbol list))
+ (event-ids (or symbol list))
(iter (for (the symbol event-id) in (a:ensure-list event-ids))
- #-(or sbcl ccl)
- (check-type event-id symbol)
- (when (and
- (funcall (coerce (slot-value (get-event event-id) 'predicate) 'function)
- (get-event event-id))
- (or (and (slot-value (get-event event-id) 'repeatable) (not (gethash event-id (current-events-of *game*))))
- (not (gethash event-id (finished-events-of *game*))))
- (finished-events (slot-value (get-event event-id) 'finished-depends)))
- (let* ((mission (slot-value (get-event event-id) 'mission))
- (accept (when mission
- (funcall (coerce (slot-value (get-event event-id) 'mission) 'function)))))
- (when mission
- (setf (gethash event-id (current-events-of *game*)) t))
- (setf (gethash `(,event-id
- ,@(when (and mission (s:memq accept '(:accepted :declined)))
- `(,accept)))
- (finished-events-of *game*))
- t)
- (apply (coerce (slot-value (get-event event-id) 'lambda) 'function)
- `(,event-id ,@(when mission `(,accept)))))
- (collect event-id))))
+ #-(or sbcl ccl)
+ (check-type event-id symbol)
+ (when (and
+ (funcall (coerce (slot-value (get-event event-id) 'predicate) 'function)
+ (get-event event-id))
+ (or (and (slot-value (get-event event-id) 'repeatable) (not (gethash event-id (current-events-of *game*))))
+ (not (gethash event-id (finished-events-of *game*))))
+ (finished-events (slot-value (get-event event-id) 'finished-depends)))
+ (let* ((mission (slot-value (get-event event-id) 'mission))
+ (accept (when mission
+ (funcall (coerce (slot-value (get-event event-id) 'mission) 'function)))))
+ (when mission
+ (setf (gethash event-id (current-events-of *game*)) t))
+ (setf (gethash `(,event-id
+ ,@(when (and mission (s:memq accept '(:accepted :declined)))
+ `(,accept)))
+ (finished-events-of *game*))
+ t)
+ (apply (coerce (slot-value (get-event event-id) 'lambda) 'function)
+ `(,event-id ,@(when mission `(,accept)))))
+ (collect event-id))))
(defunassert event-attributes (event-id)
- (event-id symbol)
+ (event-id symbol)
(gethash event-id (slot-value *game* 'event-attributes%)))
(defunassert (setf event-attributes) (instance event-id)
- (event-id symbol)
+ (event-id symbol)
(setf (gethash event-id (slot-value *game* 'event-attributes%)) instance))
(defun set-new-battle (enemies &rest keys &key team-npcs win-events enter-battle-text continuable)
(when continuable
@@ -271,38 +271,38 @@
(setf *battle*
(apply #'make-instance 'battle
:enemies (iter (for (the list j) in enemies)
- (collect (apply #'make-instance (car j) (eval (cdr j)))))
+ (collect (apply #'make-instance (car j) (eval (cdr j)))))
:team-npcs (iter (for (the list j) in team-npcs)
- (collect (apply #'make-instance (car j) (eval (cdr j)))))
+ (collect (apply #'make-instance (car j) (eval (cdr j)))))
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*))
- (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))))))
- (yadfa-bin:pokedex j))
+ (unless (s:memq (class-name (class-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))))))
+ (yadfa-bin:pokedex j))
(switch-user-packages)
(process-battle :attack t :no-team-attack t))
(defunassert run-equip-effects (user)
- (user base-character)
+ (user base-character)
(iter (for i in (wear-of user))
- (wear-script i user))
+ (wear-script i user))
(when (wield-of user)
(wield-script (wield-of user) user)))
(defunassert get-warp-point (direction position)
- (direction symbol position list)
+ (direction symbol position list)
(getf (warp-points-of (get-zone position))
(typecase direction
((member :north :south :east :west :up :down)
direction)
(keyword
(iter (for (k v) on (warp-points-of (get-zone position)) by 'cddr)
- (when (and (string= k direction) v)
- (leave k))))
+ (when (and (string= k direction) v)
+ (leave k))))
(symbol direction))))
(defunassert get-destination (direction position)
- (direction symbol position list)
+ (direction symbol position list)
(macrolet ((a (pos x y z)
(a:with-gensyms ((posx "POSX") (posy "POSY") (posz "POSZ") (posm "POSM") (b "B"))
`(let ((,b (destructuring-bind (,posx ,posy ,posz ,posm) ,pos
@@ -322,7 +322,7 @@
(defunassert get-path-end (destination &optional position direction
&aux (player (player-of *game*)) (allies (allies-of *game*)) (wield (wield-of player))
(wear (wear-of player)) (inventory (inventory-of player)))
- (direction symbol position list destination list)
+ (direction symbol position list destination list)
(unless (get-zone destination)
(return-from get-path-end (values nil (format nil "Pick a direction the game knows about~%"))))
(when (or (hiddenp (get-zone destination)) (and position direction (getf-direction position direction :hidden)))
@@ -336,9 +336,9 @@
(cons wield wear)
(let ((a ()))
(iter (for i in allies)
- (push (wield-of i) a)
- (iter (for j in (wear-of i))
- (push j a)))
+ (push (wield-of i) a)
+ (iter (for j in (wear-of i))
+ (push j a)))
a)))))
(and position direction
(getf-direction position direction :locked)
@@ -348,14 +348,14 @@
(cons wield wear)
(let ((a ()))
(iter (for i in allies)
- (push (wield-of i) a)
- (iter (for j in (wear-of i))
- (push j a)))
+ (push (wield-of i) a)
+ (iter (for j in (wear-of i))
+ (push j a)))
a))))))
(return-from get-path-end (values nil (format nil "zone ~a is locked~%" destination))))
destination)
(defunassert print-map-pattern-cache (path designs)
- (path pathname designs list)
+ (path pathname designs list)
(or (gethash `(:map-pattern ,path ,designs) *pattern-cache*)
(setf (gethash `(:map-pattern ,path ,designs) *pattern-cache*)
(clim:make-pattern-from-bitmap-file
@@ -375,7 +375,7 @@
(and (not (s:memq direction '(:up :down)))))
t))
(defunassert print-map (position &aux (player (player-of *game*)) (player-position (position-of player)) (player-zone (get-zone player-position)))
- (player player player-position list player-zone (or null zone))
+ (player player player-position list player-zone (or null zone))
(labels ((a (position)
(let ((b 0)
(array
@@ -396,65 +396,65 @@
#P"e.xpm"
#P"dot.xpm")))
(iter (for direction in '(:east :west :south :north))
- (for (the fixnum byte-position) upfrom 0)
- (unless (travelablep position direction)
- (setf (ldb (byte 1 byte-position) b) 1)))
+ (for (the fixnum byte-position) upfrom 0)
+ (unless (travelablep position direction)
+ (setf (ldb (byte 1 byte-position) b) 1)))
(aref array b))))
(updating-present-with-effective-frame (*query-io* :unique-id `(map% ,position)
:id-test #'equal
:cache-value (sxhash (list player-position
(iter (for i in '(:north :south :east :west :up :down))
- (collect (travelablep player-position i)))
+ (collect (travelablep player-position i)))
(and player-zone
(warp-points-of player-zone)))))
- (let ((pattern (print-map-pattern-cache #P"blank.xpm"
- (list clim:+background-ink+ clim:+foreground-ink+))))
- (multiple-value-bind (start-x start-y) (if c:*application-frame*
- (clim:stream-cursor-position *standard-output*)
- (values 0 0))
- (declare (type real start-x start-y))
- (clim:updating-output (t)
- ;; position needs to be bound inside of clim:updating-output and not outside
- ;; for the presentation to notice when the floor the player is on changes
- (let* ((player-position (position-of (player-of *game*)))
- (position (if (eq position t)
- player-position
- position)))
- (declare (type list position player-position))
- (destructuring-bind (posx posy posz posm) position
- (declare (type integer posx posy posz)
- (type symbol posm))
- (iter (for (the integer y)
- from (- posy 15)
- to (+ posy 15))
- (for y-pos
- from start-y
- to (+ start-y (* 30 (the (unsigned-byte 32) (clim:pattern-height pattern))))
- by (the (unsigned-byte 32) (clim:pattern-height pattern)))
- (iter (for (the integer x)
- from (- posx 15)
- to (+ posx 15))
- (for x-pos
- from start-x
- to (+ start-x (* 30 (the (unsigned-byte 32) (clim:pattern-width pattern))))
- by (the (unsigned-byte 32) (clim:pattern-width pattern)))
- (let* ((current-position `(,x ,y ,posz ,posm))
- (current-zone (get-zone current-position))
- (char (cons (if (or (and current-zone (hiddenp current-zone)) (not current-zone))
- #P"blank.xpm"
- (a current-position))
- (clim:make-rgb-color (if (and current-zone (warp-points-of current-zone)) 1 0)
- (if (equal current-position player-position) 0.7l0 0)
- (if (or (travelablep current-position :up) (travelablep current-position :down)) 1 0)))))
- (setf pattern (print-map-pattern-cache (car char) (list clim:+background-ink+ (cdr char))))
- (when (get-zone current-position)
- (clim:with-output-as-presentation
- (*standard-output* (get-zone current-position) 'zone)
- (clim:draw-pattern* *standard-output* pattern x-pos y-pos)))))))))
- (when c:*application-frame*
- (clim:stream-set-cursor-position *standard-output* start-x (+ start-y (* 31 (the (unsigned-byte 32) (clim:pattern-height pattern)))))))))))
+ (let ((pattern (print-map-pattern-cache #P"blank.xpm"
+ (list clim:+background-ink+ clim:+foreground-ink+))))
+ (multiple-value-bind (start-x start-y) (if c:*application-frame*
+ (clim:stream-cursor-position *standard-output*)
+ (values 0 0))
+ (declare (type real start-x start-y))
+ (clim:updating-output (t)
+ ;; position needs to be bound inside of clim:updating-output and not outside
+ ;; for the presentation to notice when the floor the player is on changes
+ (let* ((player-position (position-of (player-of *game*)))
+ (position (if (eq position t)
+ player-position
+ position)))
+ (declare (type list position player-position))
+ (destructuring-bind (posx posy posz posm) position
+ (declare (type integer posx posy posz)
+ (type symbol posm))
+ (iter (for (the integer y)
+ from (- posy 15)
+ to (+ posy 15))
+ (for y-pos
+ from start-y
+ to (+ start-y (* 30 (the (unsigned-byte 32) (clim:pattern-height pattern))))
+ by (the (unsigned-byte 32) (clim:pattern-height pattern)))
+ (iter (for (the integer x)
+ from (- posx 15)
+ to (+ posx 15))
+ (for x-pos
+ from start-x
+ to (+ start-x (* 30 (the (unsigned-byte 32) (clim:pattern-width pattern))))
+ by (the (unsigned-byte 32) (clim:pattern-width pattern)))
+ (let* ((current-position `(,x ,y ,posz ,posm))
+ (current-zone (get-zone current-position))
+ (char (cons (if (or (and current-zone (hiddenp current-zone)) (not current-zone))
+ #P"blank.xpm"
+ (a current-position))
+ (clim:make-rgb-color (if (and current-zone (warp-points-of current-zone)) 1 0)
+ (if (equal current-position player-position) 0.7l0 0)
+ (if (or (travelablep current-position :up) (travelablep current-position :down)) 1 0)))))
+ (setf pattern (print-map-pattern-cache (car char) (list clim:+background-ink+ (cdr char))))
+ (when (get-zone current-position)
+ (clim:with-output-as-presentation
+ (*standard-output* (get-zone current-position) 'zone)
+ (clim:draw-pattern* *standard-output* pattern x-pos y-pos)))))))))
+ (when c:*application-frame*
+ (clim:stream-set-cursor-position *standard-output* start-x (+ start-y (* 31 (the (unsigned-byte 32) (clim:pattern-height pattern)))))))))))
(defunassert get-zone-text (text)
- (text (or string coerced-function))
+ (text (or string coerced-function))
(typecase text
(string
text)
@@ -467,8 +467,8 @@
old-direction)
(keyword
(iter (for (k v) on (warp-points-of (get-zone old-position)) by 'cddr)
- (when (and (string= k old-direction) v)
- (leave k))))
+ (when (and (string= k old-direction) v)
+ (leave k))))
(symbol old-direction)))))
(format t "~a~%" (get-zone-text (if (and old-position old-direction (getf-direction old-position old-direction :exit-text))
(getf-direction old-position old-direction :exit-text)
@@ -493,27 +493,27 @@
(z '(0 0 1) :up stairs)
(z '(0 0 -1) :down stairs)))
(iter (for (a b) on (warp-points-of (get-zone position)) by #'cddr)
- (when (and (get-zone b) (not (hiddenp (get-zone b))))
- (format t "To ~s is ~a. " a (name-of (get-zone b)))))
+ (when (and (get-zone b) (not (hiddenp (get-zone b))))
+ (format t "To ~s is ~a. " a (name-of (get-zone b)))))
(format t "~%"))
(defun get-inventory-list ()
(iter (for i in (inventory-of (player-of *game*))) (collect (symbol-name (type-of i)))))
(defunassert filter-items (items type)
- (items list type type-specifier)
+ (items list type type-specifier)
"This function will return all items in the list @var{ITEMS} that is of type @var{TYPE}"
(iter (for item in items)
- (when (typep item type)
- (collect item))))
+ (when (typep item type)
+ (collect item))))
(defunassert swell-up% (user)
- (user base-character)
+ (user base-character)
(iter (for i in (filter-items (wear-of user) 'closed-bottoms))
- (if (waterproofp i)
- (finish)
- (progn
- (setf (sogginess-of i) (sogginess-capacity-of i))
- (collect i)))))
+ (if (waterproofp i)
+ (finish)
+ (progn
+ (setf (sogginess-of i) (sogginess-capacity-of i))
+ (collect i)))))
(defunassert swell-up (user &aux (swollen-clothes (swell-up% user)) (name (name-of user)))
- (user base-character)
+ (user base-character)
(cond
((filter-items swollen-clothes 'diaper)
(format t "~a's diapers swells up humorously~%~%" name))
@@ -526,22 +526,22 @@
(swell-up (player-of *game*))
(iter (for i in (allies-of *game*)) (swell-up i)))
(defunassert total-thickness (clothing)
- (clothing list)
+ (clothing list)
(iter (for i in (filter-items clothing 'closed-bottoms))
- (with j = 0)
- (incf j (get-diaper-expansion i))
- (finally (return j))))
+ (with j = 0)
+ (incf j (get-diaper-expansion i))
+ (finally (return j))))
(defun fast-thickness (list item)
#+sbcl (declare (type list list)
(type clothing item))
(s:nlet execute (list item (count 0))
- (if (or (eq (car list) item) (endp list))
- count
- (execute (cdr list) item (if (typep (car list) 'closed-bottoms)
- (+ count (get-diaper-expansion (car list)))
- count)))))
+ (if (or (eq (car list) item) (endp list))
+ count
+ (execute (cdr list) item (if (typep (car list) 'closed-bottoms)
+ (+ count (get-diaper-expansion (car list)))
+ count)))))
(defunassert pop-from-expansion (user &optional wet/mess &aux (reverse-wear (nreverse (wear-of user))) (last (car reverse-wear)) (return ()))
- (user base-character)
+ (user base-character)
(macrolet ((pushclothing (i wet/mess return)
`(progn
(when (and (getf (car ,wet/mess) :wet-amount)
@@ -552,81 +552,81 @@
(pushnew ,i (getf (cdr ,wet/mess) :popped)))
(pushnew ,i ,return))))
(iter
- (for item in reverse-wear)
- (let* ((thickness-capacity (if (typep item 'bottoms) (thickness-capacity-of item)))
- (thickness-capacity-threshold (if (typep item 'bottoms) (thickness-capacity-threshold-of item)))
- (total-thickness (if (and (typep item 'bottoms)
- thickness-capacity
- thickness-capacity-threshold)
- (fast-thickness reverse-wear item))))
- (declare (type (or null (real 0)) thickness-capacity thickness-capacity-threshold total-thickness))
- (when
- (and (not (eq item last))
- total-thickness
- thickness-capacity
- thickness-capacity-threshold
- (> total-thickness (+ thickness-capacity thickness-capacity-threshold)))
- (typecase item
- (onesie/closed
- (toggle-onesie% item)
- (if (lockedp item)
- (progn (format t "~a's ~a pops open from the expansion destroying the lock in the process~%~%"
- (name-of user)
- (name-of item))
- (setf (lockedp item) nil))
- (format t "~a's ~a pops open from the expansion~%~%"
- (name-of user)
- (name-of item)))
- (pushclothing (the item item) wet/mess return))
- ((or incontinence-product snap-bottoms)
- (push item (inventory-of (if (typep user 'team-member)
- (player-of *game*)
- user)))
- (a:deletef (the list reverse-wear) item :count 1)
- (format t "~a's ~a comes off from the expansion~%~%"
- (name-of user)
- (name-of item))
- (pushclothing (the item item) wet/mess return))
- ((and bottoms (not incontinence-product))
- (a:deletef (the list reverse-wear) item :count 1)
- (format t "~a's ~a tears from the expansion and is destroyed~%~%"
- (name-of user)
- (name-of item))
- (pushclothing (the item item) wet/mess return))))))
+ (for item in reverse-wear)
+ (let* ((thickness-capacity (if (typep item 'bottoms) (thickness-capacity-of item)))
+ (thickness-capacity-threshold (if (typep item 'bottoms) (thickness-capacity-threshold-of item)))
+ (total-thickness (if (and (typep item 'bottoms)
+ thickness-capacity
+ thickness-capacity-threshold)
+ (fast-thickness reverse-wear item))))
+ (declare (type (or null (real 0)) thickness-capacity thickness-capacity-threshold total-thickness))
+ (when
+ (and (not (eq item last))
+ total-thickness
+ thickness-capacity
+ thickness-capacity-threshold
+ (> total-thickness (+ thickness-capacity thickness-capacity-threshold)))
+ (typecase item
+ (onesie/closed
+ (toggle-onesie% item)
+ (if (lockedp item)
+ (progn (format t "~a's ~a pops open from the expansion destroying the lock in the process~%~%"
+ (name-of user)
+ (name-of item))
+ (setf (lockedp item) nil))
+ (format t "~a's ~a pops open from the expansion~%~%"
+ (name-of user)
+ (name-of item)))
+ (pushclothing (the item item) wet/mess return))
+ ((or incontinence-product snap-bottoms)
+ (push item (inventory-of (if (typep user 'team-member)
+ (player-of *game*)
+ user)))
+ (a:deletef (the list reverse-wear) item :count 1)
+ (format t "~a's ~a comes off from the expansion~%~%"
+ (name-of user)
+ (name-of item))
+ (pushclothing (the item item) wet/mess return))
+ ((and bottoms (not incontinence-product))
+ (a:deletef (the list reverse-wear) item :count 1)
+ (format t "~a's ~a tears from the expansion and is destroyed~%~%"
+ (name-of user)
+ (name-of item))
+ (pushclothing (the item item) wet/mess return))))))
(setf (wear-of user) (nreverse reverse-wear))
(cond ((or (getf (car wet/mess) :popped) (getf (cdr wet/mess) :popped))
(values wet/mess :wet/mess))
(return (values return :return))
(t (values nil nil)))))
(defunassert thickest-sort (clothing)
- (clothing list)
+ (clothing list)
(s:dsu-sort (iter (for i in clothing)
- (when (typep i 'closed-bottoms)
- (collect i)))
+ (when (typep i 'closed-bottoms)
+ (collect i)))
'>
:key 'get-diaper-expansion))
(defunassert thickest (clothing &optional n &aux (a (iter (for i in clothing)
- (when (typep i 'closed-bottoms)
- (collect i)))))
- (clothing list n (or null unsigned-byte))
+ (when (typep i 'closed-bottoms)
+ (collect i)))))
+ (clothing list n (or null unsigned-byte))
(if n
(the (values list &optional)
(s:bestn n a '> :key 'get-diaper-expansion :memo t))
(iter (for i in a)
- (finding i maximizing (get-diaper-expansion i)))))
+ (finding i maximizing (get-diaper-expansion i)))))
(defun move-to-zone (new-position &key ignore-lock direction old-position)
(when (iter (for i in (cons (player-of *game*) (allies-of *game*)))
- (let ((wear (typecase (must-wear-of (get-zone new-position))
- (cons (must-wear-of (get-zone new-position)))
- (symbol (gethash (must-wear-of *game*) (must-wear-of (get-zone new-position))))))
- (not-wear (typecase (must-not-wear-of (get-zone new-position))
- (cons (must-not-wear-of (get-zone new-position)))
- (symbol (gethash (must-not-wear-of *game*) (must-not-wear-of (get-zone new-position)))))))
- (when (or (and (list-length-> 1 (filter-items (wear-of i) (car wear)))
- (not (funcall (coerce (cdr wear) 'function) i)))
- (and (list-length-< 0 (filter-items (wear-of i) (car not-wear)))
- (not (funcall (coerce (cdr not-wear) 'function) i))))
- (leave t))))
+ (let ((wear (typecase (must-wear-of (get-zone new-position))
+ (cons (must-wear-of (get-zone new-position)))
+ (symbol (gethash (must-wear-of *game*) (must-wear-of (get-zone new-position))))))
+ (not-wear (typecase (must-not-wear-of (get-zone new-position))
+ (cons (must-not-wear-of (get-zone new-position)))
+ (symbol (gethash (must-not-wear-of *game*) (must-not-wear-of (get-zone new-position)))))))
+ (when (or (and (list-length-> 1 (filter-items (wear-of i) (car wear)))
+ (not (funcall (coerce (cdr wear) 'function) i)))
+ (and (list-length-< 0 (filter-items (wear-of i) (car not-wear)))
+ (not (funcall (coerce (cdr not-wear) 'function) i))))
+ (leave t))))
(return-from move-to-zone))
(when (and (not ignore-lock)
(or (and (lockedp (get-zone new-position))
@@ -659,8 +659,8 @@
(process-potty)
(run-equip-effects (player-of *game*))
(iter (for i in (allies-of *game*))
- (process-potty i)
- (run-equip-effects i))
+ (process-potty i)
+ (run-equip-effects i))
(print-enter-text (position-of (player-of *game*)) old-position direction)
(cond ((continue-battle-of (get-zone (position-of (player-of *game*))))
(set-new-battle (getf (continue-battle-of (get-zone (position-of (player-of *game*)))) :enemies)
@@ -673,19 +673,19 @@
(return-from move-to-zone))
((resolve-enemy-spawn-list (get-zone (position-of (player-of *game*))))
(let ((enemy-spawn-list (iter (for i in (resolve-enemy-spawn-list (get-zone (position-of (player-of *game*)))))
- (when (< (random 1.0l0) (getf i :chance))
- (leave (cond ((getf i :eval)
- (eval (getf i :eval)))
- ((getf i :lambda)
- (funcall (coerce (getf i :lambda) 'function)))
- (t (getf i :enemies)))))))
+ (when (< (random 1.0l0) (getf i :chance))
+ (leave (cond ((getf i :eval)
+ (eval (getf i :eval)))
+ ((getf i :lambda)
+ (funcall (coerce (getf i :lambda) 'function)))
+ (t (getf i :enemies)))))))
(team-npc-spawn-list (iter (for i in (resolve-team-npc-spawn-list (get-zone (position-of (player-of *game*)))))
- (when (< (random 1.0l0) (getf i :chance))
- (leave (cond ((getf i :eval)
- (eval (getf i :eval)))
- ((getf i :lambda)
- (funcall (coerce (getf i :lambda) 'function)))
- (t (getf i :enemies))))))))
+ (when (< (random 1.0l0) (getf i :chance))
+ (leave (cond ((getf i :eval)
+ (eval (getf i :eval)))
+ ((getf i :lambda)
+ (funcall (coerce (getf i :lambda) 'function)))
+ (t (getf i :enemies))))))))
(when enemy-spawn-list
(set-new-battle enemy-spawn-list :team-npcs team-npc-spawn-list))))))
(defun move-to-secret-underground ()
@@ -703,9 +703,9 @@
(return-from move-to-pocket-map))
(unless (get-zone '(0 0 0 pocket-map))
(make-pocket-zone (0 0 0)
- :name "Pocket Map Entrance"
- :description "Welcome to the Pocket Map. It's like the secret bases in Pokémon, except you customize it by scripting, and you can take it with you."
- :enter-text "You're at the start of the Pocket Map. Use the Pocket Map machine again at anytime to exit."))
+ :name "Pocket Map Entrance"
+ :description "Welcome to the Pocket Map. It's like the secret bases in Pokémon, except you customize it by scripting, and you can take it with you."
+ :enter-text "You're at the start of the Pocket Map. Use the Pocket Map machine again at anytime to exit."))
(let ((old-position (position-of (player-of *game*))))
(move-to-zone (if (eq (fourth (position-of (player-of *game*))) :pocket-map)
(getf (attributes-of item) :pocket-map-position)
@@ -716,10 +716,10 @@
(defunassert wet (&key (wet-amount t) force-fill-amount pants-down accident force-wet-amount (wetter (player-of *game*)) (clothes nil clothes-supplied-p)
&aux (return-value ()) (affected-clothes ()) (random (random 4)) (amount nil)
(clothes (if clothes-supplied-p clothes (wear-of wetter))))
- (force-fill-amount (or null real)
- force-wet-amount (or boolean real)
- wet-amount (or boolean real)
- wetter base-character)
+ (force-fill-amount (or null real)
+ force-wet-amount (or boolean real)
+ wet-amount (or boolean real)
+ wetter base-character)
#.(format nil "this function is mostly for mods, doesn't print text or diaper expansion, that's handled by other functions. @var{WETTER} is the instance of @code{BASE-CHARACTER} doing the flooding. @var{WET-AMOUNT} is the amount @var{WETTER} floods but won't flood if he/she can't go, passing @code{T} to @var{WET-AMOUNT} means to use @code{(BLADDER/CONTENTS-OF WETTER)}, @var{FORCE-WET-AMOUNT} causes @var{WETTER} to wet regardless. @var{FORCE-FILL-AMOUNT} will set @code{(BLADDER/CONTENTS-OF WETTER)} to that amount first. @var{PANTS-DOWN} is @code{T} if @var{WETTER} pulls his/her pants down first. @var{ACCIDENT} is @code{T} if the wetting isn't intentional and @var{WETTER} may or may not be able to stop the flow. if @var{CLOTHES} is passed, it will be the one @var{WETTER} floods, otherwise it will be @code{(wear-of @var{WETTER})}
~a."
@@ -742,9 +742,9 @@
(accident
(setf amount
(a:switch (random :test '=)
- (3 (* 4 (bladder/fill-rate-of wetter)))
- (2 (bladder/need-to-potty-limit-of wetter))
- (t (bladder/contents-of wetter)))))
+ (3 (* 4 (bladder/fill-rate-of wetter)))
+ (2 (bladder/need-to-potty-limit-of wetter))
+ (t (bladder/contents-of wetter)))))
(t (setf amount (cond ((eq wet-amount t)
(bladder/contents-of wetter))
((> wet-amount (bladder/contents-of wetter))
@@ -754,9 +754,9 @@
(setf (getf return-value :accident)
(if accident
(a:switch (random :test '=)
- (3 :dribble)
- (2 :some)
- (t :all))))
+ (3 :dribble)
+ (2 :some)
+ (t :all))))
(setf (getf return-value :old-bladder-contents) (bladder/contents-of wetter))
(let* ((amount-left amount))
(cond ((or pants-down (not (filter-items clothes 'closed-bottoms)))
@@ -765,19 +765,19 @@
(t
(decf (bladder/contents-of wetter) amount)
(iter (while (> amount-left 0))
- (for i in (reverse clothes))
- (when (typep i 'closed-bottoms)
- (cond ((> amount-left (- (sogginess-capacity-of i) (sogginess-of i)))
- (if (leakproofp i)
+ (for i in (reverse clothes))
+ (when (typep i 'closed-bottoms)
+ (cond ((> amount-left (- (sogginess-capacity-of i) (sogginess-of i)))
+ (if (leakproofp i)
+ (setf amount-left 0)
+ (decf amount-left (- (sogginess-capacity-of i) (sogginess-of i))))
+ (setf (sogginess-of i) (sogginess-capacity-of i))
+ (push i affected-clothes)
+ )
+ ((> amount-left 0)
+ (incf (sogginess-of i) amount-left)
(setf amount-left 0)
- (decf amount-left (- (sogginess-capacity-of i) (sogginess-of i))))
- (setf (sogginess-of i) (sogginess-capacity-of i))
- (push i affected-clothes)
- )
- ((> amount-left 0)
- (incf (sogginess-of i) amount-left)
- (setf amount-left 0)
- (push i affected-clothes)))))))
+ (push i affected-clothes)))))))
(setf (getf return-value :new-bladder-contents) (bladder/contents-of wetter))
(setf (getf return-value :affected-clothes) affected-clothes)
(setf (getf return-value :leak-amount) amount-left)
@@ -785,10 +785,10 @@
return-value)
(defunassert mess (&key (mess-amount t) force-fill-amount pants-down accident force-mess-amount (messer (player-of *game*)) (clothes nil clothes-supplied-p)
&aux (return-value ()) (affected-clothes ()) (amount nil) (clothes (if clothes-supplied-p clothes (wear-of messer))))
- (force-fill-amount (or null real)
- force-mess-amount (or boolean real)
- mess-amount (or boolean real)
- messer base-character)
+ (force-fill-amount (or null real)
+ force-mess-amount (or boolean real)
+ mess-amount (or boolean real)
+ messer base-character)
#.(format nil "this function is mostly for mods, doesn't print text or diaper expansion, that's handled by other functions. @var{MESSER} is the instance of @code{BASE-CHARACTER} doing the messing. @var{MESS-AMOUNT} is the amount @var{MESSER} messes but won't mess if he/she can't go, passing @code{T} to @var{MESS-AMOUNT} means to use @code{(BOWELS/CONTENTS-OF MESSER)}, @var{FORCE-MESS-AMOUNT} causes @var{MESSER} to mess regardless. @var{FORCE-FILL-AMOUNT} will set @code{(BOWELS/CONTENTS-OF MESSER)} to that amount first. @var{PANTS-DOWN} is @code{T} if @var{MESSER} pulls his/her pants down first. @var{ACCIDENT} is @code{T} if the messing isn't intentional. If @var{CLOTHES} is passed, it will be the one @var{MESSER} messes, otherwise it will be @code{(wear-of @var{MESSER})}
@@ -825,27 +825,27 @@
(t
(decf (bowels/contents-of messer) amount)
(iter (while (> amount-left 0))
- (for i in (reverse clothes))
- (when (typep i 'closed-bottoms)
- (cond ((> amount-left (- (messiness-capacity-of i) (messiness-of i)))
- (if (leakproofp i)
+ (for i in (reverse clothes))
+ (when (typep i 'closed-bottoms)
+ (cond ((> amount-left (- (messiness-capacity-of i) (messiness-of i)))
+ (if (leakproofp i)
+ (setf amount-left 0)
+ (decf amount-left (- (messiness-capacity-of i) (messiness-of i))))
+ (setf (messiness-of i) (messiness-capacity-of i))
+ (push i affected-clothes))
+ ((> amount-left 0)
+ (incf (messiness-of i) amount-left)
(setf amount-left 0)
- (decf amount-left (- (messiness-capacity-of i) (messiness-of i))))
- (setf (messiness-of i) (messiness-capacity-of i))
- (push i affected-clothes))
- ((> amount-left 0)
- (incf (messiness-of i) amount-left)
- (setf amount-left 0)
- (push i affected-clothes)))))))
+ (push i affected-clothes)))))))
(setf (getf return-value :new-bowels-contents) (bowels/contents-of messer))
(setf (getf return-value :affected-clothes) affected-clothes)
(setf (getf return-value :leak-amount) amount-left)
(setf (getf return-value :mess-amount) amount))
return-value)
(defunassert potty-on-toilet (prop &key wet mess pants-down (user (player-of *game*)))
- (prop yadfa-props:toilet
- wet (or boolean real)
- mess (or boolean real))
+ (prop yadfa-props:toilet
+ wet (or boolean real)
+ mess (or boolean real))
(when (notany #'identity (list wet mess))
(setf wet t
mess t))
@@ -861,13 +861,13 @@
:user user))
(return-from potty-on-toilet))
((and pants-down (iter (for i in (filter-items (wear-of user) 'closed-bottoms))
- (when (lockedp i)
- (format t "~a struggles to remove ~a ~a, realizes ~a can't, then starts panicking while doing a potty dance.~%"
- (name-of user)
- (if (malep user) "his" "her")
- (name-of i)
- (if (malep user) "he" "she"))
- (leave t))))
+ (when (lockedp i)
+ (format t "~a struggles to remove ~a ~a, realizes ~a can't, then starts panicking while doing a potty dance.~%"
+ (name-of user)
+ (if (malep user) "his" "her")
+ (name-of i)
+ (if (malep user) "he" "she"))
+ (leave t))))
(return-from potty-on-toilet)))
(let* ((mess-return-value (when mess
(mess :mess-amount mess :pants-down pants-down :messer user)))
@@ -905,8 +905,8 @@
out)
(format t "~a~%" (a:random-elt out))))))
(defunassert potty-on-self-or-prop (prop &key wet mess pants-down (user (player-of *game*)))
- (wet (or boolean real)
- mess (or boolean real))
+ (wet (or boolean real)
+ mess (or boolean real))
(when (notany #'identity (list wet mess))
(setf wet t
mess t))
@@ -924,13 +924,13 @@
:user user))
(return-from potty-on-self-or-prop))
((and pants-down (iter (for i in (filter-items (wear-of user) 'closed-bottoms))
- (when (lockedp i)
- (format t "~a struggles to remove ~a ~a, realizes ~a can't, then starts panicking while doing a potty dance.~%"
- (name-of user)
- (if (malep user) "his" "her")
- (name-of i)
- (if (malep user) "he" "she"))
- (leave t))))
+ (when (lockedp i)
+ (format t "~a struggles to remove ~a ~a, realizes ~a can't, then starts panicking while doing a potty dance.~%"
+ (name-of user)
+ (if (malep user) "his" "her")
+ (name-of i)
+ (if (malep user) "he" "she"))
+ (leave t))))
(return-from potty-on-self-or-prop)))
(let*
((mess-return-value (when mess
@@ -1277,7 +1277,7 @@
(funcall (coerce (potty-trigger-of (get-zone (position-of (player-of *game*)))) 'function)
(cons wet-return-value mess-return-value) user))))))))
(defunassert process-potty (&optional (user (player-of *game*)))
- (user (or player ally))
+ (user (or player ally))
(let ((time-difference (- (time-of *game*) (last-process-potty-time-of user))))
(incf (bladder/contents-of user) (* (bladder/fill-rate-of user) time-difference))
(incf (bowels/contents-of user) (* (bowels/fill-rate-of user) time-difference)))
@@ -1292,13 +1292,13 @@
(when (>= (bowels/contents-of user) (bowels/need-to-potty-limit-of user))
(mess :messer user))))))
(iter (for i in '(:wet :mess))
- (output-process-potty-text user
- (get-babyish-padding user)
- i
- (get-process-potty-action-type user
- i
- had-accident)
- had-accident))
+ (output-process-potty-text user
+ (get-babyish-padding user)
+ i
+ (get-process-potty-action-type user
+ i
+ had-accident)
+ had-accident))
(multiple-value-bind
(value key)
(pop-from-expansion user had-accident)
@@ -1331,78 +1331,78 @@
(string= a (class-name (class-of b)))
(eq a (class-name (class-of b)))))))
(defunassert calculate-diaper-usage (user)
- (user base-character)
+ (user base-character)
(iter
- (with sogginess = 0)
- (with sogginess-capacity = 0)
- (with messiness = 0)
- (with messiness-capacity = 0)
- (for i in (wear-of user))
- (when (typep i 'closed-bottoms)
- (incf sogginess (sogginess-of i))
- (incf sogginess-capacity (sogginess-capacity-of i))
- (incf messiness (messiness-of i))
- (incf messiness-capacity (messiness-capacity-of i)))
- (finally (return `(:sogginess ,sogginess :sogginess-capacity ,sogginess-capacity
- :messiness ,messiness :messiness-capacity ,messiness-capacity)))))
+ (with sogginess = 0)
+ (with sogginess-capacity = 0)
+ (with messiness = 0)
+ (with messiness-capacity = 0)
+ (for i in (wear-of user))
+ (when (typep i 'closed-bottoms)
+ (incf sogginess (sogginess-of i))
+ (incf sogginess-capacity (sogginess-capacity-of i))
+ (incf messiness (messiness-of i))
+ (incf messiness-capacity (messiness-capacity-of i)))
+ (finally (return `(:sogginess ,sogginess :sogginess-capacity ,sogginess-capacity
+ :messiness ,messiness :messiness-capacity ,messiness-capacity)))))
(defunassert calculate-diaper-usage* (clothes)
- (clothes list)
+ (clothes list)
(iter
- (with sogginess = 0)
- (with sogginess-capacity = 0)
- (with messiness = 0)
- (with messiness-capacity = 0)
- (for i in clothes)
- (when (typep i 'closed-bottoms)
- (incf sogginess (sogginess-of i))
- (incf sogginess-capacity (sogginess-capacity-of i))
- (incf messiness (messiness-of i))
- (incf messiness-capacity (messiness-capacity-of i)))
- (finally (return `(:sogginess ,sogginess :sogginess-capacity ,sogginess-capacity
- :messiness ,messiness :messiness-capacity ,messiness-capacity)))))
+ (with sogginess = 0)
+ (with sogginess-capacity = 0)
+ (with messiness = 0)
+ (with messiness-capacity = 0)
+ (for i in clothes)
+ (when (typep i 'closed-bottoms)
+ (incf sogginess (sogginess-of i))
+ (incf sogginess-capacity (sogginess-capacity-of i))
+ (incf messiness (messiness-of i))
+ (incf messiness-capacity (messiness-capacity-of i)))
+ (finally (return `(:sogginess ,sogginess :sogginess-capacity ,sogginess-capacity
+ :messiness ,messiness :messiness-capacity ,messiness-capacity)))))
(defunassert calculate-level-to-exp (level)
- (level real)
+ (level real)
(floor (/ (* 4 (expt level 3)) 5)))
(defunassert calculate-exp-yield (target)
- (target enemy)
+ (target enemy)
(u:$ (exp-yield-of target) * (level-of target) / 7))
(defunassert calculate-wear-stats (user)
- (user base-character)
+ (user base-character)
(iter
- (with j = (list :health 0 :attack 0 :defense 0 :energy 0 :speed 0))
- (for i in (wear-of user))
- (iter
- (for (a b) on (wear-stats-of i) by #'cddr)
- (incf (getf j a) b))
- (finally (return j))))
+ (with j = (list :health 0 :attack 0 :defense 0 :energy 0 :speed 0))
+ (for i in (wear-of user))
+ (iter
+ (for (a b) on (wear-stats-of i) by #'cddr)
+ (incf (getf j a) b))
+ (finally (return j))))
(defunassert calculate-wield-stats (user)
- (user base-character)
+ (user base-character)
(iter
- (with j = (list :health 0 :attack 0 :defense 0 :energy 0 :speed 0))
- (for (a b) on (if (wield-of user) (wield-stats-of (wield-of user)) ()) by #'cddr)
- (incf (getf j a) b)
- (finally (return j))))
+ (with j = (list :health 0 :attack 0 :defense 0 :energy 0 :speed 0))
+ (for (a b) on (if (wield-of user) (wield-stats-of (wield-of user)) ()) by #'cddr)
+ (incf (getf j a) b)
+ (finally (return j))))
(defunassert calculate-stat-delta (user)
- (user base-character)
+ (user base-character)
(iter
- (with j = (list :health 0 :attack 0 :defense 0 :energy 0 :speed 0))
- (for i in (when *battle* (getf (status-conditions-of *battle*) user)))
- (iter
- (for (a b) on (stat-delta-of i) by #'cddr)
- (incf (getf j a) b))
- (finally (return j))))
+ (with j = (list :health 0 :attack 0 :defense 0 :energy 0 :speed 0))
+ (for i in (when *battle* (getf (status-conditions-of *battle*) user)))
+ (iter
+ (for (a b) on (stat-delta-of i) by #'cddr)
+ (incf (getf j a) b))
+ (finally (return j))))
(defunassert calculate-stat-multiplier (user)
- (user base-character)
+ (user base-character)
(iter
- (with j = (list :health 1 :attack 1 :defense 1 :energy 1 :speed 1))
- (for i in (when *battle* (getf (status-conditions-of *battle*) user)))
- (iter
- (for (a b) on (stat-multiplier-of i) by #'cddr)
- (declare (ignorable b))
- (setf (getf j a) (* (getf j a))))
- (finally (return j))))
+ (with j = (list :health 1 :attack 1 :defense 1 :energy 1 :speed 1))
+ (for i in (when *battle* (getf (status-conditions-of *battle*) user)))
+ (iter
+ (for (a b) on (stat-multiplier-of i) by #'cddr)
+ (declare (ignorable b))
+ (setf (getf j a) (* (getf j a))))
+ (finally (return j))))
(defunassert calculate-stat (user stat-key)
- (user base-character)
+ (user base-character)
(round (if (or (eq stat-key :health) (eq stat-key :energy))
(u:$ (u:$ (u:$ (u:$ (u:$ (getf (base-stats-of user) stat-key) +
(getf (iv-stats-of user) stat-key) +
@@ -1426,8 +1426,8 @@
+ 5))))
(defun present-stats (user)
(updating-present-with-effective-frame (*query-io* :unique-id `(stats% ,user) :id-test #'equal)
- (clim:updating-output (*query-io*)
- (clim:present user (type-of user) :view yadfa-clim:+stat-view+))))
+ (clim:updating-output (*query-io*)
+ (clim:present user (type-of user) :view yadfa-clim:+stat-view+))))
(defun describe-item (item &optional wear)
(format t
"Name: ~a~%Resale Value: ~f~%Description:~%~a~%"
@@ -1442,13 +1442,13 @@
(format t "Ammo Type: ~s" (ammo-type-of item)))
(when (special-actions-of item)
(iter (for (a b) on (special-actions-of item) by #'cddr)
- (format t "Keyword: ~a~%Other Parameters: ~w~%Documentation: ~a~%~%Describe: ~a~%~%"
- a
- (cddr (lambda-list (action-lambda b)))
- (documentation b t)
- (with-output-to-string (s)
- (let ((*standard-output* s))
- (describe (action-lambda b)))))))
+ (format t "Keyword: ~a~%Other Parameters: ~w~%Documentation: ~a~%~%Describe: ~a~%~%"
+ a
+ (cddr (lambda-list (action-lambda b)))
+ (documentation b t)
+ (with-output-to-string (s)
+ (let ((*standard-output* s))
+ (describe (action-lambda b)))))))
t)
(defun finish-battle (&optional lose &aux (player (player-of *game*)) (male (malep player)) (name (name-of player))
(position (position-of player)) (enemies (enemies-of *battle*)) (team (team-of *game*)))
@@ -1465,59 +1465,59 @@
(name-of (get-zone position))
position)
(iter (for user in (cons player (allies-of *game*)))
- (setf (health-of user) (calculate-stat user :health))
- (setf (energy-of user) (calculate-stat user :energy)))
+ (setf (health-of user) (calculate-stat user :health))
+ (setf (energy-of user) (calculate-stat user :energy)))
(let ((exp-gained (/ (iter (for enemy in enemies)
- (with j = 0)
- (incf j (calculate-exp-yield enemy))
- (finally (return j)))
+ (with j = 0)
+ (incf j (calculate-exp-yield enemy))
+ (finally (return j)))
2)))
(iter (for team-member in team)
- (incf (exp-of team-member) exp-gained)
- (let ((old-level (level-of team-member)))
- (iter (while (>= (exp-of team-member) (calculate-level-to-exp (+ (level-of team-member) 1))))
- (incf (level-of team-member)))
- (when (> (level-of team-member) old-level)
- (format t "~a level-uped to ~d~%" (name-of team-member) (level-of team-member))
- (iter (for level from (1+ old-level) to (level-of team-member))
- (iter (for learned-move in (learned-moves-of team-member))
- (when (= (car learned-move) level)
- (unless (get-move (cdr learned-move) team-member)
- (pushnewmove (cdr learned-move) team-member)
- (format t "~a learned ~a~%" (name-of team-member) (name-of (get-move (cdr learned-move) team-member))))))))))
+ (incf (exp-of team-member) exp-gained)
+ (let ((old-level (level-of team-member)))
+ (iter (while (>= (exp-of team-member) (calculate-level-to-exp (+ (level-of team-member) 1))))
+ (incf (level-of team-member)))
+ (when (> (level-of team-member) old-level)
+ (format t "~a level-uped to ~d~%" (name-of team-member) (level-of team-member))
+ (iter (for level from (1+ old-level) to (level-of team-member))
+ (iter (for learned-move in (learned-moves-of team-member))
+ (when (= (car learned-move) level)
+ (unless (get-move (cdr learned-move) team-member)
+ (pushnewmove (cdr learned-move) team-member)
+ (format t "~a learned ~a~%" (name-of team-member) (name-of (get-move (cdr learned-move) team-member))))))))))
(setf *battle* nil))
(iter (for team-member in team)
- (wet :force-fill-amount (bladder/maximum-limit-of team-member))
- (mess :force-fill-amount (bowels/maximum-limit-of team-member))))
+ (wet :force-fill-amount (bladder/maximum-limit-of team-member))
+ (mess :force-fill-amount (bowels/maximum-limit-of team-member))))
(progn (format t "~a won the battle~%~%" name)
(let ((items-looted (iter (for enemy in enemies)
- (with j = ())
- (setf j (append* j (inventory-of enemy) (wear-of enemy)))
- (setf (inventory-of enemy) nil
- (wear-of enemy) nil)
- (finally (return j))))
+ (with j = ())
+ (setf j (append* j (inventory-of enemy) (wear-of enemy)))
+ (setf (inventory-of enemy) nil
+ (wear-of enemy) nil)
+ (finally (return j))))
(bitcoins-looted (iter (for enemy in enemies)
- (with j = 0)
- (incf j (if (bitcoins-per-level-of enemy) (* (bitcoins-per-level-of enemy) (level-of enemy)) (bitcoins-of enemy)))
- (finally (return j))))
+ (with j = 0)
+ (incf j (if (bitcoins-per-level-of enemy) (* (bitcoins-per-level-of enemy) (level-of enemy)) (bitcoins-of enemy)))
+ (finally (return j))))
(exp-gained (iter (for enemy in enemies)
- (with j = 0)
- (incf j (calculate-exp-yield enemy))
- (finally (return j))))
+ (with j = 0)
+ (incf j (calculate-exp-yield enemy))
+ (finally (return j))))
(win-events (win-events-of *battle*)))
(iter (for team-member in team)
- (incf (exp-of team-member) exp-gained)
- (let ((old-level (level-of team-member)))
- (iter (while (>= (exp-of team-member) (calculate-level-to-exp (+ (level-of team-member) 1))))
- (incf (level-of team-member)))
- (when (> (level-of team-member) old-level)
- (format t "~a level-uped to ~d~%" (name-of team-member) (level-of team-member))
- (iter (for level from (1+ old-level) to (level-of team-member))
- (iter (for learned-move in (learned-moves-of team-member))
- (when (= (car learned-move) level)
- (unless (get-move (cdr learned-move) team-member)
- (pushnewmove (cdr learned-move) team-member)
- (format t "~a learned ~a~%" (name-of team-member) (name-of (get-move (cdr learned-move) team-member))))))))))
+ (incf (exp-of team-member) exp-gained)
+ (let ((old-level (level-of team-member)))
+ (iter (while (>= (exp-of team-member) (calculate-level-to-exp (+ (level-of team-member) 1))))
+ (incf (level-of team-member)))
+ (when (> (level-of team-member) old-level)
+ (format t "~a level-uped to ~d~%" (name-of team-member) (level-of team-member))
+ (iter (for level from (1+ old-level) to (level-of team-member))
+ (iter (for learned-move in (learned-moves-of team-member))
+ (when (= (car learned-move) level)
+ (unless (get-move (cdr learned-move) team-member)
+ (pushnewmove (cdr learned-move) team-member)
+ (format t "~a learned ~a~%" (name-of team-member) (name-of (get-move (cdr learned-move) team-member))))))))))
(cond ((and items-looted (> bitcoins-looted 0))
(format t "~a loots ~d bitcoins and ~d ~a from the enemies~%"
name
@@ -1544,8 +1544,8 @@
(defun wash (clothing)
(declare (type list clothing))
(iter (for i in (filter-items clothing 'closed-bottoms))
- (when (not (disposablep i))
- (setf (sogginess-of i) 0 (messiness-of i) 0))))
+ (when (not (disposablep i))
+ (setf (sogginess-of i) 0 (messiness-of i) 0))))
(defun go-to-sleep% (user)
(incf (time-of *game*) 60)
(let ((time-difference (- (time-of *game*) (last-process-potty-time-of user))))
@@ -1557,81 +1557,169 @@
(cons (wet :wetter user) (mess :messer user)))
(defun go-to-sleep ()
(iter (for i in (cons (player-of *game*) (allies-of *game*)))
- (let* ((return-value (go-to-sleep% i))
- (out ())
- (male (malep i))
- (hisher (if male "his" "her"))
- (name (name-of i))
- (cheshe (if male "He" "She")))
- (multiple-value-bind (value key)
- (pop-from-expansion i return-value)
- (when (eq key :wet/mess)
- (setf return-value value)))
- (format t "~a wakes up " (name-of i))
- (when (> (getf (car return-value) :wet-amount) 0)
- (cond ((filter-items (wear-of i) 'diaper)
- (if (> (getf (car return-value) :leak-amount) 0)
- (progn (push (format nil "feeling all cold and soggy. ~a checks ~a diaper and to ~a embarrassment finds out it's leaking profusely. Seems ~a wet the bed.~%"
- cheshe
- hisher
- hisher
- name)
- out)
- (format t "~a" (a:random-elt out))
- (setf out ()))
- (progn (push (format nil "and hears a squish . ~a looks down at ~a diaper, notices that it's soggy and then folds ~a ears back and blushes. Looks like ~a wet the bed~%"
- cheshe
- hisher
- hisher
- name)
- out)
- (push (format nil "and looks down and pokes ~a diaper, then gets all blushy when it squishes. Seems ~a wet the bed~%"
- hisher
- name)
- out)
- (format t "~a" (a:random-elt out))
- (setf out ()))))
+ (let* ((return-value (go-to-sleep% i))
+ (out ())
+ (male (malep i))
+ (hisher (if male "his" "her"))
+ (name (name-of i))
+ (cheshe (if male "He" "She")))
+ (multiple-value-bind (value key)
+ (pop-from-expansion i return-value)
+ (when (eq key :wet/mess)
+ (setf return-value value)))
+ (format t "~a wakes up " (name-of i))
+ (when (> (getf (car return-value) :wet-amount) 0)
+ (cond ((filter-items (wear-of i) 'diaper)
+ (if (> (getf (car return-value) :leak-amount) 0)
+ (progn (push (format nil "feeling all cold and soggy. ~a checks ~a diaper and to ~a embarrassment finds out it's leaking profusely. Seems ~a wet the bed.~%"
+ cheshe
+ hisher
+ hisher
+ name)
+ out)
+ (format t "~a" (a:random-elt out))
+ (setf out ()))
+ (progn (push (format nil "and hears a squish . ~a looks down at ~a diaper, notices that it's soggy and then folds ~a ears back and blushes. Looks like ~a wet the bed~%"
+ cheshe
+ hisher
+ hisher
+ name)
+ out)
+ (push (format nil "and looks down and pokes ~a diaper, then gets all blushy when it squishes. Seems ~a wet the bed~%"
+ hisher
+ name)
+ out)
+ (format t "~a" (a:random-elt out))
+ (setf out ()))))
+ ((filter-items (wear-of i) 'pullup)
+ (if (> (getf (car return-value) :leak-amount) 0)
+ (progn (push (format nil "feeling all cold and soggy. ~a checks ~a pullups and to ~a embarrassment finds out it's leaking profusely. Seems ~a wet the bed.~%"
+ cheshe
+ hisher
+ hisher
+ name)
+ out)
+ (format t "~a" (a:random-elt out))
+ (setf out ()))
+ (progn (push (format nil "and hears a squish. ~a looks down at ~a pullups, notices that ~a and then folds ~a ears back and blushes. Looks like ~a wet the bed~%"
+ cheshe
+ (if (filter-items (wear-of i) '(ab-clothing pullup))
+ "the little pictures have faded"
+ "it's soggy")
+ hisher
+ hisher
+ name)
+ out)
+ (format t "~a" (a:random-elt out))
+ (setf out ()))))
+ ((filter-items (wear-of i) 'stuffer)
+ (if (> (getf (car return-value) :leak-amount) 0)
+ (progn (push (format nil "feeling all cold and soggy. ~a notices ~a PJs, the padding under ~a PJs, and bed are soaked. Seems ~a wet the bed~%"
+ cheshe
+ hisher
+ hisher
+ name)
+ out)
+ (format t "~a" (a:random-elt out))
+ (setf out ()))
+ (progn (push (format nil "and hears a squish from under ~a PJs. ~a checks the incontinence pad under them and notices that they're soaked and then folds ~a ears back and blushes. Looks like ~a wet the bed~%"
+ hisher
+ cheshe
+ hisher
+ name)
+ out)
+ (format t "~a" (a:random-elt out))
+ (setf out ()))))
+ ((filter-items (wear-of i) 'closed-bottoms)
+ (push (format nil "feeling all cold and soggy. ~a notices ~a PJs and bed are soaked then folds ~a ears back and blushes. Seems ~a wet the bed~%"
+ cheshe
+ hisher
+ hisher
+ name)
+ out)
+ (format t "~a" (a:random-elt out))
+ (setf out ()))
+ (t
+ (push (format nil "feeling all cold and soggy. ~a notices the bed is soaked then folds ~a ears back and blushes. Seems ~a wet the bed~%"
+ cheshe
+ hisher
+ name)
+ out)
+ (format t "~a" (a:random-elt out))
+ (setf out ()))))
+ (when (and (> (getf (cdr return-value) :mess-amount) 0) (> (getf (car return-value) :wet-amount) 0))
+ (format t "~a is also " (name-of i)))
+ (when (> (getf (cdr return-value) :mess-amount) 0)
+ (cond
+ ((filter-items (wear-of i) 'diaper)
+ (if (> (getf (cdr return-value) :leak-amount) 0)
+ (progn
+ (push (format nil
+ "feeling all mushy. ~a notices to ~a embarrassment that ~a diaper is leaking poo all over the bed. Seems ~a messed the bed~%"
+ cheshe
+ hisher
+ hisher
+ name)
+ out)
+ (format t "~a" (a:random-elt out))
+ (setf out ()))
+ (progn
+ (push (format nil
+ "feeling all mushy. ~a notices to ~a embarrassment that ~a diaper is filled with poo. Seems ~a messed the bed~%"
+ cheshe
+ hisher
+ hisher
+ name)
+ out)
+ (format t "~a" (a:random-elt out))
+ (setf out ()))))
((filter-items (wear-of i) 'pullup)
- (if (> (getf (car return-value) :leak-amount) 0)
- (progn (push (format nil "feeling all cold and soggy. ~a checks ~a pullups and to ~a embarrassment finds out it's leaking profusely. Seems ~a wet the bed.~%"
- cheshe
- hisher
- hisher
- name)
- out)
- (format t "~a" (a:random-elt out))
- (setf out ()))
- (progn (push (format nil "and hears a squish. ~a looks down at ~a pullups, notices that ~a and then folds ~a ears back and blushes. Looks like ~a wet the bed~%"
- cheshe
- (if (filter-items (wear-of i) '(ab-clothing pullup))
- "the little pictures have faded"
- "it's soggy")
- hisher
- hisher
- name)
- out)
- (format t "~a" (a:random-elt out))
- (setf out ()))))
+ (if (> (getf (cdr return-value) :leak-amount) 0)
+ (progn
+ (push (format nil
+ "feeling all mushy. ~a notices to ~a embarrassment that ~a pullups is leaking poo all over the bed. Seems ~a messed the bed~%"
+ cheshe
+ hisher
+ hisher
+ name)
+ out)
+ (format t "~a" (a:random-elt out))
+ (setf out ()))
+ (progn
+ (push (format nil
+ "feeling all mushy. ~a notices to ~a embarrassment that ~a pullup is filled with poo. Seems ~a messed the bed~%"
+ cheshe
+ hisher
+ hisher
+ name)
+ out)
+ (format t "~a" (a:random-elt out))
+ (setf out ()))))
((filter-items (wear-of i) 'stuffer)
- (if (> (getf (car return-value) :leak-amount) 0)
- (progn (push (format nil "feeling all cold and soggy. ~a notices ~a PJs, the padding under ~a PJs, and bed are soaked. Seems ~a wet the bed~%"
- cheshe
- hisher
- hisher
- name)
- out)
- (format t "~a" (a:random-elt out))
- (setf out ()))
- (progn (push (format nil "and hears a squish from under ~a PJs. ~a checks the incontinence pad under them and notices that they're soaked and then folds ~a ears back and blushes. Looks like ~a wet the bed~%"
- hisher
- cheshe
- hisher
- name)
- out)
- (format t "~a" (a:random-elt out))
- (setf out ()))))
+ (if (> (getf (cdr return-value) :leak-amount) 0)
+ (progn
+ (push (format nil
+ "feeling all mushy. ~a notices to ~a embarrassment that ~a incontinence pad is leaking poo all over the bed and PJs. Seems ~a messed the bed~%"
+ cheshe
+ hisher
+ hisher
+ name)
+ out)
+ (format t "~a" (a:random-elt out))
+ (setf out ()))
+ (progn
+ (push (format nil
+ "feeling all mushy. ~a notices to ~a embarrassment that ~a incontinence pad is filled with poo. Seems ~a messed the bed~%"
+ cheshe
+ hisher
+ hisher
+ name)
+ out)
+ (format t "~a" (a:random-elt out))
+ (setf out ()))))
((filter-items (wear-of i) 'closed-bottoms)
- (push (format nil "feeling all cold and soggy. ~a notices ~a PJs and bed are soaked then folds ~a ears back and blushes. Seems ~a wet the bed~%"
+ (push (format nil
+ "feeling all mushy. ~a notices to ~a embarrassment that ~a PJs have poo in them and is getting on the bed. Seems ~a messed the bed~%"
cheshe
hisher
hisher
@@ -1640,123 +1728,35 @@
(format t "~a" (a:random-elt out))
(setf out ()))
(t
- (push (format nil "feeling all cold and soggy. ~a notices the bed is soaked then folds ~a ears back and blushes. Seems ~a wet the bed~%"
+ (push (format nil
+ "feeling all mushy. ~a notices to ~a embarrassment that ~a bed has poo on it. Seems ~a messed the bed~%"
cheshe
hisher
+ hisher
name)
out)
(format t "~a" (a:random-elt out))
- (setf out ()))))
- (when (and (> (getf (cdr return-value) :mess-amount) 0) (> (getf (car return-value) :wet-amount) 0))
- (format t "~a is also " (name-of i)))
- (when (> (getf (cdr return-value) :mess-amount) 0)
- (cond
- ((filter-items (wear-of i) 'diaper)
- (if (> (getf (cdr return-value) :leak-amount) 0)
- (progn
- (push (format nil
- "feeling all mushy. ~a notices to ~a embarrassment that ~a diaper is leaking poo all over the bed. Seems ~a messed the bed~%"
- cheshe
- hisher
- hisher
- name)
- out)
- (format t "~a" (a:random-elt out))
- (setf out ()))
- (progn
- (push (format nil
- "feeling all mushy. ~a notices to ~a embarrassment that ~a diaper is filled with poo. Seems ~a messed the bed~%"
- cheshe
- hisher
- hisher
- name)
- out)
- (format t "~a" (a:random-elt out))
- (setf out ()))))
- ((filter-items (wear-of i) 'pullup)
- (if (> (getf (cdr return-value) :leak-amount) 0)
- (progn
- (push (format nil
- "feeling all mushy. ~a notices to ~a embarrassment that ~a pullups is leaking poo all over the bed. Seems ~a messed the bed~%"
- cheshe
- hisher
- hisher
- name)
- out)
- (format t "~a" (a:random-elt out))
- (setf out ()))
- (progn
- (push (format nil
- "feeling all mushy. ~a notices to ~a embarrassment that ~a pullup is filled with poo. Seems ~a messed the bed~%"
- cheshe
- hisher
- hisher
- name)
- out)
- (format t "~a" (a:random-elt out))
- (setf out ()))))
- ((filter-items (wear-of i) 'stuffer)
- (if (> (getf (cdr return-value) :leak-amount) 0)
- (progn
- (push (format nil
- "feeling all mushy. ~a notices to ~a embarrassment that ~a incontinence pad is leaking poo all over the bed and PJs. Seems ~a messed the bed~%"
- cheshe
- hisher
- hisher
- name)
- out)
- (format t "~a" (a:random-elt out))
- (setf out ()))
- (progn
- (push (format nil
- "feeling all mushy. ~a notices to ~a embarrassment that ~a incontinence pad is filled with poo. Seems ~a messed the bed~%"
- cheshe
- hisher
- hisher
- name)
- out)
- (format t "~a" (a:random-elt out))
- (setf out ()))))
- ((filter-items (wear-of i) 'closed-bottoms)
- (push (format nil
- "feeling all mushy. ~a notices to ~a embarrassment that ~a PJs have poo in them and is getting on the bed. Seems ~a messed the bed~%"
- cheshe
- hisher
- hisher
- name)
- out)
- (format t "~a" (a:random-elt out))
- (setf out ()))
- (t
- (push (format nil
- "feeling all mushy. ~a notices to ~a embarrassment that ~a bed has poo on it. Seems ~a messed the bed~%"
- cheshe
- hisher
- hisher
- name)
- out)
- (format t "~a" (a:random-elt out))
- (setf out ()))))))
+ (setf out ()))))))
t)
(defunassert shopfun (items-for-sale &key items-to-buy items-to-sell user format-items)
- (user (or base-character null)
- items-to-buy (or list boolean)
- items-to-sell (or list boolean)
- items-for-sale list)
+ (user (or base-character null)
+ items-to-buy (or list boolean)
+ items-to-sell (or list boolean)
+ items-for-sale list)
(when items-to-buy
(if (eq items-to-buy t)
(let (item quantity)
(accept-with-effective-frame (clim:accepting-values (*query-io* :resynchronize-every-pass t)
- (fresh-line *query-io*)
- (setf item (clim:accept `(clim:member-alist ,(iter (for i in items-for-sale)
- (collect (list (name-of (apply 'make-instance (car i) (eval (cdr i))))
- i)))) :prompt "Item"
- :view (make-instance 'clim:radio-box-view
- :orientation :vertical)
- :stream *query-io*))
- (fresh-line *query-io*)
- (setf quantity (clim:accept 'string :prompt "Quantity"
- :view clim:+text-field-view+ :stream *query-io*))))
+ (fresh-line *query-io*)
+ (setf item (clim:accept `(clim:member-alist ,(iter (for i in items-for-sale)
+ (collect (list (name-of (apply 'make-instance (car i) (eval (cdr i))))
+ i)))) :prompt "Item"
+ :view (make-instance 'clim:radio-box-view
+ :orientation :vertical)
+ :stream *query-io*))
+ (fresh-line *query-io*)
+ (setf quantity (clim:accept 'string :prompt "Quantity"
+ :view clim:+text-field-view+ :stream *query-io*))))
(when (and quantity item (handler-case (if (typep (parse-integer quantity) '(integer 1 *))
t
(progn (format t "Quantity must be an '(integer 1 *)~%")
@@ -1785,83 +1785,83 @@
(or (plural-name-of temp) (format nil "~as" (name-of temp)))
(* (value-of temp) quantity)))))))
(iter (for i in items-to-buy)
- (let ((item (when (list-length-<= (car i) items-for-sale)
- (apply #'make-instance
- (car (nth (car i) items-for-sale))
- (eval (cdr (nth (car i) items-for-sale)))))))
- (cond ((not item)
- (format t "item ~d doesn't exist~%" (car i)))
- ((> (* (value-of item) (cdr i)) (bitcoins-of user))
- (format t "You don't have enough bitcoins to buy ~a~%"
- (if (= (cdr i) 1)
- (format nil "that ~a" (name-of item))
- (format nil "~d ~a"
- (cdr i)
- (if (plural-name-of item)
- (plural-name-of item)
- (format nil "~as" (name-of item)))))))
- (t (dotimes (j (cdr i))
- (push (apply #'make-instance
- (car (nth (car i) items-for-sale))
- (eval (cdr (nth (car i) items-for-sale))))
- (inventory-of user)))
- (decf (bitcoins-of user) (* (value-of item) (cdr i)))
- (format t "You buy ~d ~a for ~f bitcoins~%"
- (cdr i)
- (or (plural-name-of item) (format nil "~as" (name-of item)))
- (* (value-of item) (cdr i)))))))))
+ (let ((item (when (list-length-<= (car i) items-for-sale)
+ (apply #'make-instance
+ (car (nth (car i) items-for-sale))
+ (eval (cdr (nth (car i) items-for-sale)))))))
+ (cond ((not item)
+ (format t "item ~d doesn't exist~%" (car i)))
+ ((> (* (value-of item) (cdr i)) (bitcoins-of user))
+ (format t "You don't have enough bitcoins to buy ~a~%"
+ (if (= (cdr i) 1)
+ (format nil "that ~a" (name-of item))
+ (format nil "~d ~a"
+ (cdr i)
+ (if (plural-name-of item)
+ (plural-name-of item)
+ (format nil "~as" (name-of item)))))))
+ (t (dotimes (j (cdr i))
+ (push (apply #'make-instance
+ (car (nth (car i) items-for-sale))
+ (eval (cdr (nth (car i) items-for-sale))))
+ (inventory-of user)))
+ (decf (bitcoins-of user) (* (value-of item) (cdr i)))
+ (format t "You buy ~d ~a for ~f bitcoins~%"
+ (cdr i)
+ (or (plural-name-of item) (format nil "~as" (name-of item)))
+ (* (value-of item) (cdr i)))))))))
(when items-to-sell
(if (eq items-to-sell t)
(let (items)
(accept-with-effective-frame (clim:accepting-values (*query-io* :resynchronize-every-pass t)
- (setf items (clim:accept `(clim:subset-alist ,(iter (for item in (remove-duplicates (inventory-of user)))
- (collect (cons (name-of item)
- item)))) :prompt "Items"
- :view clim:+check-box-view+ :stream *query-io*))))
+ (setf items (clim:accept `(clim:subset-alist ,(iter (for item in (remove-duplicates (inventory-of user)))
+ (collect (cons (name-of item)
+ item)))) :prompt "Items"
+ :view clim:+check-box-view+ :stream *query-io*))))
(iter (for i in items)
- (format t "You sell your ~a for ~f bitcoins~%"
- (name-of i)
- (/ (value-of i) 2))
- (incf (bitcoins-of user) (/ (value-of i) 2)))
+ (format t "You sell your ~a for ~f bitcoins~%"
+ (name-of i)
+ (/ (value-of i) 2))
+ (incf (bitcoins-of user) (/ (value-of i) 2)))
(a:deletef (the list (inventory-of user)) items :test (lambda (o e)
(s:memq e o))))
(let ((items (sort (remove-duplicates items-to-sell) #'<)))
(setf items (iter (generate i in items)
- (for j in (inventory-of user))
- (for (the fixnum k) upfrom 0)
- (when (first-iteration-p)
- (next i))
- (when (= k i)
- (collect j)
- (next i))))
+ (for j in (inventory-of user))
+ (for (the fixnum k) upfrom 0)
+ (when (first-iteration-p)
+ (next i))
+ (when (= k i)
+ (collect j)
+ (next i))))
(unless items
(format t "Those items aren't valid")
(return-from shopfun))
(iter (for i in items)
- (when (not (sellablep i))
- (format t "That item isn't sellable~%~%")
- (return-from shopfun)))
+ (when (not (sellablep i))
+ (format t "That item isn't sellable~%~%")
+ (return-from shopfun)))
(iter (for i in items)
- (format t "You sell your ~a for ~f bitcoins~%"
- (name-of (nth i (inventory-of user)))
- (/ (value-of (nth i (inventory-of user))) 2))
- (incf (bitcoins-of user) (/ (value-of i) 2)))
+ (format t "You sell your ~a for ~f bitcoins~%"
+ (name-of (nth i (inventory-of user)))
+ (/ (value-of (nth i (inventory-of user))) 2))
+ (incf (bitcoins-of user) (/ (value-of i) 2)))
(a:deletef (the list (inventory-of user)) items
:test (lambda (o e)
(s:memq e o))))))
(when format-items
(format t "~10a~40a~10@a~%" "Index" "Item" "Price")
(iter (for i in items-for-sale)
- (for (the fixnum j) upfrom 0)
- (let ((item (apply #'make-instance (car i) (eval (cdr i)))))
- (format t "~10a~40a~10@a~%" j (name-of item) (value-of item))))))
+ (for (the fixnum j) upfrom 0)
+ (let ((item (apply #'make-instance (car i) (eval (cdr i)))))
+ (format t "~10a~40a~10@a~%" j (name-of item) (value-of item))))))
(defun getf-action-from-prop (position prop action)
(getf (actions-of (getf (get-props-from-zone position) prop)) action))
(defun (setf getf-action-from-prop) (new-value position prop action)
(setf (getf (actions-of (getf (get-props-from-zone position) prop)) action) new-value))
(defunassert wash-in-washer (washer)
- (washer (or yadfa-props:washer null))
+ (washer (or yadfa-props:washer null))
"washes your dirty diapers and all the clothes you've ruined. WASHER is an instance of a washer you want to put your clothes in."
(declare (ignorable washer))
(wash (inventory-of (player-of *game*)))
@@ -1881,23 +1881,23 @@
(flet ((check-if-done ()
(s:run-hooks '*cheat-hooks*)
(iter (for i in (append (enemies-of *battle*) (team-of *game*)))
- (if (<= (health-of i) 0)
- (progn (setf (health-of i) 0)
- (unless (s:memq i (fainted-of *battle*))
- (format t "~a has fainted~%~%" (name-of i))
- (pushnew i (fainted-of *battle*)))
- (a:deletef (turn-queue-of *battle*) i))
- (a:deletef (fainted-of *battle*) i :count 1))
- (when (> (health-of i) (calculate-stat i :health))
- (setf (health-of i) (calculate-stat i :health)))
- (when (> (energy-of i) (calculate-stat i :energy))
- (setf (energy-of i) (calculate-stat i :energy))))
+ (if (<= (health-of i) 0)
+ (progn (setf (health-of i) 0)
+ (unless (s:memq i (fainted-of *battle*))
+ (format t "~a has fainted~%~%" (name-of i))
+ (pushnew i (fainted-of *battle*)))
+ (a:deletef (turn-queue-of *battle*) i))
+ (a:deletef (fainted-of *battle*) i :count 1))
+ (when (> (health-of i) (calculate-stat i :health))
+ (setf (health-of i) (calculate-stat i :health)))
+ (when (> (energy-of i) (calculate-stat i :energy))
+ (setf (energy-of i) (calculate-stat i :energy))))
(unless (iter (for i in (team-of *game*)) (when (> (health-of i) 0) (leave t)))
(finish-battle t)
(return-from process-battle t))
(unless (iter (for i in (enemies-of *battle*))
- (when (> (health-of i) 0)
- (leave t)))
+ (when (> (health-of i) 0)
+ (leave t)))
(finish-battle)
(return-from process-battle t))))
(check-if-done)
@@ -1917,27 +1917,27 @@
(name-of (first (turn-queue-of *battle*))) (name-of (get-move attack (first (turn-queue-of *battle*)))))
(return-from process-battle))
(iter (until (and team-attacked (typep (first (turn-queue-of *battle*)) 'team-member)))
- (check-if-done)
- (let* ((current-character (pop (turn-queue-of *battle*)))
- (new-ret (process-battle-turn current-character attack item reload selected-target)))
- (iter (for i in (append (team-of *game*) (team-npcs-of *battle*) (enemies-of *battle*)))
- (pop-from-expansion i))
- (when (typep current-character '(not npc))
- (setf team-attacked t
- ret new-ret)))
- (check-if-done)
- (unless (turn-queue-of *battle*)
- (incf (time-of *game*))
- (setf (turn-queue-of *battle*)
- (s:dsu-sort (iter (for i in (append (enemies-of *battle*) (team-npcs-of *battle*) (team-of *game*)))
- (when (> (health-of i) 0)
- (collect i)))
- '>
- :key (lambda (a) (calculate-stat a :speed))))))
+ (check-if-done)
+ (let* ((current-character (pop (turn-queue-of *battle*)))
+ (new-ret (process-battle-turn current-character attack item reload selected-target)))
+ (iter (for i in (append (team-of *game*) (team-npcs-of *battle*) (enemies-of *battle*)))
+ (pop-from-expansion i))
+ (when (typep current-character '(not npc))
+ (setf team-attacked t
+ ret new-ret)))
+ (check-if-done)
+ (unless (turn-queue-of *battle*)
+ (incf (time-of *game*))
+ (setf (turn-queue-of *battle*)
+ (s:dsu-sort (iter (for i in (append (enemies-of *battle*) (team-npcs-of *battle*) (team-of *game*)))
+ (when (> (health-of i) 0)
+ (collect i)))
+ '>
+ :key (lambda (a) (calculate-stat a :speed))))))
(format t "~a is next in battle~%" (name-of (first (turn-queue-of *battle*))))
ret)))
(defunassert ally-join (ally)
- (ally ally)
+ (ally ally)
(format t "~a Joins the team~%" (name-of ally))
(when (> (bitcoins-of ally) 0)
(format t "~a gets ~f bitcoins from ~a~%" (name-of (player-of *game*)) (bitcoins-of ally) (name-of ally)))
@@ -1969,9 +1969,9 @@
(setf (energy-of target) (calculate-stat target :energy)))
ret)))
(defunassert set-player (name malep species)
- (malep boolean
- name simple-string
- species simple-string)
+ (malep boolean
+ name simple-string
+ species simple-string)
"Sets the name, gender, and species of the player"
(setf (name-of (player-of *game*)) name)
(setf (species-of (player-of *game*)) species)
@@ -1984,42 +1984,42 @@
"This function sets up the player and prints the back story. If you're trying to create your own game with a different storyline using a mod, you can replace this function. Be careful when enabling mods that change the story line this significantly as they can overwrite each other"
(write-line "Enter your character's name, gender, and species" *query-io*)
(clim:accepting-values (*query-io* :resynchronize-every-pass t :exit-boxes '((:exit "Accept")))
- (fresh-line *query-io*)
- (setf name (clim:accept 'string :prompt "Name" :default (name-of default) :view clim:+text-field-view+ :stream *query-io*))
- (fresh-line *query-io*)
- (setf male (clim:accept 'boolean :prompt "Is Male"
- :default (malep default) :view clim:+toggle-button-view+ :stream *query-io*))
- (fresh-line *query-io*)
- (setf species (clim:accept 'string :prompt "Species"
- :default (species-of default) :view clim:+text-field-view+ :stream *query-io*))
- (fresh-line *query-io*)
- (setf clothes (clim:accept `((clim:subset-completion ,wear) :name-key ,(lambda (o) (name-of (make-instance o))))
- :prompt "Clothes" :view clim:+check-box-view+ :default '(yadfa-items:tshirt yadfa-items:diaper)
- :stream *query-io*))
- (fresh-line *query-io*)
- (setf bladder (clim:accept '(clim:completion (:normal :low :overactive))
- :prompt "Bladder capacity" :default :normal :view clim:+option-pane-view+ :stream *query-io*))
- (fresh-line *query-io*)
- (setf bowels (clim:accept '(clim:completion (:normal :low :kid))
- :prompt "Bowels capacity" :default :normal :view clim:+option-pane-view+ :stream *query-io*))
- (fresh-line *query-io*)
- (setf fill-rate (clim:accept '(clim:completion (:normal :fast :faster))
- :prompt "Bladder/Bowels fill rate" :default :normal :view clim:+option-pane-view+ :stream *query-io*))
- (fresh-line *query-io*)
- (setf bio (clim:accept 'string :prompt "Description" :default (description-of default) :view '(clim:text-editor-view :ncolumns 80 :nlines 7)
- :stream *query-io*)))
+ (fresh-line *query-io*)
+ (setf name (clim:accept 'string :prompt "Name" :default (name-of default) :view clim:+text-field-view+ :stream *query-io*))
+ (fresh-line *query-io*)
+ (setf male (clim:accept 'boolean :prompt "Is Male"
+ :default (malep default) :view clim:+toggle-button-view+ :stream *query-io*))
+ (fresh-line *query-io*)
+ (setf species (clim:accept 'string :prompt "Species"
+ :default (species-of default) :view clim:+text-field-view+ :stream *query-io*))
+ (fresh-line *query-io*)
+ (setf clothes (clim:accept `((clim:subset-completion ,wear) :name-key ,(lambda (o) (name-of (make-instance o))))
+ :prompt "Clothes" :view clim:+check-box-view+ :default '(yadfa-items:tshirt yadfa-items:diaper)
+ :stream *query-io*))
+ (fresh-line *query-io*)
+ (setf bladder (clim:accept '(clim:completion (:normal :low :overactive))
+ :prompt "Bladder capacity" :default :normal :view clim:+option-pane-view+ :stream *query-io*))
+ (fresh-line *query-io*)
+ (setf bowels (clim:accept '(clim:completion (:normal :low :kid))
+ :prompt "Bowels capacity" :default :normal :view clim:+option-pane-view+ :stream *query-io*))
+ (fresh-line *query-io*)
+ (setf fill-rate (clim:accept '(clim:completion (:normal :fast :faster))
+ :prompt "Bladder/Bowels fill rate" :default :normal :view clim:+option-pane-view+ :stream *query-io*))
+ (fresh-line *query-io*)
+ (setf bio (clim:accept 'string :prompt "Description" :default (description-of default) :view '(clim:text-editor-view :ncolumns 80 :nlines 7)
+ :stream *query-io*)))
(clim:accepting-values (*query-io* :resynchronize-every-pass t :exit-boxes '((:exit "Accept")))
- (setf tail-type (clim:accept '(clim:completion (:small :medium :large :lizard :bird-small :bird-large nil))
- :prompt "Tail type" :default (car (tail-of default)) :view clim:+option-pane-view+ :stream *query-io*))
- (fresh-line *query-io*)
- (setf tail (clim:accept '((clim:subset-completion (:multi :scales :fur :feathers)))
- :prompt "Tail attributes" :default (cdr (tail-of default)) :view clim:+check-box-view+ :stream *query-io*))
- (fresh-line *query-io*)
- (setf wings (clim:accept '((clim:subset-completion (:scales :fur :feathers)))
- :prompt "Wings attributes" :default (wings-of default) :view clim:+check-box-view+ :stream *query-io*))
- (fresh-line *query-io*)
- (setf skin (clim:accept '((clim:subset-completion (:scales :fur :feathers)))
- :prompt "Skin attributes" :default (skin-of default) :view clim:+check-box-view+ :stream *query-io*)))
+ (setf tail-type (clim:accept '(clim:completion (:small :medium :large :lizard :bird-small :bird-large nil))
+ :prompt "Tail type" :default (car (tail-of default)) :view clim:+option-pane-view+ :stream *query-io*))
+ (fresh-line *query-io*)
+ (setf tail (clim:accept '((clim:subset-completion (:multi :scales :fur :feathers)))
+ :prompt "Tail attributes" :default (cdr (tail-of default)) :view clim:+check-box-view+ :stream *query-io*))
+ (fresh-line *query-io*)
+ (setf wings (clim:accept '((clim:subset-completion (:scales :fur :feathers)))
+ :prompt "Wings attributes" :default (wings-of default) :view clim:+check-box-view+ :stream *query-io*))
+ (fresh-line *query-io*)
+ (setf skin (clim:accept '((clim:subset-completion (:scales :fur :feathers)))
+ :prompt "Skin attributes" :default (skin-of default) :view clim:+check-box-view+ :stream *query-io*)))
(setf (player-of *game*) (make-instance 'player
:position '(0 0 0 yadfa-zones:home)
:name name
@@ -2047,13 +2047,13 @@
:faster 20/9)
fill-rate)
:wear (iter (for i in wear)
- (when (s:memq i clothes)
- (collect (make-instance i))))))
+ (when (s:memq i clothes)
+ (collect (make-instance i))))))
(setf (team-of *game*) (list (player-of *game*)))
(iter (for i in (iter (for i in '(yadfa-items:diaper yadfa-items:pullups yadfa-items:boxers yadfa-items:panties))
- (when (s:memq i clothes)
- (collect i))))
- (dotimes (j (random 20))
- (push (make-instance i)
- (get-items-from-prop :dresser (position-of (player-of *game*))))))
+ (when (s:memq i clothes)
+ (collect i))))
+ (dotimes (j (random 20))
+ (push (make-instance i)
+ (get-items-from-prop :dresser (position-of (player-of *game*))))))
(write-line "You wake up from sleeping, the good news is that you managed to stay dry throughout the night. Bad news is your bladder filled up during the night. You would get up and head to the toilet, but the bed is too comfy, so you just lay there holding it until the discomfort of your bladder exceeds the comfort of your bed. Then eventually get up while holding yourself and hopping from foot to foot hoping you can make it to a bathroom in time" *query-io*))
diff --git a/core/libexec/generic-functions.lisp b/core/libexec/generic-functions.lisp
index f12e287..e8eb81c 100644
--- a/core/libexec/generic-functions.lisp
+++ b/core/libexec/generic-functions.lisp
@@ -157,11 +157,11 @@
(:method ((self npc) (target base-character))
(let ((moves-with-health
(iter (for i in (moves-of self))
- (when (and (>= (energy-of self) (energy-cost-of i)) (position :ai-health-inc (ai-flags-of i)))
- (collect i))))
+ (when (and (>= (energy-of self) (energy-cost-of i)) (position :ai-health-inc (ai-flags-of i)))
+ (collect i))))
(moves-can-use (iter (for i in (moves-of self))
- (when (>= (energy-of self) (energy-cost-of i))
- (collect i))))
+ (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)
diff --git a/core/libexec/macros.lisp b/core/libexec/macros.lisp
index fc441d5..aa8abc7 100644
--- a/core/libexec/macros.lisp
+++ b/core/libexec/macros.lisp
@@ -4,32 +4,32 @@
"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 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)))))))
+ (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
@@ -45,18 +45,18 @@
`(progn (s:eval-always (defclass ,name (,@superclasses element-type) ,slot-specifiers
(:metaclass element-type-class)
,@(iter (for class-option in class-options)
- (unless (s:memq (car class-option) '(:super-effective :not-very-effective :no-effect :element-name))
- (collect class-option)))))
+ (unless (s:memq (car class-option) '(:super-effective :not-very-effective :no-effect :element-name))
+ (collect class-option)))))
,@(iter (for class-option in class-options)
- (let ((option-name (car class-option)))
- (when (s:memq option-name '(:super-effective :not-very-effective :no-effect))
- (appending (iter (for target in (cdr class-option))
- (collect `(s:eval-always (unless (find-class ',target nil)
- (defclass ,target (element-type) () (:metaclass element-type-class)))))
- (collect `(defmatch ,name ,target ,option-name)))))
- (collect `(setf (slot-value (find-class ',name) 'name) ,(if (eq option-name :element-name)
- (second class-option)
- nil)))))
+ (let ((option-name (car class-option)))
+ (when (s:memq option-name '(:super-effective :not-very-effective :no-effect))
+ (appending (iter (for target in (cdr class-option))
+ (collect `(s:eval-always (unless (find-class ',target nil)
+ (defclass ,target (element-type) () (:metaclass element-type-class)))))
+ (collect `(defmatch ,name ,target ,option-name)))))
+ (collect `(setf (slot-value (find-class ',name) 'name) ,(if (eq option-name :element-name)
+ (second class-option)
+ nil)))))
(find-class ',name)))
(defmacro accept-with-effective-frame (&body body)
`(cond
@@ -81,7 +81,7 @@
`(cond
(c:*application-frame*
(push (clim:updating-output (*query-io*)
- ,@body)
+ ,@body)
yadfa-clim::*records*))
(t (clim:run-frame-top-level (clim:make-application-frame 'yadfa-clim::emacs-frame
:width 1024 :height 768
@@ -92,21 +92,21 @@
(defmacro updating-present-with-effective-frame
((stream
&key (unique-id nil unique-id-supplied-p) (id-test nil id-test-supplied-p)
- (cache-value nil cache-value-supplied-p)
- (cache-test nil cache-test-supplied-p)
- (fixed-position nil fixed-position-supplied-p)
- (all-new nil all-new-supplied-p)
- (parent-cache nil parent-cache-supplied-p)
- (record-type nil record-type-supplied-p)
+ (cache-value nil cache-value-supplied-p)
+ (cache-test nil cache-test-supplied-p)
+ (fixed-position nil fixed-position-supplied-p)
+ (all-new nil all-new-supplied-p)
+ (parent-cache nil parent-cache-supplied-p)
+ (record-type nil record-type-supplied-p)
&allow-other-keys) &body body)
`(cond
(c:*application-frame*
(push (clim:updating-output (,stream ,@(and unique-id-supplied-p `(:unique-id ,unique-id)) ,@(and id-test-supplied-p `(:id-test ,id-test))
- ,@(and cache-value-supplied-p `(:cache-value ,cache-value)) ,@(and cache-test-supplied-p `(:cache-test ,cache-test))
- ,@(and fixed-position-supplied-p `(:fixed-position ,fixed-position)) ,@(and all-new-supplied-p `(:all-new ,all-new))
- ,@(and parent-cache-supplied-p `(:parent-cache ,parent-cache))
- ,@(and record-type-supplied-p (and `(:record-type ,record-type))))
- ,@body)
+ ,@(and cache-value-supplied-p `(:cache-value ,cache-value)) ,@(and cache-test-supplied-p `(:cache-test ,cache-test))
+ ,@(and fixed-position-supplied-p `(:fixed-position ,fixed-position)) ,@(and all-new-supplied-p `(:all-new ,all-new))
+ ,@(and parent-cache-supplied-p `(:parent-cache ,parent-cache))
+ ,@(and record-type-supplied-p (and `(:record-type ,record-type))))
+ ,@body)
yadfa-clim::*records*))
(t (clim:run-frame-top-level (clim:make-application-frame 'yadfa-clim::emacs-frame
:width 1024 :height 768
@@ -126,10 +126,10 @@
`(progn
(defclass ,(a:format-symbol (symbol-package base-class) "~a" (symbol-name base-class))
,(if (iter (for i in direct-superclasses)
- (when (subtypep i 'yadfa:onesie)
- (leave t)))
- direct-superclasses
- `(yadfa:onesie ,@direct-superclasses))
+ (when (subtypep i 'yadfa:onesie)
+ (leave t)))
+ direct-superclasses
+ `(yadfa:onesie ,@direct-superclasses))
,@body)
(defclass ,(a:format-symbol (symbol-package base-class) "~a/OPENED" (symbol-name base-class))
(,(a:format-symbol (symbol-package base-class) "~a" (symbol-name base-class))
diff --git a/core/libexec/methods.lisp b/core/libexec/methods.lisp
index e54697c..43a2bb4 100644
--- a/core/libexec/methods.lisp
+++ b/core/libexec/methods.lisp
@@ -6,54 +6,54 @@
(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))
+ (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))))
+ (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)))
+ (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)))
+ (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)))
+ (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)))
+ (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))))))
+ (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))
@@ -68,8 +68,8 @@
(toggle-onesie% onesie)))
(defmethod get-babyish-padding ((user team-member))
#.`(cond ,@(iter (for i in '(diaper pullup closed-bottoms))
- (collect `((filter-items (wear-of user) ',i)
- ',i)))
+ (collect `((filter-items (wear-of user) ',i)
+ ',i)))
(t nil)))
(defmethod output-process-potty-text (user padding type action had-accident &key (stream *standard-output*))
(declare (ignore user padding type action had-accident stream)))
@@ -93,28 +93,28 @@
&key (stream *standard-output*))
(format stream "~a~%"
(let ((j (a:switch ((getf (car had-accident) :accident) :test 'eq)
- (:dribble `("You gasp in horror as a little leaks out"
- "You think you just leaked a little"
- ,(format nil "A little squirts out. You quickly grab yourself with a ~a, but manage to stop the flood"
- (a:random-elt '("groan" "whine")))))
- (:some '("You gasp in horror as you flood yourself, but manage to stop yourself"))
- (:all (let ((a `(,(format nil
- "LOOK EVERYBODY!!!! ~a IS WETTING ~a DIAPERS!!!!~%~%*~a eeps and hides ~a soggy padding in embarrassment*"
- (string-upcase (name-of user))
- (if (malep user) "HIS" "HER")
- (name-of user)
- (if (malep user) "his" "her"))
- "After doing a potty dance like a 5 year old, you freeze and pee yourself"
- "Grabbing your crotch you pause and blush as you flood yourself like an infant"
- "You cross your legs in a vain attempt to hold it in but fail miserably"
- "You gasp in embarrassment as you flood yourself like a toddler"
- "You let out a groan as your bladder empties itself"
- "You fall to your knees clutching the front of your diapers struggling to keep your diapers dry and flood yourself")))
- (unless (malep user)
- (push "You press your legs together while fidgeting and squirming until your flood your pamps like the baby girl you are" a))
- (when (s:memq (car (tail-of user)) '(:medium :large :lizard))
- "You clutch the front of your diaper with your legs crossed and your tail between your legs in vain as you flood your pamps")
- a)))))
+ (:dribble `("You gasp in horror as a little leaks out"
+ "You think you just leaked a little"
+ ,(format nil "A little squirts out. You quickly grab yourself with a ~a, but manage to stop the flood"
+ (a:random-elt '("groan" "whine")))))
+ (:some '("You gasp in horror as you flood yourself, but manage to stop yourself"))
+ (:all (let ((a `(,(format nil
+ "LOOK EVERYBODY!!!! ~a IS WETTING ~a DIAPERS!!!!~%~%*~a eeps and hides ~a soggy padding in embarrassment*"
+ (string-upcase (name-of user))
+ (if (malep user) "HIS" "HER")
+ (name-of user)
+ (if (malep user) "his" "her"))
+ "After doing a potty dance like a 5 year old, you freeze and pee yourself"
+ "Grabbing your crotch you pause and blush as you flood yourself like an infant"
+ "You cross your legs in a vain attempt to hold it in but fail miserably"
+ "You gasp in embarrassment as you flood yourself like a toddler"
+ "You let out a groan as your bladder empties itself"
+ "You fall to your knees clutching the front of your diapers struggling to keep your diapers dry and flood yourself")))
+ (unless (malep user)
+ (push "You press your legs together while fidgeting and squirming until your flood your pamps like the baby girl you are" a))
+ (when (s:memq (car (tail-of user)) '(:medium :large :lizard))
+ "You clutch the front of your diaper with your legs crossed and your tail between your legs in vain as you flood your pamps")
+ a)))))
(when (>= (getf (car had-accident) :wet-amount) 300)
(push (format nil "Aww, the baby is using ~a diapers?" (if (malep user) "his" "her")) j))
(a:random-elt j)))
@@ -131,25 +131,25 @@
&key (stream *standard-output*))
(format stream "~a~%"
(a:random-elt (a:switch ((getf (car had-accident) :accident) :test 'eq)
- (:dribble `(,(format nil "A little squirts out. You quickly grab yourself with a ~a, but manage to stop the flood"
- (a:random-elt '("groan" "whine")))
- "You gasp in horror as a little leaks out"
- "You think you just leaked a little"))
- (:some '("You gasp in horror as you flood yourself, but manage to stop yourself"))
- (:all `(,(format nil "Naughty ~a wetting your pullups. You know you're supposed to use the toilet like a big kid."
- (if (malep user) "boy" "girl"))
- ,(format nil "LOOK EVERYBODY!!!! ~A IS WETTING ~a PULLUPS!!!!!!~%~%*~a eeps and hides ~a soggy pullups in embarrassment*"
- (string-upcase (name-of user))
- (if (malep user) "HIS" "HER")
- (name-of user)
- (if (malep user) "his" "her"))
- "After doing a potty dance like a 5 year old, you freeze and pee yourself"
- "Grabbing your crotch you pause and blush as you flood yourself like an infant"
- "You cross your legs in a vain attempt to hold it in but fail miserably"
- "You gasp in embarrassment as you flood yourself like a toddler"
- "You let out a groan as your bladder empties itself"
- "You fall to your knees clutching the front of your pullups struggling to keep them dry and flood yourself"
- "The little pictures on the front of your pullups fade showing everyone what you did")))))
+ (:dribble `(,(format nil "A little squirts out. You quickly grab yourself with a ~a, but manage to stop the flood"
+ (a:random-elt '("groan" "whine")))
+ "You gasp in horror as a little leaks out"
+ "You think you just leaked a little"))
+ (:some '("You gasp in horror as you flood yourself, but manage to stop yourself"))
+ (:all `(,(format nil "Naughty ~a wetting your pullups. You know you're supposed to use the toilet like a big kid."
+ (if (malep user) "boy" "girl"))
+ ,(format nil "LOOK EVERYBODY!!!! ~A IS WETTING ~a PULLUPS!!!!!!~%~%*~a eeps and hides ~a soggy pullups in embarrassment*"
+ (string-upcase (name-of user))
+ (if (malep user) "HIS" "HER")
+ (name-of user)
+ (if (malep user) "his" "her"))
+ "After doing a potty dance like a 5 year old, you freeze and pee yourself"
+ "Grabbing your crotch you pause and blush as you flood yourself like an infant"
+ "You cross your legs in a vain attempt to hold it in but fail miserably"
+ "You gasp in embarrassment as you flood yourself like a toddler"
+ "You let out a groan as your bladder empties itself"
+ "You fall to your knees clutching the front of your pullups struggling to keep them dry and flood yourself"
+ "The little pictures on the front of your pullups fade showing everyone what you did")))))
(format stream "~a~%"
(let ((out '("Your face turns red as you leak everywhere"
"Your pullups leak. There goes the carpet."
@@ -162,18 +162,18 @@
&key (stream *standard-output*))
(format stream "~a~%"
(a:random-elt (a:switch ((getf (car had-accident) :accident) :test 'eq)
- (:dribble `(,(format nil
- "A little squirts out. You quickly grab yourself with a ~a, but manage to stop the flood"
- (a:random-elt '("groan" "whine")))
- "You gasp in horror as a little leaks out"
- "You think you just leaked a little"))
- (:some '("You gasp in horror as you flood yourself, but manage to stop yourself"))
- (:all '("After doing a potty dance like a 5 year old, you freeze and pee yourself"
- "Grabbing your crotch you pause and blush as you flood yourself like an infant"
- "You cross your legs in a vain attempt to hold it in but fail miserably"
- "You gasp in embarrassment as you flood yourself like a toddler"
- "You let out a groan as your bladder empties itself"
- "You fall to your knees holding your crotch struggling to keep your pants dry and flood yourself")))))
+ (:dribble `(,(format nil
+ "A little squirts out. You quickly grab yourself with a ~a, but manage to stop the flood"
+ (a:random-elt '("groan" "whine")))
+ "You gasp in horror as a little leaks out"
+ "You think you just leaked a little"))
+ (:some '("You gasp in horror as you flood yourself, but manage to stop yourself"))
+ (:all '("After doing a potty dance like a 5 year old, you freeze and pee yourself"
+ "Grabbing your crotch you pause and blush as you flood yourself like an infant"
+ "You cross your legs in a vain attempt to hold it in but fail miserably"
+ "You gasp in embarrassment as you flood yourself like a toddler"
+ "You let out a groan as your bladder empties itself"
+ "You fall to your knees holding your crotch struggling to keep your pants dry and flood yourself")))))
(when (and (car had-accident) (> (getf (car had-accident) :leak-amount) 0))
(format stream "~a~%"
(a:random-elt `(,(format nil "Bad ~a! No going potty in the house!" (if (= (random 2) 0) (species-of user) (name-of user)))
@@ -190,16 +190,16 @@
(format stream "~a~%"
(let
((j (a:switch ((getf (car had-accident) :accident) :test 'eq)
- (:dribble `(,(format nil "A little squirts out. You quickly grab yourself with a ~a, but manage to stop the flood"
- (a:random-elt '("groan" "whine")))
- "You gasp in horror as a little leaks out"
- "You think you just leaked a little"))
- (:some '("You gasp in horror as you flood yourself, but manage to stop yourself"))
- (:all '("After doing a potty dance like a 5 year old, you freeze and pee yourself"
- "Grabbing your crotch you pause and blush as you flood yourself like an infant"
- "You cross your legs in a vain attempt to hold it in but fail miserably"
- "You gasp in embarrassment as you flood yourself like a toddler"
- "You let out a groan as your bladder empties itself")))))
+ (:dribble `(,(format nil "A little squirts out. You quickly grab yourself with a ~a, but manage to stop the flood"
+ (a:random-elt '("groan" "whine")))
+ "You gasp in horror as a little leaks out"
+ "You think you just leaked a little"))
+ (:some '("You gasp in horror as you flood yourself, but manage to stop yourself"))
+ (:all '("After doing a potty dance like a 5 year old, you freeze and pee yourself"
+ "Grabbing your crotch you pause and blush as you flood yourself like an infant"
+ "You cross your legs in a vain attempt to hold it in but fail miserably"
+ "You gasp in embarrassment as you flood yourself like a toddler"
+ "You let out a groan as your bladder empties itself")))))
(a:random-elt j)))
(when (and (car had-accident) (> (getf (car had-accident) :leak-amount) 0))
(format stream "~a~%"
@@ -1615,54 +1615,54 @@ randomrange is @code{(random-from-range 85 100)}"
(user-element-types (element-types-of user)))
(s:mvlet ((super-effective not-very-effective no-effect (funcall (lambda ()
(iter (with (the fixnum super-effective) = 0)
- (with (the fixnum not-very-effective) = 0)
- (with (the fixnum no-effect) = 0)
- (for attack-element-type in attack-element-types)
- (iter (for target-element-type in target-element-types)
- (case (type-match attack-element-type target-element-type)
- (:super-effective (incf super-effective))
- (:not-very-effective (incf not-very-effective))
- (:no-effect (incf no-effect))))
- (finally (return (values super-effective not-very-effective no-effect))))))))
- (round (u:$ (u:$ (u:$ (u:$ (u:$ (u:$ (u:$ 2 * (level-of user)) / 5) + 2) * (power-of attack) * (u:$ (calculate-stat user :attack) / (calculate-stat target :defense)))
- / 50)
- + 2)
- * (* (u:$ (random-from-range 85 100) / 100)
- (if (> no-effect 0)
- 0
- (expt 2 (- super-effective not-very-effective)))
- (if (intersection user-element-types attack-element-types
- :key (lambda (o)
- (class-of (coerce-element-type o)))
- :test 'subtypep)
- 1.5
- 1)))))))
+ (with (the fixnum not-very-effective) = 0)
+ (with (the fixnum no-effect) = 0)
+ (for attack-element-type in attack-element-types)
+ (iter (for target-element-type in target-element-types)
+ (case (type-match attack-element-type target-element-type)
+ (:super-effective (incf super-effective))
+ (:not-very-effective (incf not-very-effective))
+ (:no-effect (incf no-effect))))
+ (finally (return (values super-effective not-very-effective no-effect))))))))
+ (round (u:$ (u:$ (u:$ (u:$ (u:$ (u:$ (u:$ 2 * (level-of user)) / 5) + 2) * (power-of attack) * (u:$ (calculate-stat user :attack) / (calculate-stat target :defense)))
+ / 50)
+ + 2)
+ * (* (u:$ (random-from-range 85 100) / 100)
+ (if (> no-effect 0)
+ 0
+ (expt 2 (- super-effective not-very-effective)))
+ (if (intersection user-element-types attack-element-types
+ :key (lambda (o)
+ (class-of (coerce-element-type o)))
+ :test 'subtypep)
+ 1.5
+ 1)))))))
(defmethod describe-diaper-wear-usage (item))
(defmethod describe-diaper-inventory-usage (item))
(defmethod describe-diaper-usage (item))
(defmethod describe-diaper-inventory-usage ((item closed-bottoms))
(iter (for (a b) on (wet-text-of item) by #'cddr)
- (when (>= (sogginess-of item) a)
- (f:fmt* t #\Space b #\Newline)
- (finish)))
+ (when (>= (sogginess-of item) a)
+ (f:fmt* t #\Space b #\Newline)
+ (finish)))
(iter (for (a b) on (mess-text-of item) by #'cddr)
- (when (>= (messiness-of item) a)
- (f:fmt* t #\Space b #\Newline)
- (finish))))
+ (when (>= (messiness-of item) a)
+ (f:fmt* t #\Space b #\Newline)
+ (finish))))
(defmethod describe-diaper-wear-usage ((item closed-bottoms))
(iter (for (a b) on (wear-wet-text-of item) by #'cddr)
- (when (>= (sogginess-of item) a)
- (f:fmt* t #\Space b #\Newline)
- (finish)))
+ (when (>= (sogginess-of item) a)
+ (f:fmt* t #\Space b #\Newline)
+ (finish)))
(iter (for (a b) on (wear-mess-text-of item) by #'cddr)
- (when (>= (messiness-of item) a)
- (f:fmt* t #\Space b #\Newline)
- (finish)))
+ (when (>= (messiness-of item) a)
+ (f:fmt* t #\Space b #\Newline)
+ (finish)))
(iter (for (a b) on (bulge-text-of item) by #'cddr)
- (when (>= (total-thickness item) a)
- (f:fmt* t #\Space b #\Newline)
- (finish))))
+ (when (>= (total-thickness item) a)
+ (f:fmt* t #\Space b #\Newline)
+ (finish))))
(defmethod describe-diaper-usage ((item closed-bottoms))
(f:fmt t
"Sogginess: " (sogginess-of item) #\Newline
@@ -1671,13 +1671,13 @@ randomrange is @code{(random-from-range 85 100)}"
"Messiness Capacity: " (messiness-capacity-of item) #\Newline))
(defmethod process-battle-turn ((character npc) attack item reload selected-target)
(iter (for i in (getf (status-conditions-of *battle*) character))
- (when (or (eq (duration-of i) t) (> (duration-of i) 0))
- (condition-script character i)
- (when (typep (duration-of i) 'real)
- (decf (duration-of i))))
- (removef-if (getf (status-conditions-of *battle*) character)
- (lambda (a) (and (not (eq a t)) (<= a 0)))
- :key #'duration-of))
+ (when (or (eq (duration-of i) t) (> (duration-of i) 0))
+ (condition-script character i)
+ (when (typep (duration-of i) 'real)
+ (decf (duration-of i))))
+ (removef-if (getf (status-conditions-of *battle*) character)
+ (lambda (a) (and (not (eq a t)) (<= a 0)))
+ :key #'duration-of))
(run-equip-effects character)
(when (<= (health-of character) 0)
(unless (s:memq character (fainted-of *battle*))
@@ -1697,8 +1697,8 @@ randomrange is @code{(random-from-range 85 100)}"
(cond ((process-battle-accident character attack item reload selected-target)
nil)
((iter (for j in (getf (status-conditions-of *battle*) character))
- (when (blocks-turn-of j)
- (leave t))))
+ (when (blocks-turn-of j)
+ (leave t))))
((process-potty-dance character attack item reload selected-target) t)
((and (wield-of character)
(ammo-type-of (wield-of character))
@@ -1706,8 +1706,8 @@ randomrange is @code{(random-from-range 85 100)}"
(> (ammo-capacity-of (wield-of character)) 0)
(ammo-type-of (wield-of character))
(iter (for i in (inventory-of character))
- (when (typep i (ammo-type-of (wield-of character)))
- (leave t))))
+ (when (typep i (ammo-type-of (wield-of character)))
+ (leave t))))
(format t "~a reloaded ~a ~a"
(name-of character)
(if (malep character)
@@ -1715,27 +1715,27 @@ randomrange is @code{(random-from-range 85 100)}"
"her")
(name-of (wield-of character)))
(iter (with count = 0)
- (for item in (inventory-of character))
- (when (or (list-length-<= (ammo-capacity-of (wield-of character)) (ammo-of (wield-of character)))
- (and (reload-count-of (wield-of character)) (>= count (reload-count-of (wield-of character)))))
- (leave t))
- (when (typep item (ammo-type-of (wield-of character)))
- (incf count)
- (push item (ammo-of (wield-of character)))
- (a:deletef item (inventory-of character) :count 1))))
+ (for item in (inventory-of character))
+ (when (or (list-length-<= (ammo-capacity-of (wield-of character)) (ammo-of (wield-of character)))
+ (and (reload-count-of (wield-of character)) (>= count (reload-count-of (wield-of character)))))
+ (leave t))
+ (when (typep item (ammo-type-of (wield-of character)))
+ (incf count)
+ (push item (ammo-of (wield-of character)))
+ (a:deletef item (inventory-of character) :count 1))))
(t
(battle-script character (a:random-elt (if (typep character 'enemy)
(team-of *game*)
(enemies-of *battle*)))))))
(defmethod process-battle-turn ((character base-character) attack item reload selected-target)
(iter (for status-condition in (getf (status-conditions-of *battle*) character))
- (when (or (eq (duration-of status-condition) t) (> (duration-of status-condition) 0))
- (condition-script character status-condition)
- (when (typep (duration-of status-condition) 'real)
- (decf (duration-of status-condition))))
- (removef-if (getf (status-conditions-of *battle*) character)
- (lambda (a) (and (not (eq a t)) (<= a 0)))
- :key #'duration-of))
+ (when (or (eq (duration-of status-condition) t) (> (duration-of status-condition) 0))
+ (condition-script character status-condition)
+ (when (typep (duration-of status-condition) 'real)
+ (decf (duration-of status-condition))))
+ (removef-if (getf (status-conditions-of *battle*) character)
+ (lambda (a) (and (not (eq a t)) (<= a 0)))
+ :key #'duration-of))
(run-equip-effects character)
(when (<= (health-of character) 0)
(setf (health-of character) 0)
@@ -1755,8 +1755,8 @@ randomrange is @code{(random-from-range 85 100)}"
(cond ((process-battle-accident character attack item reload selected-target)
nil)
((iter (for j in (getf (status-conditions-of *battle*) character))
- (when (blocks-turn-of j)
- (leave t))))
+ (when (blocks-turn-of j)
+ (leave t))))
((process-potty-dance character attack item reload selected-target) t)
(item
(format t "~a used ~a ~a on ~a~%"
@@ -1772,20 +1772,20 @@ randomrange is @code{(random-from-range 85 100)}"
"her")
(name-of (wield-of character)))
(iter (with count = 0)
- (for item in (inventory-of (player-of *game*)))
- (when (or
- (list-length-<= (ammo-capacity-of (wield-of character))
- (ammo-of (wield-of character)))
- (and
- (reload-count-of (wield-of character))
- (>=
- count
- (reload-count-of (wield-of character)))))
- (leave t))
- (when (and (typep item reload) (typep item (ammo-type-of (wield-of character))))
- (incf count)
- (push item (ammo-of (wield-of character)))
- (a:deletef item (inventory-of (player-of *game*)) :count 1))))
+ (for item in (inventory-of (player-of *game*)))
+ (when (or
+ (list-length-<= (ammo-capacity-of (wield-of character))
+ (ammo-of (wield-of character)))
+ (and
+ (reload-count-of (wield-of character))
+ (>=
+ count
+ (reload-count-of (wield-of character)))))
+ (leave t))
+ (when (and (typep item reload) (typep item (ammo-type-of (wield-of character))))
+ (incf count)
+ (push item (ammo-of (wield-of character)))
+ (a:deletef item (inventory-of (player-of *game*)) :count 1))))
((eq attack t)
(if (wield-of character)
(progn (attack selected-target character (wield-of character))
diff --git a/core/mcclim.lisp b/core/mcclim.lisp
index 16dd2c9..7d2010d 100644
--- a/core/mcclim.lisp
+++ b/core/mcclim.lisp
@@ -50,9 +50,9 @@
(:menu-bar t)
(:layouts (default
(c:vertically ()
- clim-listener::interactor-container
- clim-listener::doc
- clim-listener::wholine))))
+ clim-listener::interactor-container
+ clim-listener::doc
+ clim-listener::wholine))))
(c:define-command (yadfa-set-eol-action :command-table yadfa-menu-commands :menu "Set EOL Action")
((keyword '(member :scroll :allow :wrap :wrap*)
:prompt "Keyword"))
@@ -63,11 +63,11 @@
(cc:define-conditional-command (com-enable-world)
(yadfa-listener :enable-commands (yadfa-world-commands yadfa-bin-commands)
:disable-commands (yadfa-battle-commands))
- ())
+ ())
(cc:define-conditional-command (com-enable-battle)
(yadfa-listener :enable-commands (yadfa-battle-commands yadfa-bin-commands)
:disable-commands (yadfa-world-commands))
- ())
+ ())
(c:define-command
(com-inspect :command-table c:global-command-table :name "Inspect")
((obj 'c:expression
@@ -78,11 +78,11 @@
`(multiple-value-bind (x y) (c:stream-cursor-position ,medium)
(c:draw-rectangle* ,medium x y (+ x (* ,stat 400)) (+ y 15)
:ink (cond ,@(iter (for i in colors)
- (collect `(,(car i) ,(intern (format nil "+~a+"
- (if (typep (car (last i)) 'cons)
- (caar (last i))
- (car (last i))))
- "CLIM"))))))
+ (collect `(,(car i) ,(intern (format nil "+~a+"
+ (if (typep (car (last i)) 'cons)
+ (caar (last i))
+ (car (last i))))
+ "CLIM"))))))
(c:draw-rectangle* ,medium x y (+ x 400) (+ y 15)
:filled nil)
(c:stream-set-cursor-position ,medium (+ x 400) y)))
@@ -119,14 +119,14 @@
(when *battle*
(write-string "Conditions: " stream)
(iter (for i in (getf (status-conditions-of *battle*) object))
- (format stream "“~a” " (name-of i)))
+ (format stream "“~a” " (name-of i)))
(write-char #\Newline stream))
(format stream "Stats: ~a~%Base-Stats: ~a~%"
(let ((wield-stats (calculate-wield-stats object))
(wear-stats (calculate-wear-stats object)))
(iter (for (a b) on (base-stats-of object) by #'cddr)
- (collect a)
- (collect (+ b (getf wield-stats a) (getf wear-stats a)))))
+ (collect a)
+ (collect (+ b (getf wield-stats a) (getf wear-stats a)))))
(base-stats-of object))
(let ((c (filter-items (wear-of object) 'closed-bottoms)))
(destructuring-bind (&key (sogginess 0) (sogginess-capacity 0) (messiness 0) (messiness-capacity 0))
@@ -197,16 +197,16 @@
(return))
((and (< old-x new-x) (= old-y new-y) (= old-z new-z) (equal old-zone new-zone))
(iter (for i from (1+ old-x) to new-x)
- (collect :east)))
+ (collect :east)))
((and (> old-x new-x) (= old-y new-y) (= old-z new-z) (equal old-zone new-zone))
(iter (for i from (1- old-x) downto new-x)
- (collect :west)))
+ (collect :west)))
((and (= old-x new-x) (< old-y new-y) (= old-z new-z) (equal old-zone new-zone))
(iter (for i from (1+ old-y) to new-y)
- (collect :south)))
+ (collect :south)))
((and (= old-x new-x) (> old-y new-y) (= old-z new-z) (equal old-zone new-zone))
(iter (for i from (1- old-y) downto new-y)
- (collect :north)))
+ (collect :north)))
(t
(format t "You're either already on that zone or you tried specifying a path that involves turning (which this interface can't do because Pouar sucks at writing code that generates paths)~%")
(return))))))))
@@ -217,63 +217,63 @@
(yadfa-bin:lst :describe-zone zone))
(c:define-presentation-to-command-translator com-yadfa-move-translator
(zone com-yadfa-move yadfa-world-commands
- :documentation "Move"
- :pointer-documentation "Move Here"
- :gesture nil
- :menu t
- :tester ((object) (destructuring-bind (new-x new-y new-z new-zone) (position-of object)
- (destructuring-bind (old-x old-y old-z old-zone) (position-of (player-of *game*))
- (and (= old-z new-z) (equal old-zone new-zone) (or (and (= old-y new-y) (/= old-x new-x))
- (and (= old-x new-x) (/= old-y new-y))))))))
- (object)
+ :documentation "Move"
+ :pointer-documentation "Move Here"
+ :gesture nil
+ :menu t
+ :tester ((object) (destructuring-bind (new-x new-y new-z new-zone) (position-of object)
+ (destructuring-bind (old-x old-y old-z old-zone) (position-of (player-of *game*))
+ (and (= old-z new-z) (equal old-zone new-zone) (or (and (= old-y new-y) (/= old-x new-x))
+ (and (= old-x new-x) (/= old-y new-y))))))))
+ (object)
(list object))
(c:define-presentation-to-command-translator com-yadfa-move-translator-up
(zone com-yadfa-move yadfa-world-commands
- :documentation "Move Up"
- :pointer-documentation "Move Up"
- :gesture nil
- :menu t
- :tester ((object) (and (equal (position-of (player-of *game*)) (position-of object))
- (get-zone (destructuring-bind (x y z zone) (position-of object)
- `(,x ,y ,(1+ z) ,zone)))
- (yadfa::travelablep (position-of (player-of *game*)) :up))))
- (object)
+ :documentation "Move Up"
+ :pointer-documentation "Move Up"
+ :gesture nil
+ :menu t
+ :tester ((object) (and (equal (position-of (player-of *game*)) (position-of object))
+ (get-zone (destructuring-bind (x y z zone) (position-of object)
+ `(,x ,y ,(1+ z) ,zone)))
+ (yadfa::travelablep (position-of (player-of *game*)) :up))))
+ (object)
'((:up)))
(c:define-presentation-to-command-translator com-yadfa-move-translator-down
(zone com-yadfa-move yadfa-world-commands
- :documentation "Move Down"
- :pointer-documentation "Move Down"
- :gesture nil
- :menu t
- :tester ((object) (and (equal (position-of (player-of *game*)) (position-of object))
- (get-zone (destructuring-bind (x y z zone) (position-of object)
- `(,x ,y ,(1- z) ,zone)))
- (yadfa::travelablep (position-of (player-of *game*)) :down))))
- (object)
+ :documentation "Move Down"
+ :pointer-documentation "Move Down"
+ :gesture nil
+ :menu t
+ :tester ((object) (and (equal (position-of (player-of *game*)) (position-of object))
+ (get-zone (destructuring-bind (x y z zone) (position-of object)
+ `(,x ,y ,(1- z) ,zone)))
+ (yadfa::travelablep (position-of (player-of *game*)) :down))))
+ (object)
'((:down)))
(c:define-presentation-to-command-translator com-yadfa-move-translator-warp
(zone com-yadfa-move yadfa-world-commands
- :documentation "Move To Waypoint"
- :pointer-documentation "Move To Waypoint"
- :gesture nil
- :menu t
- :tester ((object) (and (equal (position-of (player-of *game*)) (position-of object))
- (iter (for (point position) on (warp-points-of (get-zone (position-of object))) by 'cddr)
- (unless (yadfa::travelablep (position-of (player-of *game*)) point)
- (collect point))))))
- (object)
+ :documentation "Move To Waypoint"
+ :pointer-documentation "Move To Waypoint"
+ :gesture nil
+ :menu t
+ :tester ((object) (and (equal (position-of (player-of *game*)) (position-of object))
+ (iter (for (point position) on (warp-points-of (get-zone (position-of object))) by 'cddr)
+ (unless (yadfa::travelablep (position-of (player-of *game*)) point)
+ (collect point))))))
+ (object)
`((,(let ((*query-io* (c:frame-query-io (c:find-application-frame 'yadfa-listener))))
(c:accepting-values (*query-io* :resynchronize-every-pass t)
- (c:accept `(member-alist ,(iter (for (key position) on (warp-points-of (get-zone (position-of object))) by 'cddr)
- (unless (yadfa::travelablep (position-of (player-of *game*)) key)
- (collect (cons (write-to-string key) key))))) :view clim:+radio-box-view+ :stream *query-io*))))))
+ (c:accept `(member-alist ,(iter (for (key position) on (warp-points-of (get-zone (position-of object))) by 'cddr)
+ (unless (yadfa::travelablep (position-of (player-of *game*)) key)
+ (collect (cons (write-to-string key) key))))) :view clim:+radio-box-view+ :stream *query-io*))))))
(c:define-presentation-to-command-translator com-yadfa-describe-zone-translator
(zone com-yadfa-describe-zone yadfa-bin-commands
- :documentation "Describe Zone"
- :pointer-documentation "Print Zone Description"
- :gesture nil
- :menu t)
- (object)
+ :documentation "Describe Zone"
+ :pointer-documentation "Print Zone Description"
+ :gesture nil
+ :menu t)
+ (object)
(list object))
(c:define-application-frame emacs-frame (c:standard-application-frame)
((lambda :accessor emacs-frame-lambda
@@ -286,10 +286,10 @@
(default int)))
(defmethod c:default-frame-top-level :around ((frame emacs-frame)
&key (command-parser 'c:command-line-command-parser)
- (command-unparser 'c:command-line-command-unparser)
- (partial-command-parser
- 'c:command-line-read-remaining-arguments-for-partial-command)
- (prompt "Command: "))
+ (command-unparser 'c:command-line-command-unparser)
+ (partial-command-parser
+ 'c:command-line-read-remaining-arguments-for-partial-command)
+ (prompt "Command: "))
(declare (ignore prompt))
(let* ((frame-query-io (c:frame-query-io frame))
(interactorp (typep frame-query-io 'c:interactor-pane))
@@ -317,10 +317,10 @@
(defmethod c:default-frame-top-level
((frame yadfa-listener)
&key (command-parser 'c:command-line-command-parser)
- (command-unparser 'c:command-line-command-unparser)
- (partial-command-parser
- 'c:command-line-read-remaining-arguments-for-partial-command)
- (prompt "Command: "))
+ (command-unparser 'c:command-line-command-unparser)
+ (partial-command-parser
+ 'c:command-line-read-remaining-arguments-for-partial-command)
+ (prompt "Command: "))
;; Give each pane a fresh start first time through.
(let ((needs-redisplay t)
(first-time t))
@@ -345,9 +345,9 @@
(restart-case
(flet ((execute-command ()
(a:when-let ((command (c:read-frame-command frame :stream frame-query-io)))
- (setq needs-redisplay t)
- (s:run-hooks 'yadfa:*cheat-hooks*)
- (c:execute-frame-command frame command))))
+ (setq needs-redisplay t)
+ (s:run-hooks 'yadfa:*cheat-hooks*)
+ (c:execute-frame-command frame command))))
(when needs-redisplay
(dolist (i yadfa-clim::*records*) do (c:redisplay i *standard-output*))
(c:redisplay-frame-panes frame :force-p first-time)
@@ -383,13 +383,13 @@
(unwind-protect (error 'emm386-memory-manager-error)
(call-next-method)))
(defun run-listener (&key (new-process nil)
- (debugger t)
- (width 1024)
- (height 1024)
- port
- frame-manager
- (process-name "Yadfa")
- (package :yadfa-user))
+ (debugger t)
+ (width 1024)
+ (height 1024)
+ port
+ frame-manager
+ (process-name "Yadfa")
+ (package :yadfa-user))
(let* ((fm (or frame-manager (c:find-frame-manager :port (or port (c:find-port)))))
(frame (c:make-application-frame 'yadfa-listener
:frame-manager fm
diff --git a/core/patches.lisp b/core/patches.lisp
index 4ab8510..a7a2ecf 100644
--- a/core/patches.lisp
+++ b/core/patches.lisp
@@ -50,30 +50,30 @@
(:command-definer t))
(defmethod run-frame-top-level :around ((frame accept-values) &key)
(letf (((frame-process frame) (current-process)))
- (funcall (frame-top-level-lambda frame) frame)))
+ (funcall (frame-top-level-lambda frame) frame)))
(defmethod display-exit-boxes ((frame accept-values) stream (view textual-dialog-view))
(declare (ignorable frame))
(updating-output (stream :unique-id 'buttons :cache-value t)
- (fresh-line stream)
- (formatting-table (stream)
- (formatting-row (stream)
- (dolist (i (slot-value frame 'exit-boxes))
- (formatting-cell (stream)
- (with-output-as-presentation (stream nil (cond ((eql (car i) :exit)
- 'exit-button)
- ((eql (car i) :abort)
- 'abort-button)))
- (surrounding-output-with-border
- (stream :shape :rounded :radius 6
- :background +gray80+ :highlight-background +gray90+)
- (format stream (cadr i))))))))
- (terpri stream)))
+ (fresh-line stream)
+ (formatting-table (stream)
+ (formatting-row (stream)
+ (dolist (i (slot-value frame 'exit-boxes))
+ (formatting-cell (stream)
+ (with-output-as-presentation (stream nil (cond ((eql (car i) :exit)
+ 'exit-button)
+ ((eql (car i) :abort)
+ 'abort-button)))
+ (surrounding-output-with-border
+ (stream :shape :rounded :radius 6
+ :background +gray80+ :highlight-background +gray90+)
+ (format stream (cadr i))))))))
+ (terpri stream)))
(defmethod default-frame-top-level
((frame accept-values)
&key command-parser
- command-unparser
- partial-command-parser
- prompt)
+ command-unparser
+ partial-command-parser
+ prompt)
(declare (ignore command-parser command-unparser partial-command-parser prompt))
;; Give each pane a fresh start first time through.
(let* ((stream (slot-value frame 'stream))
@@ -106,24 +106,24 @@
:stream stream
:align-prompts align-prompts))
(arecord (updating-output (stream :record-type 'accepting-values-record)
- (when label
- (format stream label)
- (terpri stream))
- (if align-prompts
- (formatting-table (stream)
- #1=(setf return-values
- (multiple-value-list
- (funcall body *accepting-values-stream*))))
- #1#)
- (unless (queries *accepting-values-stream*)
- (cerror "Exit returning body values."
- "~s must contain at least one call to ~s."
- 'accepting-values 'accept)
- (return-from default-frame-top-level return-values))
- (display-exit-boxes frame
- stream
- (stream-default-view
- *accepting-values-stream*))))
+ (when label
+ (format stream label)
+ (terpri stream))
+ (if align-prompts
+ (formatting-table (stream)
+ #1=(setf return-values
+ (multiple-value-list
+ (funcall body *accepting-values-stream*))))
+ #1#)
+ (unless (queries *accepting-values-stream*)
+ (cerror "Exit returning body values."
+ "~s must contain at least one call to ~s."
+ 'accepting-values 'accept)
+ (return-from default-frame-top-level return-values))
+ (display-exit-boxes frame
+ stream
+ (stream-default-view
+ *accepting-values-stream*))))
(first-time t)
(current-command (if initially-select-p
`(com-select-query
@@ -135,67 +135,67 @@
(*accelerator-gestures* (compute-inherited-keystrokes command-table)))
(letf (((frame-command-table *application-frame*)
(find-command-table command-table)))
- (unwind-protect
- (handler-case
- (loop
- (if first-time
- (setq first-time nil)
- (when resynchronize-every-pass
- (redisplay arecord stream)))
- (with-input-context
- ('(command :command-table accept-values))
- (object)
- (progn
- (when (and select-first-query
- (not initially-select-p))
- (setf current-command
- `(com-select-query
- ,(query-identifier
- (first
- (queries *accepting-values-stream*))))
- select-first-query nil))
- (handler-case
- (progn
- (apply (command-name current-command)
- (command-arguments current-command))
- ;; If current command returns without throwing a
- ;; command, go back to the default command
- (setq current-command *default-command*))
- (accelerator-gesture (c)
- (let ((command (lookup-keystroke-command-item
- (accelerator-gesture-event c) command-table)))
- (if (listp command)
- (setq current-command
- (if (clim:partial-command-p command)
- (funcall clim:*partial-command-parser*
- command-table stream command
- (position clim:*unsupplied-argument-marker* command))
- command))
- ;; may be it is a gesture of the frame's command-table
- (signal c))))))
- (t (setq current-command object)))
- (redisplay arecord stream))
- (av-exit ()
- (finalize-query-records *accepting-values-stream*)
- (setf (last-pass *accepting-values-stream*) t)
- (redisplay arecord stream)))
- (dolist (query (queries *accepting-values-stream*))
- (finalize (editing-stream (record query)) nil))
- (erase-output-record arecord stream)
- (setf (stream-cursor-position stream)
- (values cx cy))))
+ (unwind-protect
+ (handler-case
+ (loop
+ (if first-time
+ (setq first-time nil)
+ (when resynchronize-every-pass
+ (redisplay arecord stream)))
+ (with-input-context
+ ('(command :command-table accept-values))
+ (object)
+ (progn
+ (when (and select-first-query
+ (not initially-select-p))
+ (setf current-command
+ `(com-select-query
+ ,(query-identifier
+ (first
+ (queries *accepting-values-stream*))))
+ select-first-query nil))
+ (handler-case
+ (progn
+ (apply (command-name current-command)
+ (command-arguments current-command))
+ ;; If current command returns without throwing a
+ ;; command, go back to the default command
+ (setq current-command *default-command*))
+ (accelerator-gesture (c)
+ (let ((command (lookup-keystroke-command-item
+ (accelerator-gesture-event c) command-table)))
+ (if (listp command)
+ (setq current-command
+ (if (clim:partial-command-p command)
+ (funcall clim:*partial-command-parser*
+ command-table stream command
+ (position clim:*unsupplied-argument-marker* command))
+ command))
+ ;; may be it is a gesture of the frame's command-table
+ (signal c))))))
+ (t (setq current-command object)))
+ (redisplay arecord stream))
+ (av-exit ()
+ (finalize-query-records *accepting-values-stream*)
+ (setf (last-pass *accepting-values-stream*) t)
+ (redisplay arecord stream)))
+ (dolist (query (queries *accepting-values-stream*))
+ (finalize (editing-stream (record query)) nil))
+ (erase-output-record arecord stream)
+ (setf (stream-cursor-position stream)
+ (values cx cy))))
(apply 'values return-values)))))
(defun invoke-accepting-values
(stream body
&rest args
&key own-window exit-boxes
- (initially-select-query-identifier nil initially-select-p)
- select-first-query
- modify-initial-query resynchronize-every-pass resize-frame
- align-prompts label scroll-bars
- x-position y-position width height
- (command-table 'accept-values)
- (frame-class 'accept-values))
+ (initially-select-query-identifier nil initially-select-p)
+ select-first-query
+ modify-initial-query resynchronize-every-pass resize-frame
+ align-prompts label scroll-bars
+ x-position y-position width height
+ (command-table 'accept-values)
+ (frame-class 'accept-values))
(declare (ignore own-window exit-boxes modify-initial-query
resize-frame scroll-bars x-position y-position width height
initially-select-query-identifier
diff --git a/core/util.lisp b/core/util.lisp
index ebe18a0..3924429 100644
--- a/core/util.lisp
+++ b/core/util.lisp
@@ -22,7 +22,7 @@
(swank-backend:arglist lambda-exp))
(defmacro do-push (item &rest places)
(a:once-only (item)
- `(progn ,@(loop for place in places collect `(push ,item ,place)))))
+ `(progn ,@(loop for place in places collect `(push ,item ,place)))))
(declaim (ftype (function (unsigned-byte sequence) sequence) remove-nth))
(defun remove-nth (n sequence)
(remove-if (constantly t) sequence :start n :count 1))
@@ -88,21 +88,21 @@ the result of calling @code{REMOVE-IF} with @var{TEST}, place, and the @var{KEYW
(defmacro lappendf (list &rest args)
"Modify macro that appends @var{ARGS} at the beginning of @var{LIST} instead of the end. Might be faster."
(a:once-only (list)
- `(setf ,list (append ,@args ,list))))
+ `(setf ,list (append ,@args ,list))))
(define-modify-macro appendf* (&rest lists) append*
"Modify-macro for APPEND*. Appends LISTS to the place designated by the first
argument.")
(declaim (inline list-length-< list-length-<=))
(s:eval-always
- (defun list-length-<= (length list)
- (declare (type list list)
- (type integer length))
- (let ((n (1- length)))
- (or (minusp n) (nthcdr n list))))
- (defun list-length-< (length list)
- (declare (type list list)
- (type integer length))
- (list-length-<= (1+ length) list)))
+ (defun list-length-<= (length list)
+ (declare (type list list)
+ (type integer length))
+ (let ((n (1- length)))
+ (or (minusp n) (nthcdr n list))))
+ (defun list-length-< (length list)
+ (declare (type list list)
+ (type integer length))
+ (list-length-<= (1+ length) list)))
(defmacro defunassert (name args asserts &body body)
"Wrapper macro that brings the behavior of SBCL's type declaration to other implementations, @var{NAME-ARGS-DECLARES} is the function name, lambda list, and optionally the docstring and declarations (omitting the type declarations) @var{ASSERTS} is the type specifiers for the lambda list as a plist, @var{BODY} is the body of the function"
(declare (inline list-length-<))
@@ -117,8 +117,8 @@ argument.")
(a:parse-ordinary-lambda-list args)
(declare (ignore rest allow aux keyp))
(iter (for i in (append req (mapcar 'car op) (mapcar 'cadar key)))
- (when (member i (s:plist-keys asserts))
- (collect `(type ,(getf asserts i) ,i)))))))
+ (when (member i (s:plist-keys asserts))
+ (collect `(type ,(getf asserts i) ,i)))))))
`(defun
,name ,args ,@(when docstring `(,docstring))
,@`(,(append (or declare '(declare))
@@ -127,10 +127,10 @@ argument.")
(parse-ordinary-lambda-list args)
(declare (ignore rest allow aux keyp))
(iter (for i in (append req (mapcar 'car op) (mapcar 'cadar key)))
- (when (member i (plist-keys asserts))
- (collect `(check-type ,i ,(if (member i (plist-keys asserts))
- (getf asserts i)
- t))))))
+ (when (member i (plist-keys asserts))
+ (collect `(check-type ,i ,(if (member i (plist-keys asserts))
+ (getf asserts i)
+ t))))))
,@(cond ((and docstring declare)
(cddr body))
((or docstring declare)
diff --git a/data/element-types/abdl.lisp b/data/element-types/abdl.lisp
index bb0a46c..7937ef6 100644
--- a/data/element-types/abdl.lisp
+++ b/data/element-types/abdl.lisp
@@ -1,5 +1,5 @@
;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa-element-types"; coding: utf-8-unix; -*-
(in-package :yadfa-element-types)
(define-type abdl ()
- ()
- (:element-name "ABDL"))
+ ()
+ (:element-name "ABDL"))
diff --git a/data/element-types/pokemon.lisp b/data/element-types/pokemon.lisp
index b613597..2fb6d11 100644
--- a/data/element-types/pokemon.lisp
+++ b/data/element-types/pokemon.lisp
@@ -1,93 +1,93 @@
;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa-element-types"; coding: utf-8-unix; -*-
(in-package :yadfa-element-types)
(define-type normal ()
- ()
- (:not-very-effective rock steel)
- (:no-effect ghost)
- (:element-name "Normal"))
+ ()
+ (:not-very-effective rock steel)
+ (:no-effect ghost)
+ (:element-name "Normal"))
(define-type fighting ()
- ()
- (:not-very-effective flying poison bug psychic fairy)
- (:no-effect ghost)
- (:super-effective rock ice dark steel)
- (:element-name "Fighting"))
+ ()
+ (:not-very-effective flying poison bug psychic fairy)
+ (:no-effect ghost)
+ (:super-effective rock ice dark steel)
+ (:element-name "Fighting"))
(define-type flying ()
- ()
- (:not-very-effective rock steel electric)
- (:super-effective fighting bug grass)
- (:element-name "Flying"))
+ ()
+ (:not-very-effective rock steel electric)
+ (:super-effective fighting bug grass)
+ (:element-name "Flying"))
(define-type poison ()
- ()
- (:not-very-effective poison ground rock ghost)
- (:super-effective grass fairy)
- (:no-effect steel)
- (:element-name "Poison"))
+ ()
+ (:not-very-effective poison ground rock ghost)
+ (:super-effective grass fairy)
+ (:no-effect steel)
+ (:element-name "Poison"))
(define-type ground ()
- ()
- (:not-very-effective bug grass)
- (:super-effective poison rock steel fire electric)
- (:no-effect flying)
- (:element-name "Ground"))
+ ()
+ (:not-very-effective bug grass)
+ (:super-effective poison rock steel fire electric)
+ (:no-effect flying)
+ (:element-name "Ground"))
(define-type rock ()
- ()
- (:not-very-effective fight ground steel)
- (:super-effective flying bug fire ice)
- (:element-name "Rock"))
+ ()
+ (:not-very-effective fight ground steel)
+ (:super-effective flying bug fire ice)
+ (:element-name "Rock"))
(define-type bug ()
- ()
- (:not-very-effective fighting flying poison ghost steel fire fairy)
- (:super-effective grass psychic dark)
- (:element-name "Bug"))
+ ()
+ (:not-very-effective fighting flying poison ghost steel fire fairy)
+ (:super-effective grass psychic dark)
+ (:element-name "Bug"))
(define-type steel ()
- ()
- (:not-very-effective steel fire water electric)
- (:super-effective rockice fairy)
- (:element-name "Steel"))
+ ()
+ (:not-very-effective steel fire water electric)
+ (:super-effective rockice fairy)
+ (:element-name "Steel"))
(define-type fire ()
- ()
- (:not-very-effective rock fire water)
- (:super-effective bug steel grass ice dragon)
- (:element-name "Fire"))
+ ()
+ (:not-very-effective rock fire water)
+ (:super-effective bug steel grass ice dragon)
+ (:element-name "Fire"))
(define-type water ()
- ()
- (:not-very-effective ground rock fire)
- (:super-effective water grass dragon)
- (:element-name "Water"))
+ ()
+ (:not-very-effective ground rock fire)
+ (:super-effective water grass dragon)
+ (:element-name "Water"))
(define-type grass ()
- ()
- (:super-effective ground rock water)
- (:not-very-effective flying poison bug steel fire grass dragon)
- (:element-name "Water"))
+ ()
+ (:super-effective ground rock water)
+ (:not-very-effective flying poison bug steel fire grass dragon)
+ (:element-name "Water"))
(define-type electric ()
- ()
- (:not-very-effective grass electric dragon)
- (:no-effect ground)
- (:super-effective flying water)
- (:element-name "Electric"))
+ ()
+ (:not-very-effective grass electric dragon)
+ (:no-effect ground)
+ (:super-effective flying water)
+ (:element-name "Electric"))
(define-type psychic ()
- ()
- (:not-very-effective steel psychic)
- (:no-effect dark)
- (:super-effective fighting poison)
- (:element-name "Psychic"))
+ ()
+ (:not-very-effective steel psychic)
+ (:no-effect dark)
+ (:super-effective fighting poison)
+ (:element-name "Psychic"))
(define-type ice ()
- ()
- (:not-very-effective steel fire water ice)
- (:super-effective flying ground grass dragon)
- (:element-name "Ice"))
+ ()
+ (:not-very-effective steel fire water ice)
+ (:super-effective flying ground grass dragon)
+ (:element-name "Ice"))
(define-type dragon ()
- ()
- (:not-very-effective steel)
- (:no-effect fairy)
- (:super-effective dragon)
- (:element-name "Dragon"))
+ ()
+ (:not-very-effective steel)
+ (:no-effect fairy)
+ (:super-effective dragon)
+ (:element-name "Dragon"))
(define-type dark ()
- ()
- (:not-very-effective fighting dark fairy)
- (:super-effective ghost psychic abdl)
- (:element-name "Dark"))
+ ()
+ (:not-very-effective fighting dark fairy)
+ (:super-effective ghost psychic abdl)
+ (:element-name "Dark"))
(define-type fairy ()
- ()
- (:not-very-effective poison steel fire abdl)
- (:super-effective fighting dragon dark)
- (:element-name "Fairy"))
+ ()
+ (:not-very-effective poison steel fire abdl)
+ (:super-effective fighting dragon dark)
+ (:element-name "Fairy"))
diff --git a/data/enemies/haunted.lisp b/data/enemies/haunted.lisp
index 860aa84..534a83f 100644
--- a/data/enemies/haunted.lisp
+++ b/data/enemies/haunted.lisp
@@ -7,16 +7,16 @@
(iter (for i in (if (typep user 'team-member)
(enemies-of *battle*)
(team-of *game*)))
- (with j = nil)
- (when (>= (bladder/contents-of i) (bladder/need-to-potty-limit-of i))
- (format t "~a wets ~aself in fear~%" (name-of i) (if (malep i) "him" "her"))
- (wet :wetter i)
- (set-status-condition 'yadfa-status-conditions:wetting i)
- (setf j t))
- (when (>= (bowels/contents-of i) (bowels/need-to-potty-limit-of i))
- (format t "~a messes ~aself in fear~%" (name-of i) (if (malep i) "him" "her"))
- (mess :messer i)
- (set-status-condition 'yadfa-status-conditions:messing i)
- (setf j t))
- (finally (return j))))
+ (with j = nil)
+ (when (>= (bladder/contents-of i) (bladder/need-to-potty-limit-of i))
+ (format t "~a wets ~aself in fear~%" (name-of i) (if (malep i) "him" "her"))
+ (wet :wetter i)
+ (set-status-condition 'yadfa-status-conditions:wetting i)
+ (setf j t))
+ (when (>= (bowels/contents-of i) (bowels/need-to-potty-limit-of i))
+ (format t "~a messes ~aself in fear~%" (name-of i) (if (malep i) "him" "her"))
+ (mess :messer i)
+ (set-status-condition 'yadfa-status-conditions:messing i)
+ (setf j t))
+ (finally (return j))))
(write-line "it had no effect")))
diff --git a/data/enemies/navy.lisp b/data/enemies/navy.lisp
index a5fd595..27de13f 100644
--- a/data/enemies/navy.lisp
+++ b/data/enemies/navy.lisp
@@ -17,12 +17,12 @@
(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)))))
+ (let ((i (typecase i
+ (diaper 'diaper)
+ (pullup 'pullup)
+ (closed-bottoms 'closed-bottoms))))
+ (when i
+ (leave i)))))
(pampspronoun (if male
(if pamps
"his "
@@ -96,14 +96,14 @@
:watersport-chance (random-from-range 1 3)
:mudsport-chance (random-from-range 1 3)
:inventory (nconc (iter (for i from 0 to (random 5))
- (collect (make-instance 'yadfa-items:navy-pullups)))
+ (collect (make-instance 'yadfa-items:navy-pullups)))
(iter (for i from 0 to (random 15))
- (collect (make-instance 'yadfa-items:cloth-incontinence-pad))))))
+ (collect (make-instance 'yadfa-items:cloth-incontinence-pad))))))
(defmethod initialize-instance :after
((c navy-officer*) &rest args &key &allow-other-keys)
(destructuring-bind (&key (watersport-limit nil watersportp) (mudsport-limit nil mudsportp) (wear nil wearp) &allow-other-keys)
args
- (declare (ignore watersport-limit mudsport-limit wear))
+ (declare (ignore watersport-limit mudsport-limit wear))
(unless wearp
(push (make-instance 'yadfa-items:cloth-incontinence-pad) (wear-of c))
(push (make-instance 'yadfa-items:navy-pullups) (wear-of c))
diff --git a/data/enemies/pirates.lisp b/data/enemies/pirates.lisp
index c8218ea..2940c1e 100644
--- a/data/enemies/pirates.lisp
+++ b/data/enemies/pirates.lisp
@@ -29,11 +29,11 @@
(:default-initargs
:description "A variant of the Diaper Pirate that wears 3 layers of padding. A stuffer, a normal diaper, and a super thick diaper."
:inventory (nconc (iter (for i from 0 to (random 20))
- (collect (make-instance 'yadfa-items:incontinence-pad)))
+ (collect (make-instance 'yadfa-items:incontinence-pad)))
(iter (for i from 0 to (random 20))
- (collect (make-instance 'yadfa-items:cloth-diaper)))
+ (collect (make-instance 'yadfa-items:cloth-diaper)))
(iter (for i from 0 to (random 20))
- (collect (make-instance 'yadfa-items:thick-rubber-diaper))))))
+ (collect (make-instance 'yadfa-items:thick-rubber-diaper))))))
(defmethod initialize-instance :after ((c thickly-diaper-pirate) &rest args &key &allow-other-keys)
(destructuring-bind (&key (wear nil wearp) &allow-other-keys)
args
@@ -42,7 +42,7 @@
(setf (wear-of c) nil)
(a:appendf (wear-of c)
(iter (for i in '(yadfa-items:thick-rubber-diaper yadfa-items:cloth-diaper yadfa-items:incontinence-pad))
- (collect (make-instance i))))
+ (collect (make-instance i))))
(unless (malep c)
(push (make-instance 'yadfa-items:bra) (wear-of c)))
(push (make-instance 'yadfa-items:pirate-shirt) (wear-of c)))))
diff --git a/data/enemies/raccoon-bandits.lisp b/data/enemies/raccoon-bandits.lisp
index 62c9a23..28c733c 100644
--- a/data/enemies/raccoon-bandits.lisp
+++ b/data/enemies/raccoon-bandits.lisp
@@ -11,19 +11,19 @@
:wear (make-instances yadfa-items:bandit-uniform-tunic yadfa-items:bandit-adjustable-diaper)
:inventory (let ((a ()))
(iter (for i from 0 to (random 5))
- (push (make-instance 'yadfa-items:bandit-diaper) a))
+ (push (make-instance 'yadfa-items:bandit-diaper) a))
(iter (for i from 0 to (random 5))
- (push (make-instance 'yadfa-items:bandit-adjustable-diaper) a))
+ (push (make-instance 'yadfa-items:bandit-adjustable-diaper) a))
(iter (for i from 0 to (random 5))
- (push (make-instance 'yadfa-items:bandit-female-diaper) a)))
+ (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)) (position :ai-health-inc (ai-flags-of i)))
- (collect i))))
+ (when (and (>= (energy-of self) (energy-cost-of i)) (position :ai-health-inc (ai-flags-of i)))
+ (collect i))))
(moves-can-use (iter (for i in (moves-of self))
- (when (>= (energy-of self) (energy-cost-of i))
- (collect i))))
+ (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))
diff --git a/data/enemies/rpgmaker.lisp b/data/enemies/rpgmaker.lisp
index 88d2e2a..7e88475 100644
--- a/data/enemies/rpgmaker.lisp
+++ b/data/enemies/rpgmaker.lisp
@@ -10,7 +10,7 @@
:bowels/contents (random 700)
:bitcoins-per-level 100
:inventory (iter (for i from 0 to (random 10))
- (collect (make-instance 'yadfa-items:cloth-diaper)))))
+ (collect (make-instance 'yadfa-items:cloth-diaper)))))
(setf (get 'diapered-kobold 'change-class-target) 'yadfa-allies:diapered-kobold)
(defmethod initialize-instance :after
((c diapered-kobold) &rest args &key &allow-other-keys)
@@ -36,13 +36,13 @@
:mudsport-chance 3
:bitcoins-per-level 100
:inventory (iter (for i from 0 to (random 10))
- (collect (make-instance 'yadfa-items:high-capacity-diaper)))
+ (collect (make-instance 'yadfa-items:high-capacity-diaper)))
:element-types (make-instances yadfa-element-types:poison)
:moves (make-instances yadfa-moves:spray yadfa-moves:face-sit)))
(defmethod initialize-instance :after
((c diapered-skunk) &rest args &key &allow-other-keys)
(destructuring-bind (&key (watersport-limit nil watersportp) (mudsport-limit nil mudsportp)
- (wear nil wearp)
+ (wear nil wearp)
&allow-other-keys)
args
(declare (ignore watersport-limit mudsport-limit wear))
@@ -114,7 +114,7 @@
(defmethod initialize-instance :after
((c diapered-skunk*) &rest args &key &allow-other-keys)
(destructuring-bind (&key (watersport-limit nil watersportp) (mudsport-limit nil mudsportp)
- (wear nil wearp) (description nil descriptionp)
+ (wear nil wearp) (description nil descriptionp)
&allow-other-keys)
args
(declare (ignore watersport-limit mudsport-limit wear description))
@@ -185,9 +185,9 @@
:wear (list (make-instance 'yadfa-items:black-leather-jacket)
(make-instance 'yadfa-items:high-capacity-diaper))
:inventory (nconc (iter (for i from 0 to (random 20))
- (collect (make-instance 'yadfa-items:high-capacity-diaper)))
+ (collect (make-instance 'yadfa-items:high-capacity-diaper)))
(iter (for i from 0 to (random 20))
- (collect (make-instance 'yadfa-items:kurikia-thick-diaper))))
+ (collect (make-instance 'yadfa-items:kurikia-thick-diaper))))
:element-types (make-instances yadfa-element-types:dragon yadfa-element-types:fire yadfa-element-types:flying)
:moves (make-instances yadfa-moves:tickle yadfa-moves:roar yadfa-moves:mush yadfa-moves:fire-breath)))
(defclass diapered-dragon* (diapered-dragon pantsable-character) ()
@@ -204,19 +204,19 @@
:bladder/fill-rate (* (/ 14000 24 60) 2)
:wear (list (make-instance 'yadfa-items:kurikia-thick-rubber-diaper))
:inventory (iter (for i from 0 to (random 20))
- (collect (make-instance 'yadfa-items:kurikia-thick-rubber-diaper)))
+ (collect (make-instance 'yadfa-items:kurikia-thick-rubber-diaper)))
:element-types (list (make-instance 'yadfa-element-types:dragon))
:moves (make-instances yadfa-moves:tickle yadfa-moves:roar yadfa-moves:mush yadfa-moves:fire-breath)))
;;; Raptors would most likely not have bladders irl, but I already threw
;;; scientific accuracy out the window when I gave them scales instead of feathers.
(defclass raptor (potty-enemy adoptable-enemy) ()
- (:default-initargs
- :name "Raptor"
- :malep (a:random-elt '(t nil))
- :description "Biologically inaccurate velociraptor. The kind you see in Jurassic Park that looks more like a lizard than a prehistoric bird."
- :moves (make-instances yadfa-moves:roar yadfa-moves:bite)
- :species "Raptor"))
+ (:default-initargs
+ :name "Raptor"
+ :malep (a:random-elt '(t nil))
+ :description "Biologically inaccurate velociraptor. The kind you see in Jurassic Park that looks more like a lizard than a prehistoric bird."
+ :moves (make-instances yadfa-moves:roar yadfa-moves:bite)
+ :species "Raptor"))
(setf (get 'diapered-kobold 'change-class-target) 'yadfa-allies:raptor)
(defmethod change-class-text ((class raptor))
(format nil "~a was adopted and diapered" (name-of class)))
diff --git a/data/epilog/allies.lisp b/data/epilog/allies.lisp
index f9d4004..268ef25 100644
--- a/data/epilog/allies.lisp
+++ b/data/epilog/allies.lisp
@@ -1,36 +1,36 @@
;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa-allies"; coding: utf-8-unix; -*-
(in-package :yadfa-allies)
(defunassert yadfa-world-commands:disown-adopted-enemies (&optional allies count)
- (allies (or list type-specifier)
- count (or null unsigned-byte))
+ (allies (or list type-specifier)
+ count (or null unsigned-byte))
(setf allies
(typecase allies
(null (accept-with-effective-frame
- (clim:accepting-values (*query-io* :resynchronize-every-pass t)
- (clim:accept `(clim:subset-alist ,(iter (for enemy in (allies-of *game*))
- (when (typep (class-of enemy) 'adopted-enemy)
- (collect (cons (name-of enemy) enemy)))))
- :prompt "Enemies to disown"
- :stream *query-io*
- :view clim:+check-box-view+))))
+ (clim:accepting-values (*query-io* :resynchronize-every-pass t)
+ (clim:accept `(clim:subset-alist ,(iter (for enemy in (allies-of *game*))
+ (when (typep (class-of enemy) 'adopted-enemy)
+ (collect (cons (name-of enemy) enemy)))))
+ :prompt "Enemies to disown"
+ :stream *query-io*
+ :view clim:+check-box-view+))))
(type-specifier (iter (for enemy in (allies-of *game*))
- (for i upfrom 0)
- (when (and count (>= count i))
- (finish))
- (when (typep enemy `(and ,allies adopted-enemy))
- (collect enemy))))
+ (for i upfrom 0)
+ (when (and count (>= count i))
+ (finish))
+ (when (typep enemy `(and ,allies adopted-enemy))
+ (collect enemy))))
(list (iter
- (for enemy in (allies-of *game*))
- (generate current in allies)
- (for index upfrom 0)
- (cond ((typep current '(not unsigned-byte))
- (error "ENEMIES must be a list of unsigned-bytes"))
- ((and (eql index current) (typep enemy '(not adopted-enemy)))
- (let ((*package* (find-package :yadfa-user)))
- (error "ALLY at index ~d isn't an ~w" yadfa-allies::index 'yadfa-allies:adopted-enemy)))
- ((eql index current)
- (collect enemy)
- (next current)))))))
+ (for enemy in (allies-of *game*))
+ (generate current in allies)
+ (for index upfrom 0)
+ (cond ((typep current '(not unsigned-byte))
+ (error "ENEMIES must be a list of unsigned-bytes"))
+ ((and (eql index current) (typep enemy '(not adopted-enemy)))
+ (let ((*package* (find-package :yadfa-user)))
+ (error "ALLY at index ~d isn't an ~w" yadfa-allies::index 'yadfa-allies:adopted-enemy)))
+ ((eql index current)
+ (collect enemy)
+ (next current)))))))
(a:removef (allies-of *game*) allies :test (lambda (o e)
(member e o)))
(a:removef (team-of *game*) allies :test (lambda (o e)
diff --git a/data/epilog/blackjack.lisp b/data/epilog/blackjack.lisp
index 9033fed..9fb9fb6 100644
--- a/data/epilog/blackjack.lisp
+++ b/data/epilog/blackjack.lisp
@@ -106,17 +106,17 @@
:accessor ai-of))
(:command-table (game-frame :inherit-from (playing-commands end-game-commands end-round-commands)))
(:pane (c:vertically ()
- (c:make-clim-stream-pane :name 'game :scroll-bars nil :incremental-redisplay t
- :display-time :command-loop :display-function 'draw-game :width 640 :height 200 :max-height 300)
- (c:make-clim-stream-pane :name 'gadgets :scroll-bars nil :incremental-redisplay nil :background climi::*3d-normal-color*
- :display-time :command-loop :display-function 'draw-gadgets :width 640 :max-height 80)
- (c:make-clim-interactor-pane :display-time :command-loop :name 'int :width 1200))))
+ (c:make-clim-stream-pane :name 'game :scroll-bars nil :incremental-redisplay t
+ :display-time :command-loop :display-function 'draw-game :width 640 :height 200 :max-height 300)
+ (c:make-clim-stream-pane :name 'gadgets :scroll-bars nil :incremental-redisplay nil :background climi::*3d-normal-color*
+ :display-time :command-loop :display-function 'draw-gadgets :width 640 :max-height 80)
+ (c:make-clim-interactor-pane :display-time :command-loop :name 'int :width 1200))))
(defmethod c:run-frame-top-level ((frame game-frame) &key)
(let ((*player-cards* (make-array 12 :fill-pointer 0 :initial-element nil :element-type '(or null card)))
(*ai-cards* (make-array 12 :fill-pointer 0 :initial-element nil :element-type '(or null card)))
(*deck* (make-array 48 :fill-pointer 48 :element-type 'card :initial-contents (iter (for value in '(2 3 4 5 6 7 8 9 :king :queen :jack :ace))
- (dolist (suit '(:diamond :club :heart :spade))
- (collect (make-instance 'card :value value :suit suit))))))
+ (dolist (suit '(:diamond :club :heart :spade))
+ (collect (make-instance 'card :value value :suit suit))))))
(*round* :playing)
(*player-clothes* (list (make-instance 'yadfa-items:blackjack-uniform-diaper)))
*checkpoints*
@@ -138,20 +138,20 @@
`(multiple-value-bind (x y) (point-position ,point)
(c:draw-rectangle* ,medium x y (+ x (* ,stat 400)) (+ y 15)
:ink (cond ,@(iter (for i in colors)
- (collect `(,(car i) ,(intern (format nil "+~a+"
- (if (typep (car (last i)) 'cons)
- (caar (last i))
- (car (last i))))
- "CLIM"))))))
+ (collect `(,(car i) ,(intern (format nil "+~a+"
+ (if (typep (car (last i)) 'cons)
+ (caar (last i))
+ (car (last i))))
+ "CLIM"))))))
(c:draw-rectangle* ,medium x y (+ x 400) (+ y 15)
:filled nil)
(setf (c:stream-cursor-position ,medium) (values (+ x 400) y))))
(defun deal ()
(set-mode :playing)
(iter (for i in-vector *player-cards*)
- (vector-push i *deck*))
+ (vector-push i *deck*))
(iter (for i in-vector *ai-cards*)
- (vector-push i *deck*))
+ (vector-push i *deck*))
(setf (fill-pointer *player-cards*) 0
(fill-pointer *ai-cards*) 0)
(setf *deck* (alexandria:shuffle *deck*))
@@ -170,11 +170,11 @@
(declare (type boolean ace)
(type fixnum total))
(iter (for i in-vector cards)
- (when i
- (typecase (value-of i)
- (fixnum (incf total (value-of i)))
- ((member :king :queen :jack) (incf total 10))
- ((eql :ace) (setf ace t) (incf total)))))
+ (when i
+ (typecase (value-of i)
+ (fixnum (incf total (value-of i)))
+ ((member :king :queen :jack) (incf total 10))
+ ((eql :ace) (setf ace t) (incf total)))))
(if (and ace (<= total 10))
(+ total 10)
total)))
@@ -193,10 +193,10 @@
(labels ((process-potty-checkpoint (user)
(a:switch (user :test (lambda (o e)
(>= (bladder/contents-of o) (funcall e o))))
- ('bladder/need-to-potty-limit-of :need-to-potty)
- ('bladder/potty-dance-limit-of :potty-dance)
- ('bladder/potty-desperate-limit-of :potty-desparate)
- ('bladder/maximum-limit-of :lose)))
+ ('bladder/need-to-potty-limit-of :need-to-potty)
+ ('bladder/potty-dance-limit-of :potty-dance)
+ ('bladder/potty-desperate-limit-of :potty-desparate)
+ ('bladder/maximum-limit-of :lose)))
(process-potty-user (user &optional (clothing nil clothing-p))
(let ((new-checkpoint (process-potty-checkpoint user))
(had-accident (when (>= (bladder/contents-of (player-of *game*)) (bladder/maximum-limit-of (player-of *game*)))
@@ -214,9 +214,9 @@
(thunk (ai-of frame)))))
(defmethod c:default-frame-top-level ((frame game-frame)
&key command-parser
- command-unparser
- partial-command-parser
- prompt)
+ command-unparser
+ partial-command-parser
+ prompt)
(declare (ignore command-parser command-unparser partial-command-parser prompt))
(deal)
(call-next-method))
@@ -254,33 +254,33 @@
(setf *put-on-old-clothes* put-on-old-clothes)
(c:frame-exit c:*application-frame*)))
(serapeum:eval-always
- (in-package :yadfa-blackjack)
- (defclass give-up () ()))
+ (in-package :yadfa-blackjack)
+ (defclass give-up () ()))
(c:define-presentation-to-command-translator give-up-with-accept
(give-up com-give-up game-frame
- :gesture :select
- :documentation "Give Up?"
- :pointer-documentation "Give Up?")
- (object frame)
+ :gesture :select
+ :documentation "Give Up?"
+ :pointer-documentation "Give Up?")
+ (object frame)
(let ((*query-io* (c:frame-query-io frame))
go-potty put-on-old-clothes)
(c:accepting-values (*query-io* :own-window t :exit-boxes '((:exit "Accept")))
- (fresh-line *query-io*)
- (setf go-potty (c:accept '(c:member-alist (("Run to the toilet" :toilet)
- ("Flood your pamps" :pamps)))
- :prompt "<Run to the toilet> | <Flood your pamps>"
- :default :pamps :stream *query-io* :view c:+option-pane-view+))
- (fresh-line *query-io*)
- (setf put-on-old-clothes (c:accept 'boolean
- :prompt "Put on old clothes?:"
- :default t :stream *query-io* :view c:+toggle-button-view+)))
+ (fresh-line *query-io*)
+ (setf go-potty (c:accept '(c:member-alist (("Run to the toilet" :toilet)
+ ("Flood your pamps" :pamps)))
+ :prompt "<Run to the toilet> | <Flood your pamps>"
+ :default :pamps :stream *query-io* :view c:+option-pane-view+))
+ (fresh-line *query-io*)
+ (setf put-on-old-clothes (c:accept 'boolean
+ :prompt "Put on old clothes?:"
+ :default t :stream *query-io* :view c:+toggle-button-view+)))
`(,go-potty ,put-on-old-clothes)))
(c:define-command (com-stay :name t :command-table playing-commands)
()
(let ((player-total (calculate-total *player-cards*))
(stream (c:frame-standard-output c:*application-frame*)))
(iter (while (<= player-total (calculate-total *ai-cards*) 20))
- (vector-push (vector-pop *deck*) *ai-cards*))
+ (vector-push (vector-pop *deck*) *ai-cards*))
(let ((ai-total (calculate-total *ai-cards*)))
(cond
((> ai-total 21)
@@ -308,15 +308,15 @@
(cc:define-conditional-command (com-playing-mode)
(game-frame :enable-commands (playing-commands)
:disable-commands (end-round-commands end-game-commands))
- ())
+ ())
(cc:define-conditional-command (com-end-round-mode)
(game-frame :enable-commands (end-round-commands)
:disable-commands (playing-commands end-game-commands))
- ())
+ ())
(cc:define-conditional-command (com-end-game-mode)
(game-frame :enable-commands (end-game-commands)
:disable-commands (playing-commands end-round-commands))
- ())
+ ())
(defclass stat-view (c:view) ())
(defconstant +stat-view+ (make-instance 'stat-view))
(c:define-presentation-method c:present (user (type base-character) medium (view stat-view) &key)
@@ -337,26 +337,26 @@
(c:draw-circle* pane (+ (c:point-x point) 10) (+ (c:point-y point) 10) 10 :ink c:+red+)
(c:draw-circle* pane (+ (c:point-x point) 30) (+ (c:point-y point) 10) 10 :ink c:+red+ )
(c:draw-polygon pane (iter (for (x y) on '(0 10 40 10 20 40) by 'cddr)
- (collect (c:make-point (+ (c:point-x point) x) (+ (c:point-y point) y)))) :ink c:+red+))
+ (collect (c:make-point (+ (c:point-x point) x) (+ (c:point-y point) y)))) :ink c:+red+))
(draw-spade (point)
(declare (type c:point point))
(c:draw-circle* pane (+ (c:point-x point) 10) (+ (c:point-y point) 20) 10 :ink c:+black+)
(c:draw-circle* pane (+ (c:point-x point) 30) (+ (c:point-y point) 20) 10 :ink c:+black+)
(c:draw-polygon pane (iter (for (x y) on '(0 15 20 0 40 15 20 20) by 'cddr)
- (collect (c:make-point (+ (c:point-x point) x) (+ (c:point-y point) y)))) :ink c:+black+)
+ (collect (c:make-point (+ (c:point-x point) x) (+ (c:point-y point) y)))) :ink c:+black+)
(c:draw-polygon pane (iter (for (x y) on '(10 40 30 40 20 20) by 'cddr)
- (collect (c:make-point (+ (c:point-x point) x) (+ (c:point-y point) y)))) :ink c:+black+))
+ (collect (c:make-point (+ (c:point-x point) x) (+ (c:point-y point) y)))) :ink c:+black+))
(draw-diamond (point)
(declare (type c:point point))
(c:draw-polygon pane (iter (for (x y) on '(20 0 0 20 20 40 40 20) by 'cddr)
- (collect (c:make-point (+ (c:point-x point) x) (+ (c:point-y point) y)))) :ink c:+red+))
+ (collect (c:make-point (+ (c:point-x point) x) (+ (c:point-y point) y)))) :ink c:+red+))
(draw-club (point)
(declare (type c:point point))
(c:draw-circle* pane (+ (c:point-x point) 10) (+ (c:point-y point) 20) 10 :ink c:+black+)
(c:draw-circle* pane (+ (c:point-x point) 30) (+ (c:point-y point) 20) 10 :ink c:+black+)
(c:draw-circle* pane (+ (c:point-x point) 20) (+ (c:point-y point) 10) 10 :ink c:+black+)
(c:draw-polygon pane (iter (for (x y) on '(10 40 30 40 20 20) by 'cddr)
- (collect (c:make-point (+ (c:point-x point) x) (+ (c:point-y point) y)))) :ink c:+black+))
+ (collect (c:make-point (+ (c:point-x point) x) (+ (c:point-y point) y)))) :ink c:+black+))
(draw-card (card point)
(declare (type card card)
(type c:point point))
@@ -382,51 +382,51 @@
(multiple-value-bind (x y) (c:stream-cursor-position pane)
(declare (ignore x))
(iter (for i in-vector cards)
- (for x upfrom 0)
- (c:updating-output (pane :unique-id `(,user ,x) :id-test 'equal :cache-value `(,i ,(side-of i)) :cache-test 'equal)
- (draw-card i (c:make-point (+ (* x 40) 10) y))))
+ (for x upfrom 0)
+ (c:updating-output (pane :unique-id `(,user ,x) :id-test 'equal :cache-value `(,i ,(side-of i)) :cache-test 'equal)
+ (draw-card i (c:make-point (+ (* x 40) 10) y))))
(c:stream-increment-cursor-position pane 0 40)
(c:updating-output (pane :unique-id user :id-test 'eq :cache-value (bladder/contents-of user))
- (c:present user 'base-character :view +stat-view+ :stream pane)))))
+ (c:present user 'base-character :view +stat-view+ :stream pane)))))
(setf (c:stream-cursor-position pane) (values 0 0))
(draw-row (ai-of frame) *ai-cards*)
(draw-row (player-of *game*) *player-cards*)))
(defun draw-gadgets (frame pane)
(declare (ignore frame))
(c:formatting-item-list (pane)
- (let ((table (case *round*
- (:playing 'playing-commands)
- (:end-round 'end-round-commands)
- (:end-game 'end-game-commands))))
- (macrolet ((thunk (&rest alist)
- `(c:map-over-command-table-names
- (lambda (name symbol)
- (c:formatting-cell (pane)
- (case symbol
- ,@(iter (for i in (append alist '((t `(,(c:gadget-client button)) (c:command :command-table game-frame)))))
- (destructuring-bind (command object type) i
- (collect `(,command (c:with-output-as-gadget (pane)
- (c:make-pane 'c:push-button
- :label name
- :client symbol
- :activate-callback
- (lambda (button)
- (declare (ignorable button))
- ;; apparently panes don't work as presentations in McCLIM
- (c:throw-highlighted-presentation
- (make-instance 'c:standard-presentation
- :object ,object
- :single-box t
- :type ',type)
- c:*input-context*
- (make-instance 'c:pointer-button-press-event
- :sheet nil
- :x 0 :y 0
- :modifier-state 0
- :button c:+pointer-left-button+))))))))))))
- table
- :inherited nil)))
- (thunk ('com-give-up (make-instance 'give-up) give-up))))))
+ (let ((table (case *round*
+ (:playing 'playing-commands)
+ (:end-round 'end-round-commands)
+ (:end-game 'end-game-commands))))
+ (macrolet ((thunk (&rest alist)
+ `(c:map-over-command-table-names
+ (lambda (name symbol)
+ (c:formatting-cell (pane)
+ (case symbol
+ ,@(iter (for i in (append alist '((t `(,(c:gadget-client button)) (c:command :command-table game-frame)))))
+ (destructuring-bind (command object type) i
+ (collect `(,command (c:with-output-as-gadget (pane)
+ (c:make-pane 'c:push-button
+ :label name
+ :client symbol
+ :activate-callback
+ (lambda (button)
+ (declare (ignorable button))
+ ;; apparently panes don't work as presentations in McCLIM
+ (c:throw-highlighted-presentation
+ (make-instance 'c:standard-presentation
+ :object ,object
+ :single-box t
+ :type ',type)
+ c:*input-context*
+ (make-instance 'c:pointer-button-press-event
+ :sheet nil
+ :x 0 :y 0
+ :modifier-state 0
+ :button c:+pointer-left-button+))))))))))))
+ table
+ :inherited nil)))
+ (thunk ('com-give-up (make-instance 'give-up) give-up))))))
(defun run-game (&optional (enemy 'enemy))
(let ((c:*default-server-path* (if (eq (car (clim:port-server-path (clim:find-port))) :clx-ff)
:clx-ttf nil))
diff --git a/data/epilog/enemies.lisp b/data/epilog/enemies.lisp
index eed6922..7370729 100644
--- a/data/epilog/enemies.lisp
+++ b/data/epilog/enemies.lisp
@@ -8,7 +8,7 @@
(setf (wings-of current) '())
(setf (learned-moves-of current) '())
(iter (for i in '(yadfa-moves:watersport yadfa-moves:mudsport))
- (pushnew (make-instance i) (moves-of current) :key 'type-of))
+ (pushnew (make-instance i) (moves-of current) :key 'type-of))
(when (bitcoins-per-level-of previous)
(setf (bitcoins-of current) (* (bitcoins-per-level-of previous) (level-of previous)))))
(defmethod update-instance-for-different-class ((previous yadfa-enemies:catchable-raccoon-bandit) (current yadfa-allies:diapered-raccoon-bandit) &rest initargs &key &allow-other-keys)
@@ -19,7 +19,7 @@
(setf (wings-of current) '())
(setf (learned-moves-of current) '())
(iter (for i in '(yadfa-moves:watersport yadfa-moves:mudsport))
- (pushnew (make-instance i) (moves-of current) :key 'type-of))
+ (pushnew (make-instance i) (moves-of current) :key 'type-of))
(when (bitcoins-per-level-of previous)
(setf (bitcoins-of current) (* (bitcoins-per-level-of previous) (level-of previous)))))
(defmethod update-instance-for-different-class ((previous yadfa-enemies:diapered-kobold) (current yadfa-allies:diapered-kobold) &rest initargs &key &allow-other-keys)
@@ -30,6 +30,6 @@
(setf (wings-of current) '())
(setf (learned-moves-of current) '())
(iter (for i in '(yadfa-moves:watersport yadfa-moves:mudsport))
- (pushnew (make-instance i) (moves-of current) :key 'type-of))
+ (pushnew (make-instance i) (moves-of current) :key 'type-of))
(when (bitcoins-per-level-of previous)
(setf (bitcoins-of current) (* (bitcoins-per-level-of previous) (level-of previous)))))
diff --git a/data/epilog/items.lisp b/data/epilog/items.lisp
index d18d883..7b6e313 100644
--- a/data/epilog/items.lisp
+++ b/data/epilog/items.lisp
@@ -29,50 +29,50 @@
(declare (ignore user))
(setf (inventory-of (player-of *game*))
(append (iter (for enemy in (contained-enemies-of item))
- (dolist (item (inventory-of enemy))
- (collect item))
- (dolist (item (wear-of enemy))
- (collect item))
- (setf (inventory-of enemy) nil
- (wear-of enemy) nil))
+ (dolist (item (inventory-of enemy))
+ (collect item))
+ (dolist (item (wear-of enemy))
+ (collect item))
+ (setf (inventory-of enemy) nil
+ (wear-of enemy) nil))
(inventory-of (player-of *game*)))))))
(unless (getf (special-actions-of item) :adopt-enemies)
(setf (getf (special-actions-of item) :adopt-enemies)
'(lambda (item user &allow-other-keys :enemies enemies)
(if (iter (for i in (contained-enemies-of item))
- (when (typep (class-of i) 'yadfa-enemies:adoptable-enemy)
- (return t)))
- (progn
- (setf enemies
- (typecase enemies
- (null (accept-with-effective-frame
- (clim:accepting-values (*query-io* :resynchronize-every-pass t)
- (setf enemies (clim:accept `(clim:subset-alist ,(iter (for enemy in (contained-enemies-of item))
- (when (typep (class-of i) 'yadfa-enemies:adoptable-enemy)
- (collect (cons (name-of enemy) enemy)))))
- :prompt "Enemies to adopt"
- :stream *query-io*
- :view clim:+check-box-view+)))))
- (type-specifier (iter (for enemy in (contained-enemies-of item))
- (when (typep i enemies)
- (collect i))))
- (list (iter
- (for enemy in (contained-enemies-of item))
- (generate current in enemies)
- (for index upfrom 0)
- (cond ((typep current '(not unsigned-byte))
- (error "ENEMIES must be a list of unsigned-bytes"))
- ((eql index current)
- (collect enemy)
- (next current)))))
- (t (error "ENEMIES must either be a list of unsigned-bytes or a type specifier"))))
- (alexandria:removef (contained-enemies-of item) enemies
- :test (lambda (o e)
- (member e o)))
- (alexandria:appendf (allies-of *game*) (iter (for i in enemies)
- (write-line (yadfa-enemies:change-class-text i))
- (collect (change-class i (get (class-name i) 'yadfa-enemies:change-class-target))))))
- (format t "No enemies in there to adopt"))))))))
+ (when (typep (class-of i) 'yadfa-enemies:adoptable-enemy)
+ (return t)))
+ (progn
+ (setf enemies
+ (typecase enemies
+ (null (accept-with-effective-frame
+ (clim:accepting-values (*query-io* :resynchronize-every-pass t)
+ (setf enemies (clim:accept `(clim:subset-alist ,(iter (for enemy in (contained-enemies-of item))
+ (when (typep (class-of i) 'yadfa-enemies:adoptable-enemy)
+ (collect (cons (name-of enemy) enemy)))))
+ :prompt "Enemies to adopt"
+ :stream *query-io*
+ :view clim:+check-box-view+)))))
+ (type-specifier (iter (for enemy in (contained-enemies-of item))
+ (when (typep i enemies)
+ (collect i))))
+ (list (iter
+ (for enemy in (contained-enemies-of item))
+ (generate current in enemies)
+ (for index upfrom 0)
+ (cond ((typep current '(not unsigned-byte))
+ (error "ENEMIES must be a list of unsigned-bytes"))
+ ((eql index current)
+ (collect enemy)
+ (next current)))))
+ (t (error "ENEMIES must either be a list of unsigned-bytes or a type specifier"))))
+ (alexandria:removef (contained-enemies-of item) enemies
+ :test (lambda (o e)
+ (member e o)))
+ (alexandria:appendf (allies-of *game*) (iter (for i in enemies)
+ (write-line (yadfa-enemies:change-class-text i))
+ (collect (change-class i (get (class-name i) 'yadfa-enemies:change-class-target))))))
+ (format t "No enemies in there to adopt"))))))))
(defmethod use-script ((item enemy-catcher) (user base-character) (target yadfa-enemies:ghost))
(f:fmt t "You failed to catch " (name-of target) #\Newline #\Newline)
(cond ((eq (device-health-of item) t) nil)
@@ -103,8 +103,8 @@
(push target (contained-enemies-of item)))))
(defunassert yadfa-battle-commands:catch-enemy (&optional (target 'yadfa-enemies:catchable-enemy) (item 'enemy-catcher))
- (item type-specifier
- target (or unsigned-byte type-specifier))
+ (item type-specifier
+ target (or unsigned-byte type-specifier))
"Catches an enemy using. @var{ITEM} which is a type specifier. @var{TARGET} is an index or type specifier of an enemy in battle or a type specifier"
(let ((selected-item (find item (inventory-of (player-of *game*))
:test (lambda (type-specifier obj)
@@ -130,13 +130,13 @@
:item selected-item
:selected-target selected-target)))
(defunassert yadfa-world-commands:loot-caught-enemies (&optional item)
- (item (or null unsigned-byte type-specifier))
+ (item (or null unsigned-byte type-specifier))
"Loots the enemies you caught. @var{ITEM} is either a type specifier or an unsiged-byte of the item. Don't specify if you want to loot the enemies of all items"
(cond ((null item)
(iter (for item in (inventory-of *game*))
- (when (typep item 'enemy-catcher)
- (funcall (coerce (action-lambda (getf (special-actions-of item) :take-items)) 'function)
- item (player-of *game*) :action :take-items))))
+ (when (typep item 'enemy-catcher)
+ (funcall (coerce (action-lambda (getf (special-actions-of item) :take-items)) 'function)
+ item (player-of *game*) :action :take-items))))
((typep item 'unsigned-byte)
(let* ((inventory-length (list-length (inventory-of (player-of *game*))))
(selected-item (and (< item inventory-length) (nth item (inventory-of (player-of *game*))))))
diff --git a/data/epilog/puzzle.lisp b/data/epilog/puzzle.lisp
index f065398..e1733ec 100644
--- a/data/epilog/puzzle.lisp
+++ b/data/epilog/puzzle.lisp
@@ -19,55 +19,55 @@
()
(:command-table (game-frame :inherit-from (puzzle-commands)))
(:pane (c:vertically ()
- (c:make-clim-stream-pane :name 'puzzle :incremental-redisplay t :scroll-bars nil
- :display-time :command-loop :display-function 'draw-puzzle :width 800 :height 450)
- (c:make-clim-interactor-pane :name 'int :display-time :command-loop :width 800 :height 150))))
+ (c:make-clim-stream-pane :name 'puzzle :incremental-redisplay t :scroll-bars nil
+ :display-time :command-loop :display-function 'draw-puzzle :width 800 :height 450)
+ (c:make-clim-interactor-pane :name 'int :display-time :command-loop :width 800 :height 150))))
(define-game-frame-command (com-exit-game :name t)
()
(c:frame-exit c:*application-frame*))
(defmethod c:run-frame-top-level ((frame game-frame) &key)
(let ((*patterns* (make-array `(,(cdr *puzzle-size*) ,(cdr *puzzle-size*))
:initial-contents (iter
- (with pw = (car *puzzle-size*))
- (with ps = (cdr *puzzle-size*))
- (with pattern = (mcclim-raster-image:with-output-to-rgba-pattern
- (stream :width pw :height pw)
- (c:draw-rectangle* stream 0 0 pw pw :ink c:+green+)
- (flet ((draw-rosette2 (stream x y radius n &rest drawing-options)
- (loop with alpha = (/ (* 2 pi) n)
- and radius = (/ radius 2)
- for i below n
- do (apply #'clim:draw-circle* stream
- (+ (* radius (cos (* alpha i))) x)
- (+ (* radius (sin (* alpha i))) y)
- radius
- :filled nil
- drawing-options))))
- (draw-rosette2 stream (/ pw 2) (/ pw 2) (/ pw 2) 18
- :ink clim:+steel-blue+ :line-thickness 2))))
- (for y from 0 to (1- ps))
- (collect (iter (for x from 0 to (1- ps))
- (collect (c:make-rectangular-tile
- (c:transform-region (c:make-translation-transformation (* x (- (/ pw ps)))
- (* y (- (/ pw ps))))
- pattern)
- (/ pw ps) (/ pw ps))))))))
+ (with pw = (car *puzzle-size*))
+ (with ps = (cdr *puzzle-size*))
+ (with pattern = (mcclim-raster-image:with-output-to-rgba-pattern
+ (stream :width pw :height pw)
+ (c:draw-rectangle* stream 0 0 pw pw :ink c:+green+)
+ (flet ((draw-rosette2 (stream x y radius n &rest drawing-options)
+ (loop with alpha = (/ (* 2 pi) n)
+ and radius = (/ radius 2)
+ for i below n
+ do (apply #'clim:draw-circle* stream
+ (+ (* radius (cos (* alpha i))) x)
+ (+ (* radius (sin (* alpha i))) y)
+ radius
+ :filled nil
+ drawing-options))))
+ (draw-rosette2 stream (/ pw 2) (/ pw 2) (/ pw 2) 18
+ :ink clim:+steel-blue+ :line-thickness 2))))
+ (for y from 0 to (1- ps))
+ (collect (iter (for x from 0 to (1- ps))
+ (collect (c:make-rectangular-tile
+ (c:transform-region (c:make-translation-transformation (* x (- (/ pw ps)))
+ (* y (- (/ pw ps))))
+ pattern)
+ (/ pw ps) (/ pw ps))))))))
(*puzzle* (make-array `(,(cdr *puzzle-size*) ,(cdr *puzzle-size*))
:element-type 'cons
:initial-contents (iter (with a = (make-array (* (cdr *puzzle-size*) (cdr *puzzle-size*))
:element-type 'cons
:initial-contents (alexandria:shuffle
(iter
- (for y from 0 to (1- (cdr *puzzle-size*)))
- (with i = 0)
- (appending (iter (for x from 0 to (1- (cdr *puzzle-size*)))
- (collect `(,i ,y ,x))
- (incf i)))))))
- (with i = 0)
- (for y from 0 to (1- (cdr *puzzle-size*)))
- (collect (iter (for x from 0 to (1- (cdr *puzzle-size*)))
- (collect (aref a i))
- (incf i))))))
+ (for y from 0 to (1- (cdr *puzzle-size*)))
+ (with i = 0)
+ (appending (iter (for x from 0 to (1- (cdr *puzzle-size*)))
+ (collect `(,i ,y ,x))
+ (incf i)))))))
+ (with i = 0)
+ (for y from 0 to (1- (cdr *puzzle-size*)))
+ (collect (iter (for x from 0 to (1- (cdr *puzzle-size*)))
+ (collect (aref a i))
+ (incf i))))))
(*swap-1* nil)
(*swap-2* nil)
*win*)
@@ -80,7 +80,7 @@
*win*))))
(cc:define-conditional-command (com-end-puzzle :name t)
(game-frame :disable-commands (puzzle-commands))
- ())
+ ())
(c:define-command (com-select-piece :name t :command-table puzzle-commands)
((piece puzzle-piece :prompt "Which Piece?"))
(locally (declare (type list piece))
@@ -98,8 +98,8 @@
(let ((had-accident (process-potty)))
(declare (type cons had-accident))
(cond ((apply '< (iter (for y from 0 to (1- (cdr *puzzle-size*)))
- (appending (iter (for x from 0 to (1- (cdr *puzzle-size*)))
- (collect (car (aref *puzzle* y x)))))))
+ (appending (iter (for x from 0 to (1- (cdr *puzzle-size*)))
+ (collect (car (aref *puzzle* y x)))))))
(setf *win* t)
(cc:change-entity-enabledness 'com-end-puzzle)
(write-line "You completed the puzzle"))
@@ -114,47 +114,47 @@
'("messed")))))))))
(c:define-presentation-to-command-translator select-piece
(puzzle-piece com-select-piece game-frame
- :gesture :select
- :documentation "Select Piece"
- :pointer-documentation "Select Piece")
- (object)
+ :gesture :select
+ :documentation "Select Piece"
+ :pointer-documentation "Select Piece")
+ (object)
(list object))
(defun draw-puzzle (frame pane)
(let* ((pw (car *puzzle-size*))
(ps (cdr *puzzle-size*))
(px (/ pw ps)))
(iter (for y from 0 to (1- ps))
- (iter (for x from 0 to (1- ps))
- (c:updating-output (pane :unique-id `(,x ,y) :id-test 'equal :cache-value (sxhash `(,(aref *puzzle* y x)
- ,(when (equal *swap-1*
- `(,y ,x))
- `(,y ,x))
- ,(when (equal *swap-2*
- `(,y ,x))
- `(,y ,x)))))
- (c:with-output-as-presentation (pane `(,y ,x) 'puzzle-piece)
- (c:draw-design pane (apply #'aref *patterns* (cdr (aref *puzzle* y x)))
- :transformation (let ((translate (c:make-translation-transformation (* x px) (* y px))))
- (if (or (equal *swap-1* `(,y ,x)) (equal *swap-2* `(,y ,x)))
- (c:compose-transformations translate (c:make-scaling-transformation 0.9l0 0.9l0 (c:make-point (/ px 2) (/ px 2))))
- translate)))))))
+ (iter (for x from 0 to (1- ps))
+ (c:updating-output (pane :unique-id `(,x ,y) :id-test 'equal :cache-value (sxhash `(,(aref *puzzle* y x)
+ ,(when (equal *swap-1*
+ `(,y ,x))
+ `(,y ,x))
+ ,(when (equal *swap-2*
+ `(,y ,x))
+ `(,y ,x)))))
+ (c:with-output-as-presentation (pane `(,y ,x) 'puzzle-piece)
+ (c:draw-design pane (apply #'aref *patterns* (cdr (aref *puzzle* y x)))
+ :transformation (let ((translate (c:make-translation-transformation (* x px) (* y px))))
+ (if (or (equal *swap-1* `(,y ,x)) (equal *swap-2* `(,y ,x)))
+ (c:compose-transformations translate (c:make-scaling-transformation 0.9l0 0.9l0 (c:make-point (/ px 2) (/ px 2))))
+ translate)))))))
(setf (c:stream-cursor-position pane) (values 20 pw))
(c:formatting-item-list (pane)
- (c:updating-output (pane :cache-value *win*)
- (typecase *win*
- (null (c:formatting-cell (pane)
- (c:with-output-as-presentation (pane '(com-swap-pieces) `(c:command :command-table ,(c:frame-command-table frame)))
- (c:surrounding-output-with-border
- (pane :shape :rounded :radius 6
- :background c:+gray80+ :highlight-background c:+gray90+)
- (format pane "Swap Pieces")))))
- (t (c:formatting-cell (pane)
- (c:with-output-as-presentation (pane '(com-exit-game) `(c:command :command-table ,(c:frame-command-table frame)))
- (c:surrounding-output-with-border
- (pane :shape :rounded :radius 6
- :background c:+gray80+ :highlight-background c:+gray90+)
- (format pane "Exit Game")))))))
- (c:formatting-cell (pane) (c:present (player-of *game*) (type-of (player-of *game*)) :view +stat-view+ :stream pane)))))
+ (c:updating-output (pane :cache-value *win*)
+ (typecase *win*
+ (null (c:formatting-cell (pane)
+ (c:with-output-as-presentation (pane '(com-swap-pieces) `(c:command :command-table ,(c:frame-command-table frame)))
+ (c:surrounding-output-with-border
+ (pane :shape :rounded :radius 6
+ :background c:+gray80+ :highlight-background c:+gray90+)
+ (format pane "Swap Pieces")))))
+ (t (c:formatting-cell (pane)
+ (c:with-output-as-presentation (pane '(com-exit-game) `(c:command :command-table ,(c:frame-command-table frame)))
+ (c:surrounding-output-with-border
+ (pane :shape :rounded :radius 6
+ :background c:+gray80+ :highlight-background c:+gray90+)
+ (format pane "Exit Game")))))))
+ (c:formatting-cell (pane) (c:present (player-of *game*) (type-of (player-of *game*)) :view +stat-view+ :stream pane)))))
(defun run-game (&key (width 320) (height 5))
(let ((*puzzle-size* `(,width . ,height)))
(c:run-frame-top-level (c:make-application-frame 'game-frame :pretty-name "Puzzle" :width 800 :height 600))))
diff --git a/data/epilog/pyramid.lisp b/data/epilog/pyramid.lisp
index 1df4d22..2635114 100644
--- a/data/epilog/pyramid.lisp
+++ b/data/epilog/pyramid.lisp
@@ -19,45 +19,45 @@
(c:define-command-table puzzle-commands)
(c:define-command-table game-commands)
(serapeum:eval-always
- (in-package :yadfa-pyramid)
- (defclass area ()
- ((north
- :initform nil
- :initarg :north
- :accessor northp)
- (south
- :initform nil
- :initarg :south
- :accessor southp)
- (east
- :initform nil
- :initarg :east
- :accessor eastp)
- (west
- :initform nil
- :initarg :west
- :accessor westp)
- (objects
- :initform nil
- :initarg :objects
- :accessor objects-of)
- (puzzle
- :initform nil
- :initarg :puzzle
- :accessor puzzle-of)))
- (defclass puzzle ()
- ((name
- :initform ""
- :initarg :name
- :accessor name-of)
- (key-of
- :initform nil
- :initarg :key
- :accessor key-of)
- (needed-objects
- :initform nil
- :initarg :needed-objects
- :accessor needed-objects-of))))
+ (in-package :yadfa-pyramid)
+ (defclass area ()
+ ((north
+ :initform nil
+ :initarg :north
+ :accessor northp)
+ (south
+ :initform nil
+ :initarg :south
+ :accessor southp)
+ (east
+ :initform nil
+ :initarg :east
+ :accessor eastp)
+ (west
+ :initform nil
+ :initarg :west
+ :accessor westp)
+ (objects
+ :initform nil
+ :initarg :objects
+ :accessor objects-of)
+ (puzzle
+ :initform nil
+ :initarg :puzzle
+ :accessor puzzle-of)))
+ (defclass puzzle ()
+ ((name
+ :initform ""
+ :initarg :name
+ :accessor name-of)
+ (key-of
+ :initform nil
+ :initarg :key
+ :accessor key-of)
+ (needed-objects
+ :initform nil
+ :initarg :needed-objects
+ :accessor needed-objects-of))))
(defclass object ()
((name
:initform ""
@@ -65,14 +65,14 @@
:accessor name-of)))
(defmethod print-object ((object object) stream)
(print-unreadable-object-with-prefix (object stream :type t)
- (if (slot-boundp object 'name)
- (write (slot-value object 'name) :stream stream)
- (write-string "#<unbound>" stream))))
+ (if (slot-boundp object 'name)
+ (write (slot-value object 'name) :stream stream)
+ (write-string "#<unbound>" stream))))
(defmethod print-object ((object puzzle) stream)
(print-unreadable-object-with-prefix (object stream :type t)
- (if (slot-boundp object 'name)
- (write (slot-value object 'name) :stream stream)
- (write-string "#<unbound>" stream))))
+ (if (slot-boundp object 'name)
+ (write (slot-value object 'name) :stream stream)
+ (write-string "#<unbound>" stream))))
(serapeum:eval-always (c:define-presentation-type object (&optional place)))
(cc:define-conditional-application-frame game-frame
()
@@ -80,15 +80,15 @@
()
(:command-table (game-frame :inherit-from (puzzle-commands game-commands)))
(:pane (c:horizontally ()
- (c:make-clim-stream-pane :name 'maze :incremental-redisplay t :scroll-bars nil
- :display-time :command-loop :display-function 'draw-maze :width 500 :height 600)
- (c:make-clim-interactor-pane :name 'int :display-time :command-loop :width 300 :height 600 :end-of-line-action :wrap*))))
+ (c:make-clim-stream-pane :name 'maze :incremental-redisplay t :scroll-bars nil
+ :display-time :command-loop :display-function 'draw-maze :width 500 :height 600)
+ (c:make-clim-interactor-pane :name 'int :display-time :command-loop :width 300 :height 600 :end-of-line-action :wrap*))))
(c:define-presentation-to-command-translator describe-area
(area climi::com-describe game-frame
- :gesture :select
- :documentation "Describe"
- :pointer-documentation "Describe")
- (object)
+ :gesture :select
+ :documentation "Describe"
+ :pointer-documentation "Describe")
+ (object)
(list object))
(declaim (ftype (function () (values cons &optional)) process-potty))
(defun process-potty ()
@@ -104,7 +104,7 @@
(cc:define-conditional-command (com-end-puzzle :name t)
(game-frame :enable-commands (end-puzzle-commands)
:disable-commands (puzzle-commands))
- ())
+ ())
(define-game-frame-command (com-exit-game :name t)
()
(c:frame-exit c:*application-frame*))
@@ -193,26 +193,26 @@
(defconstant +object-view+ (make-instance 'object-view))
(c:define-presentation-to-command-translator excavate-object
(object com-excavate game-frame
- :tester ((object presentation)
- (when (listp (c:presentation-type presentation))
- (destructuring-bind (object &optional place) (c:presentation-type presentation)
- (declare (ignore object))
- (eq place :area)))))
- (object)
+ :tester ((object presentation)
+ (when (listp (c:presentation-type presentation))
+ (destructuring-bind (object &optional place) (c:presentation-type presentation)
+ (declare (ignore object))
+ (eq place :area)))))
+ (object)
(list object))
(c:define-presentation-to-command-translator place-object
(object com-place game-frame
- :tester ((object presentation)
- (when (listp (c:presentation-type presentation))
- (destructuring-bind (object &optional place) (c:presentation-type presentation)
- (declare (ignore object))
- (eq place :inventory)))))
- (object)
+ :tester ((object presentation)
+ (when (listp (c:presentation-type presentation))
+ (destructuring-bind (object &optional place) (c:presentation-type presentation)
+ (declare (ignore object))
+ (eq place :inventory)))))
+ (object)
(list object))
(c:define-presentation-to-command-translator check-puzzle
(puzzle com-check game-frame
- :tester ((object) object))
- (object)
+ :tester ((object) object))
+ (object)
'())
(c:define-presentation-method c:present (user (type base-character) medium (view stat-view) &key)
(format medium "Name: ~a~%" (name-of user))
@@ -261,8 +261,8 @@
(*potty* '(nil))
(*wear* (list (make-instance 'yadfa-items:cursed-diaper)))
(*positions* (alexandria:shuffle (iter (for x from 0 to (1- *width*))
- (appending (iter (for y from 0 to (1- *height*))
- (collect `(,x ,y))))))))
+ (appending (iter (for y from 0 to (1- *height*))
+ (collect `(,x ,y))))))))
(declare (special *maze* *position* *width* *height* *pattern-cache* *objects* *result* *positions* *finished-puzzles* *wear* *potty*)
(type fixnum *width* *height*)
(type list *position* *positions* *wear* *objects*)
@@ -281,20 +281,20 @@
(labels ((walk (x y width height)
(push (list x y) visited)
(iter (for (u v w) in (alexandria:shuffle (neighbors x y width height)))
- (unless (member (list u v) visited :test #'equal)
- (eval `(setf (,w ,(gethash `(,x ,y) *maze*)) t))
- (eval `(setf (,(getf '(northp southp
- southp northp
- westp eastp
- eastp westp)
- w)
- ,(gethash `(,u ,v) *maze*))
- t))
- (walk u v width height)))))
+ (unless (member (list u v) visited :test #'equal)
+ (eval `(setf (,w ,(gethash `(,x ,y) *maze*)) t))
+ (eval `(setf (,(getf '(northp southp
+ southp northp
+ westp eastp
+ eastp westp)
+ w)
+ ,(gethash `(,u ,v) *maze*))
+ t))
+ (walk u v width height)))))
(walk (random width) (random height) width height))))
(iter (for x from 0 to (1- *width*))
- (iter (for y from 0 to (1- *height*))
- (setf (gethash `(,x ,y) *maze*) (make-instance 'area))))
+ (iter (for y from 0 to (1- *height*))
+ (setf (gethash `(,x ,y) *maze*) (make-instance 'area))))
(remove-wall *width* *height*))
(let ((emblem (make-instance 'object :name "Emblem"))
(puzzle (make-instance 'puzzle :name "Puzzle" :key :puzzle)))
@@ -309,10 +309,10 @@
(defmethod c:default-frame-top-level
((frame game-frame)
&key (command-parser 'c:command-line-command-parser)
- (command-unparser 'c:command-line-command-unparser)
- (partial-command-parser
- 'c:command-line-read-remaining-arguments-for-partial-command)
- (prompt "Command: "))
+ (command-unparser 'c:command-line-command-unparser)
+ (partial-command-parser
+ 'c:command-line-read-remaining-arguments-for-partial-command)
+ (prompt "Command: "))
;; Give each pane a fresh start first time through.
(let ((needs-redisplay t)
(first-time t))
@@ -337,8 +337,8 @@
(restart-case
(flet ((execute-command ()
(alexandria:when-let ((command (c:read-frame-command frame :stream frame-query-io)))
- (setq needs-redisplay t)
- (c:execute-frame-command frame command))))
+ (setq needs-redisplay t)
+ (c:execute-frame-command frame command))))
(when needs-redisplay
(c:redisplay-frame-panes frame :force-p first-time)
(when first-time
@@ -383,9 +383,9 @@
#P"e.xpm"
#P"dot.xpm")))
(iter (for direction in '(eastp westp southp northp))
- (for byte-position upfrom 0)
- (unless (funcall direction (gethash position *maze*))
- (setf (ldb (byte 1 byte-position) b) 1)))
+ (for byte-position upfrom 0)
+ (unless (funcall direction (gethash position *maze*))
+ (setf (ldb (byte 1 byte-position) b) 1)))
(aref array b)))
(pattern-cache (path designs)
(declare (type pathname path)
@@ -399,68 +399,68 @@
:format :xpm
:designs designs)))))
(c:updating-output (pane :unique-id 'map :cache-test 'equal :cache-value (sxhash *position*))
- (iter (for x from 0 to (1- *width*))
- (iter (for y from 0 to (1- *height*))
- (c:updating-output (pane :unique-id `(,x ,y) :id-test 'equal :cache-value (equal *position* `(,x ,y)))
- (c:with-output-as-presentation (pane (gethash `(,x ,y) *maze*) 'area)
- (c:draw-pattern* pane (pattern-cache (bitmap `(,x ,y))
- `(,clim:+background-ink+ ,(clim:make-rgb-color (if (equal `(,x ,y) *position*) 1 0) 0 0)))
- (* x 16) (* y 16)))))))
+ (iter (for x from 0 to (1- *width*))
+ (iter (for y from 0 to (1- *height*))
+ (c:updating-output (pane :unique-id `(,x ,y) :id-test 'equal :cache-value (equal *position* `(,x ,y)))
+ (c:with-output-as-presentation (pane (gethash `(,x ,y) *maze*) 'area)
+ (c:draw-pattern* pane (pattern-cache (bitmap `(,x ,y))
+ `(,clim:+background-ink+ ,(clim:make-rgb-color (if (equal `(,x ,y) *position*) 1 0) 0 0)))
+ (* x 16) (* y 16)))))))
(setf (c:stream-cursor-position pane) (values 0 (* 16 *height*)))
(c:updating-output (pane :unique-id 'inventory :cache-value (sxhash *objects*))
- (c:formatting-table (pane)
- (c:formatting-row (pane)
- (c:formatting-cell (pane) (write-string "Inventory: (" pane))
- (iter (for object in *objects*)
- (c:formatting-cell (pane) (c:present object '(object :inventory) :stream pane)))
- (c:formatting-cell (pane) (write-string ")" pane))))
- (terpri pane))
+ (c:formatting-table (pane)
+ (c:formatting-row (pane)
+ (c:formatting-cell (pane) (write-string "Inventory: (" pane))
+ (iter (for object in *objects*)
+ (c:formatting-cell (pane) (c:present object '(object :inventory) :stream pane)))
+ (c:formatting-cell (pane) (write-string ")" pane))))
+ (terpri pane))
(c:updating-output (pane :unique-id 'objects :cache-value (sxhash (objects-of (gethash *position* *maze*))))
- (c:formatting-table (pane)
- (c:formatting-row (pane)
- (c:formatting-cell (pane) (write-string "Objects: (" pane))
- (iter (for object in (objects-of (gethash *position* *maze*)))
- (c:formatting-cell (pane) (c:present object '(object :area) :stream pane)))
- (c:formatting-cell (pane) (write-string ")" pane))))
- (terpri pane))
+ (c:formatting-table (pane)
+ (c:formatting-row (pane)
+ (c:formatting-cell (pane) (write-string "Objects: (" pane))
+ (iter (for object in (objects-of (gethash *position* *maze*)))
+ (c:formatting-cell (pane) (c:present object '(object :area) :stream pane)))
+ (c:formatting-cell (pane) (write-string ")" pane))))
+ (terpri pane))
(c:updating-output (pane :unique-id 'puzzle :cache-value (puzzle-of (gethash *position* *maze*)))
- (c:formatting-table (pane)
- (c:formatting-row (pane)
- (c:formatting-cell (pane) (write-string "Puzzle: " pane))
- (c:formatting-cell (pane) (c:present (puzzle-of (gethash *position* *maze*)) 'puzzle :stream pane))))
- (terpri pane))
+ (c:formatting-table (pane)
+ (c:formatting-row (pane)
+ (c:formatting-cell (pane) (write-string "Puzzle: " pane))
+ (c:formatting-cell (pane) (c:present (puzzle-of (gethash *position* *maze*)) 'puzzle :stream pane))))
+ (terpri pane))
(c:updating-output (pane :unique-id 'player :cache-value (sxhash `(,(bladder/contents-of (player-of *game*))
,(bowels/contents-of (player-of *game*)))))
- (c:present (player-of *game*) (type-of (player-of *game*)) :view +stat-view+ :stream pane)
- (terpri pane))
+ (c:present (player-of *game*) (type-of (player-of *game*)) :view +stat-view+ :stream pane)
+ (terpri pane))
(c:updating-output (pane :unique-id 'controls :cache-value *result*)
- (typecase *result*
- (null (c:formatting-table (pane)
- (macrolet ((thunk (direction text)
- `(c:with-output-as-presentation (pane '(com-move ,direction) '(c:command :command-table game-frame))
- (c:surrounding-output-with-border
- (pane :shape :rounded :radius 6
- :background c:+gray80+ :highlight-background c:+gray90+)
- (format pane ,text)))))
- (c:formatting-row (pane)
- (c:formatting-cell (pane) pane)
- (c:formatting-cell (pane) (thunk :north "North"))
- (c:formatting-cell (pane) pane))
- (c:formatting-row (pane)
- (c:formatting-cell (pane) (thunk :west "West"))
- (c:formatting-cell (pane) pane)
- (c:formatting-cell (pane) (thunk :east "East")))
- (c:formatting-row (pane)
- (c:formatting-cell (pane) pane)
- (c:formatting-cell (pane) (thunk :south "South"))
- (c:formatting-cell (pane) pane)))))
- (t (c:formatting-table (pane)
- (c:formatting-row (pane)
- (c:formatting-cell (pane)
- (c:with-output-as-presentation (pane '(com-exit-game) '(c:command :command-table game-frame))
- (c:surrounding-output-with-border
- (pane :shape :rounded :radius 6
- :background c:+gray80+ :highlight-background c:+gray90+)
- (format pane "Exit Minigame")))))))))))
+ (typecase *result*
+ (null (c:formatting-table (pane)
+ (macrolet ((thunk (direction text)
+ `(c:with-output-as-presentation (pane '(com-move ,direction) '(c:command :command-table game-frame))
+ (c:surrounding-output-with-border
+ (pane :shape :rounded :radius 6
+ :background c:+gray80+ :highlight-background c:+gray90+)
+ (format pane ,text)))))
+ (c:formatting-row (pane)
+ (c:formatting-cell (pane) pane)
+ (c:formatting-cell (pane) (thunk :north "North"))
+ (c:formatting-cell (pane) pane))
+ (c:formatting-row (pane)
+ (c:formatting-cell (pane) (thunk :west "West"))
+ (c:formatting-cell (pane) pane)
+ (c:formatting-cell (pane) (thunk :east "East")))
+ (c:formatting-row (pane)
+ (c:formatting-cell (pane) pane)
+ (c:formatting-cell (pane) (thunk :south "South"))
+ (c:formatting-cell (pane) pane)))))
+ (t (c:formatting-table (pane)
+ (c:formatting-row (pane)
+ (c:formatting-cell (pane)
+ (c:with-output-as-presentation (pane '(com-exit-game) '(c:command :command-table game-frame))
+ (c:surrounding-output-with-border
+ (pane :shape :rounded :radius 6
+ :background c:+gray80+ :highlight-background c:+gray90+)
+ (format pane "Exit Minigame")))))))))))
(defun run-game ()
(c:run-frame-top-level (c:make-application-frame 'game-frame)))
diff --git a/data/events/bandits-domain.lisp b/data/events/bandits-domain.lisp
index 62e22f7..6d02c79 100644
--- a/data/events/bandits-domain.lisp
+++ b/data/events/bandits-domain.lisp
@@ -113,13 +113,13 @@
(name-of (player-of *game*)) " gets everything the raccoon is carrying except the clothes and diapers the raccoon is wearing. The raccoon then waddles off with his legs spread apart like a 5 year old who didn't make it to the toilet in time." #\Newline #\Newline)
(incf (bitcoins-of (player-of *game*)) (random-from-range 50000 100000))
(iter (for i from 0 to (random 5))
- (push (make-instance 'yadfa-items:gold-bar) (inventory-of (player-of *game*))))
+ (push (make-instance 'yadfa-items:gold-bar) (inventory-of (player-of *game*))))
(iter (for i from 0 to (random 5))
- (push (make-instance 'yadfa-items:gem) (inventory-of (player-of *game*))))
+ (push (make-instance 'yadfa-items:gem) (inventory-of (player-of *game*))))
(iter (for i from 0 to (random 5))
- (push (make-instance 'yadfa-items:bandit-uniform-tunic) (inventory-of (player-of *game*))))
+ (push (make-instance 'yadfa-items:bandit-uniform-tunic) (inventory-of (player-of *game*))))
(iter (for i from 0 to (random 20))
- (push (make-instance 'yadfa-items:bandit-adjustable-diaper) (inventory-of (player-of *game*))))
+ (push (make-instance 'yadfa-items:bandit-adjustable-diaper) (inventory-of (player-of *game*))))
(push (make-instance 'yadfa-items:bandit-swimsuit/closed) (inventory-of (player-of *game*))))
(set-new-battle '((yadfa-enemies:diapered-raccoon-bandit . (list :level (random-from-range 2 5)
:bowels/contents 0
@@ -237,32 +237,32 @@
(name-of (player-of *game*)) ": Mind telling me your names?" #\Newline #\Newline)
(finish-output)
(accept-with-effective-frame (clim:accepting-values (*query-io* :resynchronize-every-pass t :exit-boxes '((:exit "Accept")))
- (fresh-line *query-io*)
- (setf a (make-instance 'yadfa-allies:chris
- :name (clim:accept 'string
- :prompt "Fox Name"
- :default (second
- (assoc :name (progn
- (c2mop:ensure-finalized
- (find-class 'yadfa-allies:chris))
- (c2mop:compute-default-initargs
- (find-class 'yadfa-allies:chris)))))
- :view clim:+text-field-view+
- :stream *query-io*)))
- (fresh-line *query-io*)
- (setf b (make-instance 'yadfa-allies:kristy
- :name (clim:accept 'string
- :prompt "Vixen Name"
- :default (second
- (assoc :name (progn
- (c2mop:ensure-finalized
- (find-class 'yadfa-allies:kristy))
- (c2mop:compute-default-initargs
- (find-class 'yadfa-allies:kristy)))))
- :view clim:+text-field-view+
- :stream *query-io*)))))
+ (fresh-line *query-io*)
+ (setf a (make-instance 'yadfa-allies:chris
+ :name (clim:accept 'string
+ :prompt "Fox Name"
+ :default (second
+ (assoc :name (progn
+ (c2mop:ensure-finalized
+ (find-class 'yadfa-allies:chris))
+ (c2mop:compute-default-initargs
+ (find-class 'yadfa-allies:chris)))))
+ :view clim:+text-field-view+
+ :stream *query-io*)))
+ (fresh-line *query-io*)
+ (setf b (make-instance 'yadfa-allies:kristy
+ :name (clim:accept 'string
+ :prompt "Vixen Name"
+ :default (second
+ (assoc :name (progn
+ (c2mop:ensure-finalized
+ (find-class 'yadfa-allies:kristy))
+ (c2mop:compute-default-initargs
+ (find-class 'yadfa-allies:kristy)))))
+ :view clim:+text-field-view+
+ :stream *query-io*)))))
(iter (for i in (list a b))
- (do-push i (team-of *game*) (allies-of *game*)))
+ (do-push i (team-of *game*) (allies-of *game*)))
(f:fmt t "Fox: I'm " (name-of a) #\Newline #\Newline
"Vixen: And I'm " (name-of b) #\Newline #\Newline
(name-of a) ": What's yours?" #\Newline #\Newline
diff --git a/data/events/lukurbo.lisp b/data/events/lukurbo.lisp
index 99a29cf..32bbd2a 100644
--- a/data/events/lukurbo.lisp
+++ b/data/events/lukurbo.lisp
@@ -15,17 +15,17 @@
(format t "~a: I'm gonna call you ~a *snuggles*~%~%"
(name-of (player-of *game*))
(name-of (accept-with-effective-frame (clim:accepting-values (*query-io* :resynchronize-every-pass t :exit-boxes '((:exit "Accept")))
- (fresh-line *query-io*)
- (let ((a (make-instance 'yadfa-allies:furry
- :name (clim:accept 'string
- :prompt "Fursuiter Name"
- :default (second
- (assoc :name (progn
- (c2mop:ensure-finalized
- (find-class 'yadfa-allies:furry))
- (c2mop:compute-default-initargs
- (find-class 'yadfa-allies:furry)))))
- :view clim:+text-field-view+
- :stream *query-io*))))
- (do-push a (team-of *game*) (allies-of *game*))
- a)))))))
+ (fresh-line *query-io*)
+ (let ((a (make-instance 'yadfa-allies:furry
+ :name (clim:accept 'string
+ :prompt "Fursuiter Name"
+ :default (second
+ (assoc :name (progn
+ (c2mop:ensure-finalized
+ (find-class 'yadfa-allies:furry))
+ (c2mop:compute-default-initargs
+ (find-class 'yadfa-allies:furry)))))
+ :view clim:+text-field-view+
+ :stream *query-io*))))
+ (do-push a (team-of *game*) (allies-of *game*))
+ a)))))))
diff --git a/data/events/pirates-cove.lisp b/data/events/pirates-cove.lisp
index 68e28aa..bb80365 100644
--- a/data/events/pirates-cove.lisp
+++ b/data/events/pirates-cove.lisp
@@ -32,16 +32,16 @@
(name-of (player-of *game*)) ": got a name?" #\Newline #\Newline)
(finish-output)
(accept-with-effective-frame
- (clim:accepting-values (*query-io* :resynchronize-every-pass t :exit-boxes '((:exit "Accept")))
- (setf coon (clim:accept 'string :stream *query-io* :prompt "Raccoon Name"
- :default #.(second
- (assoc :name
- (progn
- (c2mop:ensure-finalized
- (find-class 'yadfa-allies:slynk))
- (c2mop:compute-default-initargs
- (find-class 'yadfa-allies:slynk)))))
- :view clim:+text-field-view+))))
+ (clim:accepting-values (*query-io* :resynchronize-every-pass t :exit-boxes '((:exit "Accept")))
+ (setf coon (clim:accept 'string :stream *query-io* :prompt "Raccoon Name"
+ :default #.(second
+ (assoc :name
+ (progn
+ (c2mop:ensure-finalized
+ (find-class 'yadfa-allies:slynk))
+ (c2mop:compute-default-initargs
+ (find-class 'yadfa-allies:slynk)))))
+ :view clim:+text-field-view+))))
(f:fmt t "Raccoon: It's " (name-of coon) #\Newline #\Newline
(name-of coon) " decides you can't be all bad since you're the first one to be nice to him (plus the Raccoon Bandits abandoned him) and decides to join your team" #\Newline #\Newline)
(do-push coon (team-of *game*) (allies-of *game*))
diff --git a/data/events/pyramid.lisp b/data/events/pyramid.lisp
index e2c4dea..fa189ba 100644
--- a/data/events/pyramid.lisp
+++ b/data/events/pyramid.lisp
@@ -16,8 +16,8 @@
(bladder/contents-of (player-of *game*)))
(bladder/fill-rate-of (player-of *game*))))
(bowels-time (/ (- (bowels/need-to-potty-limit-of (player-of *game*))
- (bowels/contents-of (player-of *game*)))
- (bowels/fill-rate-of (player-of *game*))))
+ (bowels/contents-of (player-of *game*)))
+ (bowels/fill-rate-of (player-of *game*))))
(flood-or-mess (cond ((and (> (bowels/contents-of (player-of *game*)) (bowels/need-to-potty-limit-of (player-of *game*)))
(> (bladder/contents-of (player-of *game*)) (bladder/need-to-potty-limit-of (player-of *game*))))
'both)
@@ -29,8 +29,8 @@
((< bladder-time bowels-time) 'bladder-fill)
(t 'bowels-fill)))
(diapers (find wear '(yadfa-items:cursed-diaper yadfa-items:temple-pullups)
- :test (lambda (o e)
- (filter-items o e)))))
+ :test (lambda (o e)
+ (filter-items o e)))))
(unless result
(format t "~a~a, You give up ~a your ~a~%"
(case diapers
@@ -63,13 +63,13 @@
(change-class (first (wear-of (player-of *game*))) 'yadfa-items:temple-diaper)
(apply 'reinitialize-instance (first (wear-of (player-of *game*)))
(iter (for slot in (c2mop:compute-slots (find-class 'yadfa-items:temple-diaper)))
- (collect (car (c2mop:slot-definition-initargs slot)))
- (collect (funcall (c2mop:slot-definition-initfunction slot))))))
+ (collect (car (c2mop:slot-definition-initargs slot)))
+ (collect (funcall (c2mop:slot-definition-initfunction slot))))))
(t (format t "Your pullup glows and transforms into a thick diaper with a Ankh on the front. According to the hieroglyphics, this is the infinity diaper, famous for never leaking at all.")
(change-class (first (wear-of (player-of *game*))) 'yadfa-items:infinity-diaper)
(apply 'reinitialize-instance (first (wear-of (player-of *game*)))
(iter (for slot in (c2mop:compute-slots (find-class 'yadfa-items:infinity-diaper)))
- (collect (car (c2mop:slot-definition-initargs slot)))
- (collect (funcall (c2mop:slot-definition-initfunction slot)))))
+ (collect (car (c2mop:slot-definition-initargs slot)))
+ (collect (funcall (c2mop:slot-definition-initfunction slot)))))
(trigger-event 'infinity-diaper-obtained-1))))))))
:repeatable t)
diff --git a/data/items/clothes.lisp b/data/items/clothes.lisp
index f16e0b3..19a4888 100644
--- a/data/items/clothes.lisp
+++ b/data/items/clothes.lisp
@@ -381,5 +381,5 @@
10 "Well it's not noticeable"
0 "It's clean")
:wear-mess-text '(400 "There's a big lump on the back of your seat"
- 10 "Well it's not noticeable"
- 0 "It's clean")))
+ 10 "Well it's not noticeable"
+ 0 "It's clean")))
diff --git a/data/items/consumable.lisp b/data/items/consumable.lisp
index cee09c3..44307a2 100644
--- a/data/items/consumable.lisp
+++ b/data/items/consumable.lisp
@@ -29,7 +29,7 @@
" type" #\Newline)))
(setf (element-types-of target) new)
(iter (for i in difference)
- (format-type i)))
+ (format-type i)))
(f:fmt t "It had no effect on " (name-of target) #\Newline))))
(defclass antimutagen (consumable)
((element-types :initarg :element-types :accessor element-types-of)))
@@ -48,7 +48,7 @@
" type" #\Newline)))
(setf (element-types-of target) new)
(iter (for i in difference)
- (format-type i)))
+ (format-type i)))
(f:fmt t "It had no effect on " (name-of target) #\Newline))))
(defclass monster-energy-drink (consumable) ()
(:default-initargs
@@ -154,4 +154,4 @@
(iter (for i in (if (typep target 'team-member)
(enemies-of *battle*)
(team-of *game*)))
- (decf (health-of i) 120)))
+ (decf (health-of i) 120)))
diff --git a/data/items/diaper.lisp b/data/items/diaper.lisp
index 6d47285..620e3dc 100644
--- a/data/items/diaper.lisp
+++ b/data/items/diaper.lisp
@@ -45,7 +45,7 @@
(defmethod use-script ((item diaper-package-mixin) (user base-character) (target base-character))
(format t "You tear open the package and dump all the diapers out of it.~%")
(iter (for i from 1 to 20)
- (push (make-instance (slot-value item 'diaper)) (inventory-of target))))
+ (push (make-instance (slot-value item 'diaper)) (inventory-of target))))
(defclass generic-diapers (yadfa:diaper undies) ()
(:default-initargs
:sogginess-capacity 100
@@ -214,21 +214,21 @@
(calculate-gems (amount)
(declare (type fixnum amount))
(iter (for (the simple-string color) in '("magneta" "yellow" "purple" "green" "red"))
- (for (the fixnum value) in '(25 10 5 2 1))
- (with (the fixnum ret) = 0)
- (setf ret (iter (with (the fixnum ret) = 0)
- (while (>= amount value))
- (incf ret)
- (decf amount value)
- (finally (return ret))))
- (when (> ret 0)
- (collect (list color ret)))))
+ (for (the fixnum value) in '(25 10 5 2 1))
+ (with (the fixnum ret) = 0)
+ (setf ret (iter (with (the fixnum ret) = 0)
+ (while (>= amount value))
+ (incf ret)
+ (decf amount value)
+ (finally (return ret))))
+ (when (> ret 0)
+ (collect (list color ret)))))
(text-length (text)
(s:nlet rec ((count 0)
(text text))
- (if (>= count 2)
- count
- (rec (1+ count) (cdr text))))))
+ (if (>= count 2)
+ count
+ (rec (1+ count) (cdr text))))))
(let* ((text (calculate-gems count))
(text-length (text-length text)))
(declare (type list text))
@@ -236,11 +236,11 @@
(2
(:fmt (:join (", " ", and ")
(iter (for i in text)
- (collect (format-pair i))))))
+ (collect (format-pair i))))))
(1
(:fmt (:join " and "
(iter (for i in text)
- (collect (format-pair i))))))
+ (collect (format-pair i))))))
(0
(:fmt (format-pair (car text))))))))))
(defmethod describe-diaper-wear-usage ((item gem-diaper))
diff --git a/data/items/weapons.lisp b/data/items/weapons.lisp
index 4b3b8cd..b375c0a 100644
--- a/data/items/weapons.lisp
+++ b/data/items/weapons.lisp
@@ -6,7 +6,7 @@
(defmethod use-script ((item ammo-box-mixin) (user base-character) (target base-character))
(f:fmt t (name-of user) " open the box and dump all the ammunition out of it." #\Newline)
(iter (for i from 1 to 6)
- (push (make-instance (slot-value item 'ammo)) (inventory-of target))))
+ (push (make-instance (slot-value item 'ammo)) (inventory-of target))))
(defclass 7.62×39mm (ammo) ()
(:default-initargs
:name "7.62x39mm Rounds"
diff --git a/data/map/bandits-domain.lisp b/data/map/bandits-domain.lisp
index 941009d..fd62cb2 100644
--- a/data/map/bandits-domain.lisp
+++ b/data/map/bandits-domain.lisp
@@ -2,207 +2,207 @@
(in-package :yadfa-zones)
#.`(progn
,@(iter (for i from 10 to 20)
- (collect
- `(ensure-zone (0 ,i 0 bandits-domain)
- :name "Bandit's Way"
- :description "A path filled with bandits"
- :enter-text "You follow the path"
- :warp-points ,(when (= i 10) '(list 'ironside '(2 0 0 ironside)))
- :enemy-spawn-list 'bandits-way)))
+ (collect
+ `(ensure-zone (0 ,i 0 bandits-domain)
+ :name "Bandit's Way"
+ :description "A path filled with bandits"
+ :enter-text "You follow the path"
+ :warp-points ,(when (= i 10) '(list 'ironside '(2 0 0 ironside)))
+ :enemy-spawn-list 'bandits-way)))
,@(iter (for i from -1 downto -10)
- (collect
- `(ensure-zone (,i 21 0 bandits-domain)
- :name "Bandit's Town"
- :description "A town run by the Raccoon Bandits"
- :enter-text "You're wander around Bandit's Town"
- ,@(when (= i -3)
- '(:events '(yadfa-events:enter-bandits-shop-2)))))))
+ (collect
+ `(ensure-zone (,i 21 0 bandits-domain)
+ :name "Bandit's Town"
+ :description "A town run by the Raccoon Bandits"
+ :enter-text "You're wander around Bandit's Town"
+ ,@(when (= i -3)
+ '(:events '(yadfa-events:enter-bandits-shop-2)))))))
(ensure-zone (-3 22 0 bandits-domain)
- :name "Bandit's Shop"
- :description "A local shop"
- :enter-text "You enter the Bandit's Shop"
- :must-wear (cons 'padding '(lambda (user)
- (declare (ignore user))
- (write-line "That area is a diapers only pants free zone. Pants are strictly prohibited and padding is mandatory.")
- nil))
- :must-wear* (cons 'padding '(lambda (user)
- (declare (ignore user))
- (write-line "This area is a diapers only pants free zone. Pants are strictly prohibited and padding is mandatory.")
- nil))
- :must-not-wear (cons '(and closed-bottoms (not incontinence-product))
- '(lambda (user)
- (declare (ignore user))
- (write-line "That area is a diapers only pants free zone. Pants are strictly prohibited and padding is mandatory.")
- nil))
- :must-not-wear* (cons '(and closed-bottoms (not incontinence-product))
- '(lambda (user)
- (declare (ignore user))
- (write-line "This area is a diapers only pants free zone. Pants are strictly prohibited and padding is mandatory.")
- nil))
- :can-potty '(lambda
- (prop &key wet mess pants-down user)
- (declare (ignorable prop wet mess pants-down user))
- (not (when (or pants-down (not (filter-items (wear-of user) 'closed-bottoms)))
- (format t "*The shopkeeper baps ~a on the nose with a newspaper before ~a gets the chance to go*~%" (name-of user) (name-of user))
- (format t "Shopkeeper: Bad ~a, no going potty inside~%" (species-of user))
- (when (or (>= (bladder/contents-of user) (bladder/potty-dance-limit-of user))
- (>= (bowels/contents-of user) (bowels/potty-dance-limit-of user))))
- (format t "*~a whines and continues ~a embarrassing potty dance while the shopkeeper watches in amusement*~%~%"
- (name-of user)
- (if (malep user)
- "his"
- "her"))
- t)))
- :potty-trigger '(lambda (had-accident user)
- (block nil
- (when (not (filter-items (wear-of user) 'incontinence-product))
- (format t "*The shopkeeper baps ~a on the nose with a newspaper*~%" (name-of user))
- (format t "Shopkeeper: Bad ~a, no going potty inside~%" (species-of user)))
- (when (or (getf (car had-accident) :popped)
- (getf (cdr had-accident) :popped))
- (write-string #.(with-output-to-string (s)
- (format s "*The shopkeeper falls over laughing with his diaper clearly exposed from under his tunic, then gets an embarrassed look on his face when he floods his diaper from the laughter, which is incredibly obvious from the wetness indicator changing color*~%~%")
- (format s "*A random raccoon in the shop records the shopkeeper flooding his pamps then uploads it to the internet*~%~%")))
- (trigger-event 'yadfa-events:shopkeeper-floods-himself-1))
- (when (> (getf (car had-accident) :leak-amount) 0)
- (format t "*The shopkeeper laughs at ~a's misfortune*~%" (name-of user))
- (return))
- (when (> (getf (cdr had-accident) :leak-amount) 0)
- (format t "Shopkeeper: Bad ~a!!! No going potty on the floor!!!~%~%" (name-of user))
- (apply #'format t "*The Shopkeeper spanks ~a through ~a messy diaper and makes ~a sit in it in timeout*~%"
- (name-of user)
- (if (malep user)
- '("his" "him")
- '("her" "her")))
- (return))
- (when (> (getf (car had-accident) :wet-amount) 0)
- (format t "Shopkeeper: Aww, is ~a using ~a diapers like a baby?~%"
- (name-of user)
- (if (malep user)
- "his"
- "her"))
- (return))
- (when (> (getf (cdr had-accident) :mess-amount) 0)
- (format t "Shopkeeper: Looks like ~a made a stinky!!!~%~%" (name-of user))
- (format t "*The Shopkeeper mushes ~a's messy diaper who quickly jerks away and then grabs the back of ~a diaper struggling to unmush it*~%"
- (name-of user)
- (if (malep user)
- "his"
- "her"))
- (return))))
- :props (list :shop (make-instance 'yadfa-props:shop
- :actions (list :ask-for-bathroom
- (make-action :documentation "Ask the raccoons if you can use the bathroom."
- :lambda '(lambda
- (prop &rest keys &key &allow-other-keys)
- (declare (ignore prop keys))
- (write-string #.(with-output-to-string (s)
- (format s "Diapered Raccoon Bandit Shop Owner: Sorry, only I'm allowed in there. Everyone else can just use their diapers. Isn't that right mushbutt?~%~%")
- (format s "*The Shop Owner slaps the back of the Rookie's diaper*~%~%")
- (format s "*Rookie yelps then grabs the back of his diaper and struggles to unmush it*~%~%")
- (format s "*The Shop Owner laughs*~%~%")
- (format s "Rookie Raccoon: Can I please get a diaper change now?~%~%")
- (format s "Shop Owner: Keep asking me that and I'll make you sit in it in timeout again.~%~%")
- (format s "Rookie Raccoon: NO! PLEASE! I'LL BE GOOD!~%~%")))))
- :ask-why-youre-allowed-to-shop (make-action :documentation "Ask the raccoons why you're allowed to shop here without the gang attacking you"
- :lambda '(lambda
- (prop &rest keys &key &allow-other-keys)
- (declare (ignore prop keys))
- (format t "~a: You know how the gang seems to attack me everywhere I show up?~%~%"
- (name-of (player-of *game*)))
- (format t "Shop Owner: Yeah?~%~%")
- (format t "~a: Well how come they're letting me shop here without attacking me?~%~%"
- (name-of (player-of *game*)))
- (format t "Shop Owner: Because money, stupid.")))
- :ask-what-they-do-with-sold-items (make-action :documentation "Ask the raccoons what they do with the random crap you sell them"
- :lambda '(lambda (prop &rest keys &key &allow-other-keys)
- (declare (ignore prop keys))
- (format t "~a: So what the hell do you do with all the random crap we sell you~%~%"
- (name-of (player-of *game*)))
- (format t "Shop Owner: We dump it all on ~a's garbage collector. Yes, I know, buying all this crap only to throw it out is dumb. Blame Pouar for designing it this way." (lisp-implementation-type))))
- :ask-why-this-shop-exists (make-action :documentation "Ask the raccoons why they need to sell items for profit instead of just stealing everything."
- :lambda '(lambda (prop &rest keys &key &allow-other-keys)
- (declare (ignore prop keys))
- (format t "~a: So why do you even need this shop? Why not just steal everything?~%~%"
- (name-of (player-of *game*)))
- (write-line "Shop Owner: In case you haven't noticed, being stealthy enough to steal everything isn't all that easy when your diaper crinkles with each and every step you take. *crinkles and blushes*"))))
- :items-for-sale '((yadfa-items:gold-pacifier)
- (yadfa-items:recovering-pacifier)
- (yadfa-items:healing-pacifier)
- (yadfa-items:bandit-swimsuit)
- (yadfa-items:bandit-uniform-tunic)
- (yadfa-items:bandit-uniform-shirt)
- (yadfa-items:bandit-uniform-sports-bikini-top)
- (yadfa-items:monster-energy-drink)
- (yadfa-items:spiked-bottle-of-milk)
- (yadfa-items:bandit-diaper)
- (yadfa-items:bandit-adjustable-diaper)
- (yadfa-items:bandit-female-diaper)
- (yadfa-items:bandit-swim-diaper-cover)
- (yadfa-items:lower-bandit-swim-diaper-cover)
- (yadfa-items:female-bandit-swim-diaper-cover)
- (yadfa-items:gold-collar)
- (yadfa-items:ak47)
- (yadfa-items:box-of-7.62×39mm)
- (yadfa-items:pink-sword)
- (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))
- :events '(yadfa-events:enter-bandits-shop-1 yadfa-events:obtain-diaper-lock-1 yadfa-events:enter-bandits-shop-3 yadfa-events:get-warp-pipe-summoner-1))
+ :name "Bandit's Shop"
+ :description "A local shop"
+ :enter-text "You enter the Bandit's Shop"
+ :must-wear (cons 'padding '(lambda (user)
+ (declare (ignore user))
+ (write-line "That area is a diapers only pants free zone. Pants are strictly prohibited and padding is mandatory.")
+ nil))
+ :must-wear* (cons 'padding '(lambda (user)
+ (declare (ignore user))
+ (write-line "This area is a diapers only pants free zone. Pants are strictly prohibited and padding is mandatory.")
+ nil))
+ :must-not-wear (cons '(and closed-bottoms (not incontinence-product))
+ '(lambda (user)
+ (declare (ignore user))
+ (write-line "That area is a diapers only pants free zone. Pants are strictly prohibited and padding is mandatory.")
+ nil))
+ :must-not-wear* (cons '(and closed-bottoms (not incontinence-product))
+ '(lambda (user)
+ (declare (ignore user))
+ (write-line "This area is a diapers only pants free zone. Pants are strictly prohibited and padding is mandatory.")
+ nil))
+ :can-potty '(lambda
+ (prop &key wet mess pants-down user)
+ (declare (ignorable prop wet mess pants-down user))
+ (not (when (or pants-down (not (filter-items (wear-of user) 'closed-bottoms)))
+ (format t "*The shopkeeper baps ~a on the nose with a newspaper before ~a gets the chance to go*~%" (name-of user) (name-of user))
+ (format t "Shopkeeper: Bad ~a, no going potty inside~%" (species-of user))
+ (when (or (>= (bladder/contents-of user) (bladder/potty-dance-limit-of user))
+ (>= (bowels/contents-of user) (bowels/potty-dance-limit-of user))))
+ (format t "*~a whines and continues ~a embarrassing potty dance while the shopkeeper watches in amusement*~%~%"
+ (name-of user)
+ (if (malep user)
+ "his"
+ "her"))
+ t)))
+ :potty-trigger '(lambda (had-accident user)
+ (block nil
+ (when (not (filter-items (wear-of user) 'incontinence-product))
+ (format t "*The shopkeeper baps ~a on the nose with a newspaper*~%" (name-of user))
+ (format t "Shopkeeper: Bad ~a, no going potty inside~%" (species-of user)))
+ (when (or (getf (car had-accident) :popped)
+ (getf (cdr had-accident) :popped))
+ (write-string #.(with-output-to-string (s)
+ (format s "*The shopkeeper falls over laughing with his diaper clearly exposed from under his tunic, then gets an embarrassed look on his face when he floods his diaper from the laughter, which is incredibly obvious from the wetness indicator changing color*~%~%")
+ (format s "*A random raccoon in the shop records the shopkeeper flooding his pamps then uploads it to the internet*~%~%")))
+ (trigger-event 'yadfa-events:shopkeeper-floods-himself-1))
+ (when (> (getf (car had-accident) :leak-amount) 0)
+ (format t "*The shopkeeper laughs at ~a's misfortune*~%" (name-of user))
+ (return))
+ (when (> (getf (cdr had-accident) :leak-amount) 0)
+ (format t "Shopkeeper: Bad ~a!!! No going potty on the floor!!!~%~%" (name-of user))
+ (apply #'format t "*The Shopkeeper spanks ~a through ~a messy diaper and makes ~a sit in it in timeout*~%"
+ (name-of user)
+ (if (malep user)
+ '("his" "him")
+ '("her" "her")))
+ (return))
+ (when (> (getf (car had-accident) :wet-amount) 0)
+ (format t "Shopkeeper: Aww, is ~a using ~a diapers like a baby?~%"
+ (name-of user)
+ (if (malep user)
+ "his"
+ "her"))
+ (return))
+ (when (> (getf (cdr had-accident) :mess-amount) 0)
+ (format t "Shopkeeper: Looks like ~a made a stinky!!!~%~%" (name-of user))
+ (format t "*The Shopkeeper mushes ~a's messy diaper who quickly jerks away and then grabs the back of ~a diaper struggling to unmush it*~%"
+ (name-of user)
+ (if (malep user)
+ "his"
+ "her"))
+ (return))))
+ :props (list :shop (make-instance 'yadfa-props:shop
+ :actions (list :ask-for-bathroom
+ (make-action :documentation "Ask the raccoons if you can use the bathroom."
+ :lambda '(lambda
+ (prop &rest keys &key &allow-other-keys)
+ (declare (ignore prop keys))
+ (write-string #.(with-output-to-string (s)
+ (format s "Diapered Raccoon Bandit Shop Owner: Sorry, only I'm allowed in there. Everyone else can just use their diapers. Isn't that right mushbutt?~%~%")
+ (format s "*The Shop Owner slaps the back of the Rookie's diaper*~%~%")
+ (format s "*Rookie yelps then grabs the back of his diaper and struggles to unmush it*~%~%")
+ (format s "*The Shop Owner laughs*~%~%")
+ (format s "Rookie Raccoon: Can I please get a diaper change now?~%~%")
+ (format s "Shop Owner: Keep asking me that and I'll make you sit in it in timeout again.~%~%")
+ (format s "Rookie Raccoon: NO! PLEASE! I'LL BE GOOD!~%~%")))))
+ :ask-why-youre-allowed-to-shop (make-action :documentation "Ask the raccoons why you're allowed to shop here without the gang attacking you"
+ :lambda '(lambda
+ (prop &rest keys &key &allow-other-keys)
+ (declare (ignore prop keys))
+ (format t "~a: You know how the gang seems to attack me everywhere I show up?~%~%"
+ (name-of (player-of *game*)))
+ (format t "Shop Owner: Yeah?~%~%")
+ (format t "~a: Well how come they're letting me shop here without attacking me?~%~%"
+ (name-of (player-of *game*)))
+ (format t "Shop Owner: Because money, stupid.")))
+ :ask-what-they-do-with-sold-items (make-action :documentation "Ask the raccoons what they do with the random crap you sell them"
+ :lambda '(lambda (prop &rest keys &key &allow-other-keys)
+ (declare (ignore prop keys))
+ (format t "~a: So what the hell do you do with all the random crap we sell you~%~%"
+ (name-of (player-of *game*)))
+ (format t "Shop Owner: We dump it all on ~a's garbage collector. Yes, I know, buying all this crap only to throw it out is dumb. Blame Pouar for designing it this way." (lisp-implementation-type))))
+ :ask-why-this-shop-exists (make-action :documentation "Ask the raccoons why they need to sell items for profit instead of just stealing everything."
+ :lambda '(lambda (prop &rest keys &key &allow-other-keys)
+ (declare (ignore prop keys))
+ (format t "~a: So why do you even need this shop? Why not just steal everything?~%~%"
+ (name-of (player-of *game*)))
+ (write-line "Shop Owner: In case you haven't noticed, being stealthy enough to steal everything isn't all that easy when your diaper crinkles with each and every step you take. *crinkles and blushes*"))))
+ :items-for-sale '((yadfa-items:gold-pacifier)
+ (yadfa-items:recovering-pacifier)
+ (yadfa-items:healing-pacifier)
+ (yadfa-items:bandit-swimsuit)
+ (yadfa-items:bandit-uniform-tunic)
+ (yadfa-items:bandit-uniform-shirt)
+ (yadfa-items:bandit-uniform-sports-bikini-top)
+ (yadfa-items:monster-energy-drink)
+ (yadfa-items:spiked-bottle-of-milk)
+ (yadfa-items:bandit-diaper)
+ (yadfa-items:bandit-adjustable-diaper)
+ (yadfa-items:bandit-female-diaper)
+ (yadfa-items:bandit-swim-diaper-cover)
+ (yadfa-items:lower-bandit-swim-diaper-cover)
+ (yadfa-items:female-bandit-swim-diaper-cover)
+ (yadfa-items:gold-collar)
+ (yadfa-items:ak47)
+ (yadfa-items:box-of-7.62×39mm)
+ (yadfa-items:pink-sword)
+ (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))
+ :events '(yadfa-events:enter-bandits-shop-1 yadfa-events:obtain-diaper-lock-1 yadfa-events:enter-bandits-shop-3 yadfa-events:get-warp-pipe-summoner-1))
(ensure-zone (-3 23 0 bandits-domain)
- :name "Bandit's Shop Bathroom"
- :description "CLOSED FOREVER!!!!! MUAHAHAHAHA!!!!"
- :locked t)
+ :name "Bandit's Shop Bathroom"
+ :description "CLOSED FOREVER!!!!! MUAHAHAHAHA!!!!"
+ :locked t)
(ensure-zone (-5 22 0 bandits-domain)
- :name "Bandit's Kennel"
- :description "A grungy looking kennel where the Raccoon Bandits keep their “pets”. Neglected so much that they literally forgot about their existence"
- :enter-text "You enter the kennel"
- :events '(yadfa-events:enter-bandits-kennel-1))
+ :name "Bandit's Kennel"
+ :description "A grungy looking kennel where the Raccoon Bandits keep their “pets”. Neglected so much that they literally forgot about their existence"
+ :enter-text "You enter the kennel"
+ :events '(yadfa-events:enter-bandits-kennel-1))
(ensure-zone (0 21 0 bandits-domain)
- :name "Bandit's Town Entrance"
- :description "The entrance to Bandit Town"
- :enter-text "You're at the entrance of Bandit Town"
- :warp-points (list 'home '(0 1 0 home))
- :events '(yadfa-events:enter-bandits-village-1))
+ :name "Bandit's Town Entrance"
+ :description "The entrance to Bandit Town"
+ :enter-text "You're at the entrance of Bandit Town"
+ :warp-points (list 'home '(0 1 0 home))
+ :events '(yadfa-events:enter-bandits-village-1))
#.`(progn
,@(iter (for i from 22 to 30)
- (collect
- `(ensure-zone (0 ,i 0 bandits-domain)
- :name "Bandit's Town"
- :description "A town run by the Raccoon Bandits"
- :enter-text "You're wander around Bandit's Town"))))
+ (collect
+ `(ensure-zone (0 ,i 0 bandits-domain)
+ :name "Bandit's Town"
+ :description "A town run by the Raccoon Bandits"
+ :enter-text "You're wander around Bandit's Town"))))
(ensure-zone (0 31 0 bandits-domain)
- :name "Bandit's Town"
- :description "A town run by the Raccoon Bandits"
- :enter-text "You see a sign that says \"To the south lies your generic RPG Maker Dungeon. Get ready for a mediocre adventure!!!! OOOOOOOOO!!!!"
- :warp-points (list 'rpgmaker-dungeon '(5 9 0 rpgmaker-dungeon))
- :hidden t
- :events '(yadfa-events:secret-underground-pipe-rpgmaker-dungeon))
+ :name "Bandit's Town"
+ :description "A town run by the Raccoon Bandits"
+ :enter-text "You see a sign that says \"To the south lies your generic RPG Maker Dungeon. Get ready for a mediocre adventure!!!! OOOOOOOOO!!!!"
+ :warp-points (list 'rpgmaker-dungeon '(5 9 0 rpgmaker-dungeon))
+ :hidden t
+ :events '(yadfa-events:secret-underground-pipe-rpgmaker-dungeon))
(ensure-zone (1 21 0 bandits-domain)
- :name "Bandit's Cove Dock"
- :description "The dock of Bandit's Cove"
- :enter-text "You're at a dock")
+ :name "Bandit's Cove Dock"
+ :description "The dock of Bandit's Cove"
+ :enter-text "You're at a dock")
#.`(progn
,@(let ((a ()))
(iter (for y from 19 to 23)
- (alexandria:appendf a (iter (for x from 2 to 6)
- (collect `(ensure-zone (,x ,y 0 bandits-domain)
- :name "Bandit's Cove"
- :description "A cove filled with bandits"
- :enter-text "You're at a cove run by bandits"
- :enemy-spawn-list 'bandits-cove)))))
+ (alexandria:appendf a (iter (for x from 2 to 6)
+ (collect `(ensure-zone (,x ,y 0 bandits-domain)
+ :name "Bandit's Cove"
+ :description "A cove filled with bandits"
+ :enter-text "You're at a cove run by bandits"
+ :enemy-spawn-list 'bandits-cove)))))
a))
(ensure-zone (6 24 0 bandits-domain)
- :name "Bandit's Cave Entrance"
- :description "A mysterious cave"
- :enter-text "You enter the cave"
- :warp-points (list 'descend '(6 24 -2 bandits-domain)))
+ :name "Bandit's Cave Entrance"
+ :description "A mysterious cave"
+ :enter-text "You enter the cave"
+ :warp-points (list 'descend '(6 24 -2 bandits-domain)))
(ensure-zone (6 24 -2 bandits-domain)
- :name "Bandit's Cave"
- :description "A mysterious cave"
- :enter-text "You enter the cave"
- :warp-points (list 'cave-entrance '(6 24 0 bandits-domain)
- 'descend '(6 24 -2 bandits-domain))
- :events '(yadfa-events:decend-bandits-cave-1))
+ :name "Bandit's Cave"
+ :description "A mysterious cave"
+ :enter-text "You enter the cave"
+ :warp-points (list 'cave-entrance '(6 24 0 bandits-domain)
+ 'descend '(6 24 -2 bandits-domain))
+ :events '(yadfa-events:decend-bandits-cave-1))
diff --git a/data/map/debug-map.lisp b/data/map/debug-map.lisp
index 34707e8..01ba5d9 100644
--- a/data/map/debug-map.lisp
+++ b/data/map/debug-map.lisp
@@ -1,59 +1,59 @@
;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa-zones"; coding: utf-8-unix; -*-
(in-package :yadfa-zones)
(ensure-zone (0 0 0 debug-map)
- :name "zone-0-0-0-debug-map"
- :description "zone-0-0-0-debug-map"
- :enter-text "zone-0-0-0-debug-map"
- :warp-points (list '\1 '(1 1 0 debug-map) '\2 '(0 -1 -1 debug-map))
- :stairs (list :down)
- :props (list :dresser (make-instance 'prop
- :name "Dresser"
- :description "A dresser"
- :placeable t
- :items (nconc (iter (for i from 1 to 20)
- (collect (make-instance 'yadfa-items:diaper)))
- (iter (for i from 1 to 20)
- (collect (make-instance 'yadfa-items:pullups)))
- (iter (for i from 1 to 5)
- (collect (make-instance 'yadfa-items:thick-rubber-diaper)))
- (list (make-instance 'yadfa-items:sundress)
- (make-instance 'yadfa-items:toddler-dress)
- (make-instance 'yadfa-items:rubber-onesie))))
- :toilet (make-instance 'yadfa-props:toilet)
- :bed (make-instance 'yadfa-props:bed)
- :shop (make-instance 'yadfa-props:debug-shop
- :actions (list :talk (make-action :documentation "Say hi"
- :lambda '(lambda
- (prop &rest keys &key &allow-other-keys)
- (declare (ignore prop keys))
- (format t "Hello World~%")))))))
+ :name "zone-0-0-0-debug-map"
+ :description "zone-0-0-0-debug-map"
+ :enter-text "zone-0-0-0-debug-map"
+ :warp-points (list '\1 '(1 1 0 debug-map) '\2 '(0 -1 -1 debug-map))
+ :stairs (list :down)
+ :props (list :dresser (make-instance 'prop
+ :name "Dresser"
+ :description "A dresser"
+ :placeable t
+ :items (nconc (iter (for i from 1 to 20)
+ (collect (make-instance 'yadfa-items:diaper)))
+ (iter (for i from 1 to 20)
+ (collect (make-instance 'yadfa-items:pullups)))
+ (iter (for i from 1 to 5)
+ (collect (make-instance 'yadfa-items:thick-rubber-diaper)))
+ (list (make-instance 'yadfa-items:sundress)
+ (make-instance 'yadfa-items:toddler-dress)
+ (make-instance 'yadfa-items:rubber-onesie))))
+ :toilet (make-instance 'yadfa-props:toilet)
+ :bed (make-instance 'yadfa-props:bed)
+ :shop (make-instance 'yadfa-props:debug-shop
+ :actions (list :talk (make-action :documentation "Say hi"
+ :lambda '(lambda
+ (prop &rest keys &key &allow-other-keys)
+ (declare (ignore prop keys))
+ (format t "Hello World~%")))))))
(ensure-zone (0 0 -1 debug-map)
- :name "zone-0-0--1-debug-map"
- :description "zone-0-0--1-debug-map"
- :enter-text "zone-0-0--1-debug-map"
- :underwater t
- :stairs (list :up))
+ :name "zone-0-0--1-debug-map"
+ :description "zone-0-0--1-debug-map"
+ :enter-text "zone-0-0--1-debug-map"
+ :underwater t
+ :stairs (list :up))
(ensure-zone (0 -1 -1 debug-map)
- :name "zone-0--1--1-debug-map"
- :description "zone-0--1--1-debug-map"
- :enter-text "zone-0--1--1-debug-map"
- :hidden t)
+ :name "zone-0--1--1-debug-map"
+ :description "zone-0--1--1-debug-map"
+ :enter-text "zone-0--1--1-debug-map"
+ :hidden t)
(ensure-zone (0 1 0 debug-map)
- :name "zone-0-1-0-debug-map"
- :description "zone-0-1-0-debug-map"
- :enter-text "zone-0-1-0-debug-map"
- :enemy-spawn-list '((:chance 1 :enemies ((enemy)))))
+ :name "zone-0-1-0-debug-map"
+ :description "zone-0-1-0-debug-map"
+ :enter-text "zone-0-1-0-debug-map"
+ :enemy-spawn-list '((:chance 1 :enemies ((enemy)))))
(ensure-zone (1 0 0 debug-map)
- :name "zone-1-0-0-debug-map"
- :description "zone-1-0-0-debug-map"
- :enter-text "zone-1-0-0-debug-map" )
+ :name "zone-1-0-0-debug-map"
+ :description "zone-1-0-0-debug-map"
+ :enter-text "zone-1-0-0-debug-map" )
(ensure-zone (1 1 0 debug-map)
- :name "zone-1-1-0-debug-map"
- :description "zone-1-1-0-debug-map"
- :enter-text "zone-1-1-0-debug-map"
- :events '(yadfa-events::test-battle-1)
- :warp-points '(\1 (0 0 0 debug-map)))
+ :name "zone-1-1-0-debug-map"
+ :description "zone-1-1-0-debug-map"
+ :enter-text "zone-1-1-0-debug-map"
+ :events '(yadfa-events::test-battle-1)
+ :warp-points '(\1 (0 0 0 debug-map)))
(ensure-zone (1 1 1 debug-map)
- :name "zone-1-1-1-debug-map"
- :description "zone-1-1-1-debug-map"
- :enter-text "zone-1-1-1-debug-map")
+ :name "zone-1-1-1-debug-map"
+ :description "zone-1-1-1-debug-map"
+ :enter-text "zone-1-1-1-debug-map")
diff --git a/data/map/haunted-forest.lisp b/data/map/haunted-forest.lisp
index bff2b25..a4d8870 100644
--- a/data/map/haunted-forest.lisp
+++ b/data/map/haunted-forest.lisp
@@ -1,188 +1,188 @@
;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa-zones"; coding: utf-8-unix; -*-
(in-package :yadfa-zones)
(ensure-zone (0 0 0 haunted-forest)
- :name "Haunted Forest Entrance"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You enter the haunted forest"
- :events '(yadfa-events:secret-underground-pipe-haunted-forest)
- :warp-points (list 'rpgmaker-dungeon '(5 0 0 rpgmaker-dungeon)))
+ :name "Haunted Forest Entrance"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You enter the haunted forest"
+ :events '(yadfa-events:secret-underground-pipe-haunted-forest)
+ :warp-points (list 'rpgmaker-dungeon '(5 0 0 rpgmaker-dungeon)))
(ensure-zone (0 -1 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest)
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest)
(ensure-zone (1 -1 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest)
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest)
(ensure-zone (-1 -1 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest
- :direction-attributes (list :west (list :hidden t)))
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest
+ :direction-attributes (list :west (list :hidden t)))
(ensure-zone (-2 -1 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest
- :direction-attributes (list :east (list :hidden t)))
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest
+ :direction-attributes (list :east (list :hidden t)))
(ensure-zone (-2 0 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest)
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest)
(ensure-zone (-1 -2 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest
- :direction-attributes (list :west (list :hidden t)
- :north (list :hidden t)))
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest
+ :direction-attributes (list :west (list :hidden t)
+ :north (list :hidden t)))
(ensure-zone (-2 -2 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest
- :direction-attributes (list :east (list :hidden t)))
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest
+ :direction-attributes (list :east (list :hidden t)))
(ensure-zone (-2 -3 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest)
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest)
(ensure-zone (-1 -3 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest
- :direction-attributes (list :south (list :hidden t)))
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest
+ :direction-attributes (list :south (list :hidden t)))
(ensure-zone (0 -3 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest)
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest)
(ensure-zone (1 -3 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest)
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest)
(ensure-zone (1 -2 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest)
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest)
(ensure-zone (2 -2 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest
- :direction-attributes (list :south (list :hidden t)))
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest
+ :direction-attributes (list :south (list :hidden t)))
(ensure-zone (1 -1 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest)
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest)
(ensure-zone (2 -1 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest
- :direction-attributes (list :north (list :hidden t)))
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest
+ :direction-attributes (list :north (list :hidden t)))
(ensure-zone (2 0 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest)
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest)
(ensure-zone (3 0 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest)
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest)
(ensure-zone (3 -2 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest)
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest)
(ensure-zone (3 -3 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest)
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest)
(ensure-zone (3 -4 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest)
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest)
(ensure-zone (3 -5 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest)
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest)
(ensure-zone (5 -2 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest
- :direction-attributes (list :east (list :hidden t)))
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest
+ :direction-attributes (list :east (list :hidden t)))
(ensure-zone (6 -3 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest
- :direction-attributes (list :east (list :hidden t)))
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest
+ :direction-attributes (list :east (list :hidden t)))
(ensure-zone (6 -2 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're in front of a haunted house"
- :enemy-spawn-list 'haunted-forest
- :direction-attributes (list :west (list :hidden t)
- :south (list :hidden t)
- :east (list :hidden t)
- 'haunted-house (list :exit-text "You enter the haunted house"))
- :events '(yadfa-events:secret-underground-pipe-haunted-house)
- :warp-points (list 'haunted-house '(0 0 0 haunted-house)))
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're in front of a haunted house"
+ :enemy-spawn-list 'haunted-forest
+ :direction-attributes (list :west (list :hidden t)
+ :south (list :hidden t)
+ :east (list :hidden t)
+ 'haunted-house (list :exit-text "You enter the haunted house"))
+ :events '(yadfa-events:secret-underground-pipe-haunted-house)
+ :warp-points (list 'haunted-house '(0 0 0 haunted-house)))
(ensure-zone (5 -3 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest)
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest)
(ensure-zone (5 -1 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest)
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest)
(ensure-zone (6 -1 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest
- :direction-attributes (list :north (list :hidden t)))
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest
+ :direction-attributes (list :north (list :hidden t)))
(ensure-zone (7 -1 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest)
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest)
(ensure-zone (7 -2 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest
- :direction-attributes (list :west (list :hidden t)))
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest
+ :direction-attributes (list :west (list :hidden t)))
(ensure-zone (7 -3 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest
- :direction-attributes (list :west (list :hidden t)))
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest
+ :direction-attributes (list :west (list :hidden t)))
(ensure-zone (7 -4 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest)
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest)
#.`(progn ,@(iter (for i from 3 to 7)
- (collect `(ensure-zone (,i -5 0 haunted-forest)
- :name "Haunted Forest"
- :description "You're in a strange forest. Spooky sounds and scary eyes all around."
- :enter-text "You're wondering around the haunted forest"
- :enemy-spawn-list 'haunted-forest))))
+ (collect `(ensure-zone (,i -5 0 haunted-forest)
+ :name "Haunted Forest"
+ :description "You're in a strange forest. Spooky sounds and scary eyes all around."
+ :enter-text "You're wondering around the haunted forest"
+ :enemy-spawn-list 'haunted-forest))))
diff --git a/data/map/haunted-house.lisp b/data/map/haunted-house.lisp
index c6b2aad..f212316 100644
--- a/data/map/haunted-house.lisp
+++ b/data/map/haunted-house.lisp
@@ -1,35 +1,35 @@
;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa-zones"; coding: utf-8-unix; -*-
(in-package :yadfa-zones)
(ensure-zone (0 0 0 haunted-house)
- :name "Haunted House Entrance"
- :description "You're at a entrance of a haunted house"
- :enter-text "You walk to the entrance of the haunted house"
- :direction-attributes (list 'haunted-forest (list :exit-text "You exit the haunted house"))
- :warp-points (list 'haunted-forest '(6 -2 0 haunted-forest)))
+ :name "Haunted House Entrance"
+ :description "You're at a entrance of a haunted house"
+ :enter-text "You walk to the entrance of the haunted house"
+ :direction-attributes (list 'haunted-forest (list :exit-text "You exit the haunted house"))
+ :warp-points (list 'haunted-forest '(6 -2 0 haunted-forest)))
(ensure-zone (1 0 0 haunted-house)
- :name "Haunted House Hallway"
- :description "You're in a spooky haunted house."
- :enter-text "You're wandering around the haunted house")
+ :name "Haunted House Hallway"
+ :description "You're in a spooky haunted house."
+ :enter-text "You're wandering around the haunted house")
(ensure-zone (-1 0 0 haunted-house)
- :name "Haunted House Hallway"
- :description "You're in a spooky haunted house."
- :enter-text "You're wandering around the haunted house")
+ :name "Haunted House Hallway"
+ :description "You're in a spooky haunted house."
+ :enter-text "You're wandering around the haunted house")
(ensure-zone (-1 -1 0 haunted-house)
- :name "Haunted House Stairwell"
- :description "You're in a spooky haunted house."
- :enter-text "You're wandering around the haunted house"
- :stairs (list :up)
- :direction-attributes (list :up (list :exit-text "You head down the stairs")))
+ :name "Haunted House Stairwell"
+ :description "You're in a spooky haunted house."
+ :enter-text "You're wandering around the haunted house"
+ :stairs (list :up)
+ :direction-attributes (list :up (list :exit-text "You head down the stairs")))
(ensure-zone (-1 -1 1 haunted-house)
- :name "Haunted House Stairwell"
- :description "You're in a spooky haunted house."
- :enter-text "You're wandering around the haunted house"
- :stairs (list :down)
- :direction-attributes (list :down (list :exit-text "You head up the stairs")))
+ :name "Haunted House Stairwell"
+ :description "You're in a spooky haunted house."
+ :enter-text "You're wandering around the haunted house"
+ :stairs (list :down)
+ :direction-attributes (list :down (list :exit-text "You head up the stairs")))
(ensure-zone (1 -1 0 haunted-house)
- :name "Haunted Kitchen"
- :description "You're in a spooky haunted house."
- :enter-text "You enter the kitchen")
+ :name "Haunted Kitchen"
+ :description "You're in a spooky haunted house."
+ :enter-text "You enter the kitchen")
(defun highchairfunction% (prop &rest keys &key &allow-other-keys)
(declare (type prop prop) (ignore prop keys))
(write-string #.(with-output-to-string (s)
@@ -40,71 +40,71 @@
(team (cons (player-of *game*) (allies-of *game*))))
(declare (type list team wet mess))
(iter (for c in team)
- (setf (health-of c) (calculate-stat c :health))
- (setf (energy-of c) (calculate-stat c :energy))
- (incf (bladder/contents-of c) 500)
- (incf (bowels/contents-of c) 300)
- (when (>= (bladder/contents-of c)
- (bladder/maximum-limit-of c))
- (lappendf wet (list c (wet :wetter c))))
- (when (>= (bowels/contents-of c)
- (bowels/maximum-limit-of c))
- (lappendf mess (list c (mess :messer c)))
- (setf mess (append (list c (mess :messer c)) mess)))
- (let (a b c e f
- (d (iter (for (k v) on mess by 'cddr)
- (when (> (getf v :mess-amount) 0)
- (collect (name-of k) at start)))))
- (declare (type list a b c d e f))
- (iter (for i in team)
- (push (name-of i) e)
- (when (filter-items (wear-of i) 'padding)
- (push (name-of i) f)))
- (iter (for (k v) on wet by 'cddr)
- (cond ((> (getf v :leak-amount) 300)
- (push (name-of k) a))
- ((> (getf v :leak-amount) 100)
- (push (name-of k) b))
- ((> (getf v :wet-amount) 0)
- (push (name-of k) c))))
- (flet ((temp (array control plural male female)
- (when array
- (apply 'format control array (cond ((cdr array) plural)
- ((malep (car array)) male)
- (t female))))))
- (temp a "*~{~#[~;~a~;~a and ~a~:;~@{~a~#[~;, and ~:;, ~]~}~]~} presses ~a legs together as ~a bladder~a gives out and a yellow stream flows down ~a highchair~a*~%~%"
- '("their" "their" "s" "their" "s")
- '("his" "his" "" "his" "")
- '("her" "her" "" "her" ""))
- (temp b "*~{~#[~;~a~;~a and ~a~:;~@{~a~#[~;, and ~:;, ~]~}~]~} presses ~a legs together as ~a bladder~a gives out and a puddle forms in ~a seat~a*~%~%"
- '("their" "their" "s" "their" "s")
- '("his" "his" "" "his" "")
- '("her" "her" "" "her" ""))
- (temp c "*~{~#[~;~a~;~a and ~a~:;~@{~a~#[~;, and ~:;, ~]~}~]~} presses ~a legs together as ~a bladder~a gives out and flood~a ~a pamps*~%~%"
- '("their" "their" "s" "" "their")
- '("his" "his" "" "s" "his")
- '("her" "her" "" "s" "her"))
- (temp d "*~{~#[~;~a~;~a and ~a~:;~@{~a~#[~;, and ~:;, ~]~}~]~} presses ~a legs together as a loud blort is heard as ~a mess~a ~aself*~%~%"
- '("their" "they" "" "themselves")
- '("his" "his" "es" "himself")
- '("her" "her" "es" "herself"))
- (temp e "*The ghost hands picks ~{~#[~;~a~;~a and ~a~:;~@{~a~#[~;, and ~:;, ~]~}~]~} up out of the highchair~s and sets ~a on the floor*~%"
- '("s" "them")
- '("" "him")
- '("" "her"))
- (temp f "*then gives ~{~#[~;~a~;~a and ~a~:;~@{~a~#[~;, and ~:;, ~]~}~]~} pats on ~a pamps*~%~%"
- '("their")
- '("his")
- '("her")))))))
+ (setf (health-of c) (calculate-stat c :health))
+ (setf (energy-of c) (calculate-stat c :energy))
+ (incf (bladder/contents-of c) 500)
+ (incf (bowels/contents-of c) 300)
+ (when (>= (bladder/contents-of c)
+ (bladder/maximum-limit-of c))
+ (lappendf wet (list c (wet :wetter c))))
+ (when (>= (bowels/contents-of c)
+ (bowels/maximum-limit-of c))
+ (lappendf mess (list c (mess :messer c)))
+ (setf mess (append (list c (mess :messer c)) mess)))
+ (let (a b c e f
+ (d (iter (for (k v) on mess by 'cddr)
+ (when (> (getf v :mess-amount) 0)
+ (collect (name-of k) at start)))))
+ (declare (type list a b c d e f))
+ (iter (for i in team)
+ (push (name-of i) e)
+ (when (filter-items (wear-of i) 'padding)
+ (push (name-of i) f)))
+ (iter (for (k v) on wet by 'cddr)
+ (cond ((> (getf v :leak-amount) 300)
+ (push (name-of k) a))
+ ((> (getf v :leak-amount) 100)
+ (push (name-of k) b))
+ ((> (getf v :wet-amount) 0)
+ (push (name-of k) c))))
+ (flet ((temp (array control plural male female)
+ (when array
+ (apply 'format control array (cond ((cdr array) plural)
+ ((malep (car array)) male)
+ (t female))))))
+ (temp a "*~{~#[~;~a~;~a and ~a~:;~@{~a~#[~;, and ~:;, ~]~}~]~} presses ~a legs together as ~a bladder~a gives out and a yellow stream flows down ~a highchair~a*~%~%"
+ '("their" "their" "s" "their" "s")
+ '("his" "his" "" "his" "")
+ '("her" "her" "" "her" ""))
+ (temp b "*~{~#[~;~a~;~a and ~a~:;~@{~a~#[~;, and ~:;, ~]~}~]~} presses ~a legs together as ~a bladder~a gives out and a puddle forms in ~a seat~a*~%~%"
+ '("their" "their" "s" "their" "s")
+ '("his" "his" "" "his" "")
+ '("her" "her" "" "her" ""))
+ (temp c "*~{~#[~;~a~;~a and ~a~:;~@{~a~#[~;, and ~:;, ~]~}~]~} presses ~a legs together as ~a bladder~a gives out and flood~a ~a pamps*~%~%"
+ '("their" "their" "s" "" "their")
+ '("his" "his" "" "s" "his")
+ '("her" "her" "" "s" "her"))
+ (temp d "*~{~#[~;~a~;~a and ~a~:;~@{~a~#[~;, and ~:;, ~]~}~]~} presses ~a legs together as a loud blort is heard as ~a mess~a ~aself*~%~%"
+ '("their" "they" "" "themselves")
+ '("his" "his" "es" "himself")
+ '("her" "her" "es" "herself"))
+ (temp e "*The ghost hands picks ~{~#[~;~a~;~a and ~a~:;~@{~a~#[~;, and ~:;, ~]~}~]~} up out of the highchair~s and sets ~a on the floor*~%"
+ '("s" "them")
+ '("" "him")
+ '("" "her"))
+ (temp f "*then gives ~{~#[~;~a~;~a and ~a~:;~@{~a~#[~;, and ~:;, ~]~}~]~} pats on ~a pamps*~%~%"
+ '("their")
+ '("his")
+ '("her")))))))
(ensure-zone (2 -1 0 haunted-house)
- :name "Haunted Dining Room"
- :description "You're in a spooky haunted house."
- :enter-text "You enter the dining room"
- :props (list :highchair (make-instance 'prop
- :name "High Chairs"
- :description "Several high chairs that is big enough to hold an adult"
- :actions (list :use (make-action :documentation "Look at the high chair" :lambda 'highchairfunction%)))))
+ :name "Haunted Dining Room"
+ :description "You're in a spooky haunted house."
+ :enter-text "You enter the dining room"
+ :props (list :highchair (make-instance 'prop
+ :name "High Chairs"
+ :description "Several high chairs that is big enough to hold an adult"
+ :actions (list :use (make-action :documentation "Look at the high chair" :lambda 'highchairfunction%)))))
(ensure-zone (2 0 0 haunted-house)
- :name "Haunted Living Room"
- :description "You're in a spooky haunted house."
- :enter-text "You enter the living room")
+ :name "Haunted Living Room"
+ :description "You're in a spooky haunted house."
+ :enter-text "You enter the living room")
diff --git a/data/map/home.lisp b/data/map/home.lisp
index 2579304..9be43a9 100644
--- a/data/map/home.lisp
+++ b/data/map/home.lisp
@@ -1,48 +1,48 @@
;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa-zones"; coding: utf-8-unix; -*-
(in-package :yadfa-zones)
(ensure-zone (0 0 0 home)
- :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.")
- :dresser (make-instance 'prop
- :name "Dresser"
- :placeable t
- :description "Has all your clothes and diapers in here, until you take them out."
- :items ())
- :checkpoint (make-instance 'yadfa-props:checkpoint)))
+ :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.")
+ :dresser (make-instance 'prop
+ :name "Dresser"
+ :placeable t
+ :description "Has all your clothes and diapers in here, until you take them out."
+ :items ())
+ :checkpoint (make-instance 'yadfa-props:checkpoint)))
(ensure-zone (1 0 0 home)
- :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")
- :cupboard (make-instance 'prop
- :name "Cupboard"
- :placeable t
- :description "A cupboard located on the sink"
- :items (list (make-instance 'yadfa-items:potion)))
- :washer (make-instance 'yadfa-props:washer
- :name "Washer"
- :description "A place to wash all the clothes that you've ruined")))
+ :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")
+ :cupboard (make-instance 'prop
+ :name "Cupboard"
+ :placeable t
+ :description "A cupboard located on the sink"
+ :items (list (make-instance 'yadfa-items:potion)))
+ :washer (make-instance 'yadfa-props:washer
+ :name "Washer"
+ :description "A place to wash all the clothes that you've ruined")))
(ensure-zone (0 1 0 home)
- :name "Street"
- :description "Your typical suburban street. Some furries are driving in cars, some are walking, and some are riding on top of other furries treating them like a horse."
- :enter-text "You enter the street outside your house"
- :warp-points (list 'ironside '(0 0 0 ironside)))
+ :name "Street"
+ :description "Your typical suburban street. Some furries are driving in cars, some are walking, and some are riding on top of other furries treating them like a horse."
+ :enter-text "You enter the street outside your house"
+ :warp-points (list 'ironside '(0 0 0 ironside)))
(ensure-zone (0 2 0 home)
- :name "Pool area"
- :description "A pool to go swimming in"
- :enter-text "You enter the pool area"
- :stairs (list :down))
+ :name "Pool area"
+ :description "A pool to go swimming in"
+ :enter-text "You enter the pool area"
+ :stairs (list :down))
(ensure-zone (0 2 -1 home)
- :name "Pool"
- :description "A pool"
- :enter-text "You dive in the pool"
- :stairs (list :up)
- :underwater t)
+ :name "Pool"
+ :description "A pool"
+ :enter-text "You dive in the pool"
+ :stairs (list :up)
+ :underwater t)
diff --git a/data/map/ironside.lisp b/data/map/ironside.lisp
index dec1149..5292f1e 100644
--- a/data/map/ironside.lisp
+++ b/data/map/ironside.lisp
@@ -1,168 +1,168 @@
;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa-zones"; coding: utf-8-unix; -*-
(in-package :yadfa-zones)
(ensure-zone (0 0 0 ironside)
- :name "Ironside Street"
- :description "Your typical suburban street. Some furries are driving in cars, some are walking, and some are riding on top of other furries treating them like a horse."
- :enter-text "You enter the street. You see a sign that says “Keep our city and your pants clean. Always go potty in the toilet and not in your pants and don't leave puddles on the floor. Anyone who doesn't abide by this rule will be assumed to have no potty training whatsoever and will be immediately diapered by the diaper police to prevent further puddles.”"
- :can-potty 'can-potty
- :potty-trigger 'trigger-diaper-police
- :warp-points (list 'home '(0 1 0 home)))
+ :name "Ironside Street"
+ :description "Your typical suburban street. Some furries are driving in cars, some are walking, and some are riding on top of other furries treating them like a horse."
+ :enter-text "You enter the street. You see a sign that says “Keep our city and your pants clean. Always go potty in the toilet and not in your pants and don't leave puddles on the floor. Anyone who doesn't abide by this rule will be assumed to have no potty training whatsoever and will be immediately diapered by the diaper police to prevent further puddles.”"
+ :can-potty 'can-potty
+ :potty-trigger 'trigger-diaper-police
+ :warp-points (list 'home '(0 1 0 home)))
(ensure-zone (1 0 0 ironside)
- :name "Ironside Street"
- :description "Your typical suburban street. Some furries are driving in cars, some are walking, and some are riding on top of other furries treating them like a horse."
- :can-potty 'can-potty
- :potty-trigger 'trigger-diaper-police
- :enter-text "You enter the street")
+ :name "Ironside Street"
+ :description "Your typical suburban street. Some furries are driving in cars, some are walking, and some are riding on top of other furries treating them like a horse."
+ :can-potty 'can-potty
+ :potty-trigger 'trigger-diaper-police
+ :enter-text "You enter the street")
(ensure-zone (2 0 0 ironside)
- :name "Ironside Street"
- :description "Your typical suburban street. Some furries are driving in cars, some are walking, and some are riding on top of other furries treating them like a horse."
- :can-potty 'can-potty
- :potty-trigger 'trigger-diaper-police
- :warp-points (list 'bandits-way '(0 10 0 bandits-domain))
- :enter-text "You enter the street")
+ :name "Ironside Street"
+ :description "Your typical suburban street. Some furries are driving in cars, some are walking, and some are riding on top of other furries treating them like a horse."
+ :can-potty 'can-potty
+ :potty-trigger 'trigger-diaper-police
+ :warp-points (list 'bandits-way '(0 10 0 bandits-domain))
+ :enter-text "You enter the street")
(ensure-zone (0 1 0 downtown)
- :name "Ironside Crap-Mart"
- :description "Your local Crap-Mart store. We don't have as big of selection as other stores, but we carry a lot more of what we do actually stock. Our products are built with love, and by love, I mean the sweat and tears of cheap child labor from China. We pass the savings down to you, in theory, but not in practice. We now stock incontinence products that you can depend on, unless you plan to use them, since they can't hold anything worth a crap. Why do people keep buying the ones from across the street?"
- :enter-text "You enter the Crap-Mart"
- :can-potty 'can-potty
- :potty-trigger 'trigger-diaper-police
- :props (list
- :shop (make-instance 'yadfa-props:shop
- :items-for-sale (list
- '(yadfa-items:monster-energy-drink)
- '(yadfa-items:generic-diapers-package)
- '(yadfa-items:generic-pullons-package)
- '(yadfa-items:dress)
- '(yadfa-items:jeans)
- '(yadfa-items:tshirt)
- '(yadfa-items:boxers)
- '(yadfa-items:panties)
- '(yadfa-items:knights-armor)
- '(yadfa-items:potion)))
- :changing-table (make-instance 'yadfa-props:automatic-changing-table)))
+ :name "Ironside Crap-Mart"
+ :description "Your local Crap-Mart store. We don't have as big of selection as other stores, but we carry a lot more of what we do actually stock. Our products are built with love, and by love, I mean the sweat and tears of cheap child labor from China. We pass the savings down to you, in theory, but not in practice. We now stock incontinence products that you can depend on, unless you plan to use them, since they can't hold anything worth a crap. Why do people keep buying the ones from across the street?"
+ :enter-text "You enter the Crap-Mart"
+ :can-potty 'can-potty
+ :potty-trigger 'trigger-diaper-police
+ :props (list
+ :shop (make-instance 'yadfa-props:shop
+ :items-for-sale (list
+ '(yadfa-items:monster-energy-drink)
+ '(yadfa-items:generic-diapers-package)
+ '(yadfa-items:generic-pullons-package)
+ '(yadfa-items:dress)
+ '(yadfa-items:jeans)
+ '(yadfa-items:tshirt)
+ '(yadfa-items:boxers)
+ '(yadfa-items:panties)
+ '(yadfa-items:knights-armor)
+ '(yadfa-items:potion)))
+ :changing-table (make-instance 'yadfa-props:automatic-changing-table)))
(ensure-zone (0 -1 0 ironside)
- :name "Ironside ABDL-Mart"
- :description "Welcome to ABDL-Mart"
- :enter-text "You enter the ABDL-Mart."
- :can-potty 'can-potty
- :potty-trigger 'trigger-diaper-police
- :props (list
- :shop (make-instance 'yadfa-props:shop
- :items-for-sale (list
- '(yadfa-items:bottle-of-milk)
- '(yadfa-items:incontinence-pad-package)
- '(yadfa-items:diaper-package)
- '(yadfa-items:pullups-package)
- '(yadfa-items:toddler-dress)
- '(yadfa-items:onesie/opened)))
- :changing-table (make-instance 'yadfa-props:automatic-changing-table)))
+ :name "Ironside ABDL-Mart"
+ :description "Welcome to ABDL-Mart"
+ :enter-text "You enter the ABDL-Mart."
+ :can-potty 'can-potty
+ :potty-trigger 'trigger-diaper-police
+ :props (list
+ :shop (make-instance 'yadfa-props:shop
+ :items-for-sale (list
+ '(yadfa-items:bottle-of-milk)
+ '(yadfa-items:incontinence-pad-package)
+ '(yadfa-items:diaper-package)
+ '(yadfa-items:pullups-package)
+ '(yadfa-items:toddler-dress)
+ '(yadfa-items:onesie/opened)))
+ :changing-table (make-instance 'yadfa-props:automatic-changing-table)))
(ensure-zone (2 1 0 ironside)
- :name "Ironside University Entrance"
- :description "An old school university back when universities actually innovated, instead of being dumbed down, commercialized, and simply taught how to use proprietary products."
- :enter-text "You enter the university"
- :can-potty 'can-potty
- :potty-trigger 'trigger-diaper-police)
+ :name "Ironside University Entrance"
+ :description "An old school university back when universities actually innovated, instead of being dumbed down, commercialized, and simply taught how to use proprietary products."
+ :enter-text "You enter the university"
+ :can-potty 'can-potty
+ :potty-trigger 'trigger-diaper-police)
(ensure-zone (2 2 0 ironside)
- :name "Ironside University"
- :description "A hallway"
- :enter-text "You're in the hallway"
- :can-potty 'can-potty
- :potty-trigger 'trigger-diaper-police)
+ :name "Ironside University"
+ :description "A hallway"
+ :enter-text "You're in the hallway"
+ :can-potty 'can-potty
+ :potty-trigger 'trigger-diaper-police)
(ensure-zone (2 3 0 ironside)
- :name "Ironside University"
- :description "A hallway"
- :enter-text "You're in the hallway"
- :can-potty 'can-potty
- :potty-trigger 'trigger-diaper-police)
+ :name "Ironside University"
+ :description "A hallway"
+ :enter-text "You're in the hallway"
+ :can-potty 'can-potty
+ :potty-trigger 'trigger-diaper-police)
(ensure-zone (3 2 0 ironside)
- :name "6.001/6.037"
- :description "This is the classroom for Structure and Interpretation of Computer Programs"
- :enter-text "You enter the classroom"
- :can-potty 'can-potty
- :potty-trigger 'trigger-diaper-police
- :direction-attributes (list :south (list :hidden t))
- :props
- (list
- :desk
- (make-instance 'prop
- :name "Desk"
- :description "One of the desks in the classroom"
- :actions
- (list :sit-through-lecture
- (make-action :documentation "Sit through a lecture"
- :lambda '(lambda
- (prop &rest keys &key &allow-other-keys)
- (declare (ignore prop keys))
- (format t "Instructor: Today's topic is Linear Recursion and Iteration, let's look at the following factorial function~%~%")
- (write-line "*writes")
- (write-line "(define (factorial n)")
- (write-line " (if (= n 1)")
- (write-line " 1")
- (write-line " (* n (factorial (- n 1)))))")
- (format t "on the blackboard, then walks through the process in the following substitution model~%~%(factorial 6)~%")
- (write-line "(* 6 (factorial 5))")
- (write-line "(* 6 (* 5 (factorial 4)))")
- (write-line "(* 6 (* 5 (* 4 (factorial 3))))")
- (write-line "(* 6 (* 5 (* 4 (* 3 (factorial 2)))))")
- (write-line "(* 6 (* 5 (* 4 (* 3 (* 2 (factorial 1))))))")
- (write-line "(* 6 (* 5 (* 4 (* 3 (* 2 1)))))")
- (write-line "(* 6 (* 5 (* 4 (* 3 2))))")
- (write-line "(* 6 (* 5 (* 4 6)))")
- (write-line "(* 6 (* 5 24))")
- (write-line "(* 6 120)")
- (write-line "720")
- (format t "on the blackboard*~%~%")
- (format t "Instructor: This is a recursive process, but isn't very efficient though, as the interpreter needs to keep track of all the operations, instead we can redefine the function as follows~%~%")
- (write-line "*writes")
- (write-line "(define (factorial n)")
- (write-line " (define (iter product counter)")
- (write-line " (if (> counter n)")
- (write-line " product")
- (write-line " (iter (* counter product)")
- (write-line " (+ counter 1))))")
- (write-line " (iter 1 1))")
- (write-line "on the chalkboard, then walks through the process")
- (write-line "(factorial 6)")
- (write-line "(iter 1 1)")
- (write-line "(iter 1 2)")
- (write-line "(iter 2 3)")
- (write-line "(iter 6 4)")
- (write-line "(iter 24 5)")
- (write-line "(iter 120 6)")
- (write-line "(iter 720 7)")
- (write-line "720")
- (write-line "on the blackboard*")
- (format t "Instructor: This is an iterative process, as the interpreter now only needs to keep track of the variables product and counter for each n~%~%")
- (trigger-event 'yadfa-events:ironside-university-joke-1)))))))
+ :name "6.001/6.037"
+ :description "This is the classroom for Structure and Interpretation of Computer Programs"
+ :enter-text "You enter the classroom"
+ :can-potty 'can-potty
+ :potty-trigger 'trigger-diaper-police
+ :direction-attributes (list :south (list :hidden t))
+ :props
+ (list
+ :desk
+ (make-instance 'prop
+ :name "Desk"
+ :description "One of the desks in the classroom"
+ :actions
+ (list :sit-through-lecture
+ (make-action :documentation "Sit through a lecture"
+ :lambda '(lambda
+ (prop &rest keys &key &allow-other-keys)
+ (declare (ignore prop keys))
+ (format t "Instructor: Today's topic is Linear Recursion and Iteration, let's look at the following factorial function~%~%")
+ (write-line "*writes")
+ (write-line "(define (factorial n)")
+ (write-line " (if (= n 1)")
+ (write-line " 1")
+ (write-line " (* n (factorial (- n 1)))))")
+ (format t "on the blackboard, then walks through the process in the following substitution model~%~%(factorial 6)~%")
+ (write-line "(* 6 (factorial 5))")
+ (write-line "(* 6 (* 5 (factorial 4)))")
+ (write-line "(* 6 (* 5 (* 4 (factorial 3))))")
+ (write-line "(* 6 (* 5 (* 4 (* 3 (factorial 2)))))")
+ (write-line "(* 6 (* 5 (* 4 (* 3 (* 2 (factorial 1))))))")
+ (write-line "(* 6 (* 5 (* 4 (* 3 (* 2 1)))))")
+ (write-line "(* 6 (* 5 (* 4 (* 3 2))))")
+ (write-line "(* 6 (* 5 (* 4 6)))")
+ (write-line "(* 6 (* 5 24))")
+ (write-line "(* 6 120)")
+ (write-line "720")
+ (format t "on the blackboard*~%~%")
+ (format t "Instructor: This is a recursive process, but isn't very efficient though, as the interpreter needs to keep track of all the operations, instead we can redefine the function as follows~%~%")
+ (write-line "*writes")
+ (write-line "(define (factorial n)")
+ (write-line " (define (iter product counter)")
+ (write-line " (if (> counter n)")
+ (write-line " product")
+ (write-line " (iter (* counter product)")
+ (write-line " (+ counter 1))))")
+ (write-line " (iter 1 1))")
+ (write-line "on the chalkboard, then walks through the process")
+ (write-line "(factorial 6)")
+ (write-line "(iter 1 1)")
+ (write-line "(iter 1 2)")
+ (write-line "(iter 2 3)")
+ (write-line "(iter 6 4)")
+ (write-line "(iter 24 5)")
+ (write-line "(iter 120 6)")
+ (write-line "(iter 720 7)")
+ (write-line "720")
+ (write-line "on the blackboard*")
+ (format t "Instructor: This is an iterative process, as the interpreter now only needs to keep track of the variables product and counter for each n~%~%")
+ (trigger-event 'yadfa-events:ironside-university-joke-1)))))))
(ensure-zone (3 3 0 ironside)
- :name "Ironside University Dormitory"
- :description ""
- :enter-text ""
- :can-potty 'can-potty
- :potty-trigger 'trigger-diaper-police
- :direction-attributes (list :north (list :hidden 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.")
- :dresser (make-instance 'prop
- :name "Dresser"
- :placeable t
- :description "Has all your clothes and diapers in here, until you take them out.")
- :checkpoint (make-instance 'yadfa-props:checkpoint)
- :washer (make-instance 'yadfa-props:washer
- :name "Washer"
- :description "A place to wash all the clothes that you've ruined")
- :diaper-dispenser
- (make-instance 'prop
- :name "Diaper Dispenser"
- :description "Provides diapers for the students here just in case they can't sit at their desks and hold it."
- :actions
- (list :get-diaper
- (make-action :documentation "Get a diaper from the dispenser"
- :lambda '(lambda
- (prop &rest keys &key &allow-other-keys)
- (declare (type prop prop) (ignore prop))
- (check-type prop prop)
- (push (make-instance 'yadfa-items:diaper) (inventory-of (player-of *game*)))))))))
+ :name "Ironside University Dormitory"
+ :description ""
+ :enter-text ""
+ :can-potty 'can-potty
+ :potty-trigger 'trigger-diaper-police
+ :direction-attributes (list :north (list :hidden 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.")
+ :dresser (make-instance 'prop
+ :name "Dresser"
+ :placeable t
+ :description "Has all your clothes and diapers in here, until you take them out.")
+ :checkpoint (make-instance 'yadfa-props:checkpoint)
+ :washer (make-instance 'yadfa-props:washer
+ :name "Washer"
+ :description "A place to wash all the clothes that you've ruined")
+ :diaper-dispenser
+ (make-instance 'prop
+ :name "Diaper Dispenser"
+ :description "Provides diapers for the students here just in case they can't sit at their desks and hold it."
+ :actions
+ (list :get-diaper
+ (make-action :documentation "Get a diaper from the dispenser"
+ :lambda '(lambda
+ (prop &rest keys &key &allow-other-keys)
+ (declare (type prop prop) (ignore prop))
+ (check-type prop prop)
+ (push (make-instance 'yadfa-items:diaper) (inventory-of (player-of *game*)))))))))
diff --git a/data/map/lukurbo.lisp b/data/map/lukurbo.lisp
index 48723a9..2346d66 100644
--- a/data/map/lukurbo.lisp
+++ b/data/map/lukurbo.lisp
@@ -1,8 +1,8 @@
;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa-zones"; coding: utf-8-unix; -*-
(in-package :yadfa-zones)
(ensure-zone (0 0 0 lukurbo)
- :name "Lukubro Street"
- :description "You see many diapered furries and diapered fursuiters"
- :enter-text "You're wondering around the street"
- :events '(yadfa-events:enter-lukurbo-1 yadfa-events:secret-underground-pipe-lukurbo)
- :warp-points (list 'rpgmaker-dungeon '(9 5 0 rpgmaker-dungeon)))
+ :name "Lukubro Street"
+ :description "You see many diapered furries and diapered fursuiters"
+ :enter-text "You're wondering around the street"
+ :events '(yadfa-events:enter-lukurbo-1 yadfa-events:secret-underground-pipe-lukurbo)
+ :warp-points (list 'rpgmaker-dungeon '(9 5 0 rpgmaker-dungeon)))
diff --git a/data/map/peachs-castle-wannabe.lisp b/data/map/peachs-castle-wannabe.lisp
index 5d5caa5..0dc448e 100644
--- a/data/map/peachs-castle-wannabe.lisp
+++ b/data/map/peachs-castle-wannabe.lisp
@@ -1,247 +1,247 @@
;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa-zones"; coding: utf-8-unix; -*-
(in-package :yadfa-zones)
(ensure-zone (0 0 0 peachs-castle-wannabe)
- :name "Castle Entrance"
- :description "The entrance to some crappy version of Peach's Castle"
- :enter-text "You're at the castle entrance"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe
- :warp-points (list 'silver-cape '(6 11 0 silver-cape)))
+ :name "Castle Entrance"
+ :description "The entrance to some crappy version of Peach's Castle"
+ :enter-text "You're at the castle entrance"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe
+ :warp-points (list 'silver-cape '(6 11 0 silver-cape)))
(ensure-zone (0 -1 0 peachs-castle-wannabe)
- :name "Castle Hallway"
- :description "Some crappy version of Peach's Castle"
- :enter-text "You're wondering around the castle"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe
- :props (list
- :princess (make-instance
- 'prop
- :name "Princess T̶o̶a̶d̶s̶t̶o̶o̶l̶ D̶a̶i̶s̶y̶ Peach"
- :description "The princess of this castle"
- :actions (list
- :talk (make-action
- :documentation "Talk to the princess"
- :lambda '(lambda (prop &rest keys &key &allow-other-keys)
- (declare (ignore prop keys))
- (cond ((finished-events '(yadfa-events:got-all-shine-stars-1))
- (write-line "Peach: You got all the Shine Stars"))
- ((<= (list-length (filter-items (inventory-of (player-of *game*)) 'yadfa-items:shine-star)) 0)
- (write-line "Peach: The Shine Stars keep peace and harmony throughout the land, but Bowser has stolen them and is causing discord and chaos and you need to go find them and bring them back")
- (format nil "~a: Seriously? Is that the best plot Pouar could possibly come up with for this quest?"
- (name-of (player-of *game*))))
- ((< (list-length (filter-items (inventory-of (player-of *game*)) 'yadfa-items:shine-star)) 5)
- (format nil
- "Peach: You still have ~d shine stars to collect, hurry before the player gets bored of this stupid quest."
- (- 5 (list-length (filter-items (inventory-of (player-of *game*)) 'yadfa-items:shine-star)))))
- (t
- (write-line "Peach: You got all the Shine Stars, have a MacGuffin for putting up with this crappy quest")
- (trigger-event 'yadfa-events:got-all-shine-stars-1)))))))))
+ :name "Castle Hallway"
+ :description "Some crappy version of Peach's Castle"
+ :enter-text "You're wondering around the castle"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe
+ :props (list
+ :princess (make-instance
+ 'prop
+ :name "Princess T̶o̶a̶d̶s̶t̶o̶o̶l̶ D̶a̶i̶s̶y̶ Peach"
+ :description "The princess of this castle"
+ :actions (list
+ :talk (make-action
+ :documentation "Talk to the princess"
+ :lambda '(lambda (prop &rest keys &key &allow-other-keys)
+ (declare (ignore prop keys))
+ (cond ((finished-events '(yadfa-events:got-all-shine-stars-1))
+ (write-line "Peach: You got all the Shine Stars"))
+ ((<= (list-length (filter-items (inventory-of (player-of *game*)) 'yadfa-items:shine-star)) 0)
+ (write-line "Peach: The Shine Stars keep peace and harmony throughout the land, but Bowser has stolen them and is causing discord and chaos and you need to go find them and bring them back")
+ (format nil "~a: Seriously? Is that the best plot Pouar could possibly come up with for this quest?"
+ (name-of (player-of *game*))))
+ ((< (list-length (filter-items (inventory-of (player-of *game*)) 'yadfa-items:shine-star)) 5)
+ (format nil
+ "Peach: You still have ~d shine stars to collect, hurry before the player gets bored of this stupid quest."
+ (- 5 (list-length (filter-items (inventory-of (player-of *game*)) 'yadfa-items:shine-star)))))
+ (t
+ (write-line "Peach: You got all the Shine Stars, have a MacGuffin for putting up with this crappy quest")
+ (trigger-event 'yadfa-events:got-all-shine-stars-1)))))))))
(ensure-zone (0 -2 0 peachs-castle-wannabe)
- :name "Castle Hallway"
- :description "Some crappy version of Peach's Castle"
- :enter-text "You're wandering around the castle"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe
- :stairs (list :up)
- :direction-attributes (list :east (list :hidden t)
- :west (list :hidden t)))
+ :name "Castle Hallway"
+ :description "Some crappy version of Peach's Castle"
+ :enter-text "You're wandering around the castle"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe
+ :stairs (list :up)
+ :direction-attributes (list :east (list :hidden t)
+ :west (list :hidden t)))
(ensure-zone (0 -2 1 peachs-castle-wannabe)
- :name "Castle Hallway"
- :description "Some crappy version of Peach's Castle"
- :enter-text "You're wandering around the castle"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe
- :stairs (list :down))
+ :name "Castle Hallway"
+ :description "Some crappy version of Peach's Castle"
+ :enter-text "You're wandering around the castle"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe
+ :stairs (list :down))
(ensure-zone (0 -3 1 peachs-castle-wannabe)
- :name "Castle Hallway"
- :description "Some crappy version of Peach's Castle"
- :enter-text "You're wandering around the castle"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe)
+ :name "Castle Hallway"
+ :description "Some crappy version of Peach's Castle"
+ :enter-text "You're wandering around the castle"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe)
(ensure-zone (-1 -3 1 peachs-castle-wannabe)
- :name "Castle Hallway"
- :description "Some crappy version of Peach's Castle"
- :enter-text "You're wandering around the castle"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe)
+ :name "Castle Hallway"
+ :description "Some crappy version of Peach's Castle"
+ :enter-text "You're wandering around the castle"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe)
(ensure-zone (1 -3 1 peachs-castle-wannabe)
- :name "Castle Hallway"
- :description "Some crappy version of Peach's Castle"
- :enter-text "You're wandering around the castle"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe)
+ :name "Castle Hallway"
+ :description "Some crappy version of Peach's Castle"
+ :enter-text "You're wandering around the castle"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe)
(ensure-zone (-1 -4 1 peachs-castle-wannabe)
- :name "Castle Hallway"
- :description "Some crappy version of Peach's Castle"
- :enter-text "You're wandering around the castle"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe
- :direction-attributes (list :east (list :hidden t)
- 'painting (list :exit-text "BaBaBa-BaBa-Ba Letsago"))
- :warp-points (list 'painting '(0 0 0 peachs-castle-wannabe:pokemon-area)))
+ :name "Castle Hallway"
+ :description "Some crappy version of Peach's Castle"
+ :enter-text "You're wandering around the castle"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe
+ :direction-attributes (list :east (list :hidden t)
+ 'painting (list :exit-text "BaBaBa-BaBa-Ba Letsago"))
+ :warp-points (list 'painting '(0 0 0 peachs-castle-wannabe:pokemon-area)))
(ensure-zone (1 -4 1 peachs-castle-wannabe)
- :name "Castle Hallway"
- :description "Some crappy version of Peach's Castle"
- :enter-text "You're wandering around the castle"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe
- :direction-attributes (list :west (list :hidden t)
- 'painting (list :exit-text "BaBaBa-BaBa-Ba Letsago"))
- :warp-points (list 'painting '(0 0 0 peachs-castle-wannabe:blank-area)))
+ :name "Castle Hallway"
+ :description "Some crappy version of Peach's Castle"
+ :enter-text "You're wandering around the castle"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe
+ :direction-attributes (list :west (list :hidden t)
+ 'painting (list :exit-text "BaBaBa-BaBa-Ba Letsago"))
+ :warp-points (list 'painting '(0 0 0 peachs-castle-wannabe:blank-area)))
(ensure-zone (-1 -1 0 peachs-castle-wannabe)
- :name "Castle Hallway"
- :description "Some crappy version of Peach's Castle"
- :enter-text "You're wandering around the castle"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe)
+ :name "Castle Hallway"
+ :description "Some crappy version of Peach's Castle"
+ :enter-text "You're wandering around the castle"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe)
(ensure-zone (1 -1 0 peachs-castle-wannabe)
- :name "Castle Hallway"
- :description "Some crappy version of Peach's Castle"
- :enter-text "You're wandering around the castle"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe)
+ :name "Castle Hallway"
+ :description "Some crappy version of Peach's Castle"
+ :enter-text "You're wandering around the castle"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe)
(ensure-zone (-1 -2 0 peachs-castle-wannabe)
- :name "Castle Hallway"
- :description "Some crappy version of Peach's Castle"
- :enter-text "You're wandering around the castle"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe
- :stairs (list :down)
- :direction-attributes (list :west (list :hidden t)
- :east (list :hidden t)))
+ :name "Castle Hallway"
+ :description "Some crappy version of Peach's Castle"
+ :enter-text "You're wandering around the castle"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe
+ :stairs (list :down)
+ :direction-attributes (list :west (list :hidden t)
+ :east (list :hidden t)))
(ensure-zone (1 -2 0 peachs-castle-wannabe)
- :name "Castle Hallway"
- :description "Some crappy version of Peach's Castle"
- :enter-text "You're wandering around the castle"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe
- :stairs (list :down)
- :direction-attributes (list :east (list :hidden t)
- :west (list :hidden t)))
+ :name "Castle Hallway"
+ :description "Some crappy version of Peach's Castle"
+ :enter-text "You're wandering around the castle"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe
+ :stairs (list :down)
+ :direction-attributes (list :east (list :hidden t)
+ :west (list :hidden t)))
(ensure-zone (-1 -2 -1 peachs-castle-wannabe)
- :name "Castle Hallway"
- :description "Some crappy version of Peach's Castle"
- :enter-text "You're wandering around the castle"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe
- :stairs (list :up))
+ :name "Castle Hallway"
+ :description "Some crappy version of Peach's Castle"
+ :enter-text "You're wandering around the castle"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe
+ :stairs (list :up))
(ensure-zone (1 -2 -1 peachs-castle-wannabe)
- :name "Castle Hallway"
- :description "Some crappy version of Peach's Castle"
- :enter-text "You're wandering around the castle"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe
- :stairs (list :up))
+ :name "Castle Hallway"
+ :description "Some crappy version of Peach's Castle"
+ :enter-text "You're wandering around the castle"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe
+ :stairs (list :up))
(ensure-zone (-2 -1 0 peachs-castle-wannabe)
- :name "Castle Hallway"
- :description "Some crappy version of Peach's Castle"
- :enter-text "You're wandering around the castle"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe)
+ :name "Castle Hallway"
+ :description "Some crappy version of Peach's Castle"
+ :enter-text "You're wandering around the castle"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe)
(ensure-zone (2 -1 0 peachs-castle-wannabe)
- :name "Castle Hallway"
- :description "Some crappy version of Peach's Castle"
- :enter-text "You're wandering around the castle"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe)
+ :name "Castle Hallway"
+ :description "Some crappy version of Peach's Castle"
+ :enter-text "You're wandering around the castle"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe)
(ensure-zone (-2 -2 0 peachs-castle-wannabe)
- :name "Castle Hallway"
- :description "Some crappy version of Peach's Castle"
- :enter-text "You're wandering around the castle"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe
- :direction-attributes (list :east (list :hidden t)
- 'painting (list :exit-text "BaBaBa-BaBa-Ba Letsago"))
- :warp-points (list 'painting '(0 0 0 peachs-castle-wannabe:race-area)))
+ :name "Castle Hallway"
+ :description "Some crappy version of Peach's Castle"
+ :enter-text "You're wandering around the castle"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe
+ :direction-attributes (list :east (list :hidden t)
+ 'painting (list :exit-text "BaBaBa-BaBa-Ba Letsago"))
+ :warp-points (list 'painting '(0 0 0 peachs-castle-wannabe:race-area)))
(ensure-zone (2 -2 0 peachs-castle-wannabe)
- :name "Castle Hallway"
- :description "Some crappy version of Peach's Castle"
- :enter-text "You're wandering around the castle"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe
- :direction-attributes (list :west (list :hidden t)
- 'painting (list :exit-text "BaBaBa-BaBa-Ba Letsago"))
- :warp-points (list 'painting '(0 0 0 peachs-castle-wannabe:thwomp-area)))
+ :name "Castle Hallway"
+ :description "Some crappy version of Peach's Castle"
+ :enter-text "You're wandering around the castle"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe
+ :direction-attributes (list :west (list :hidden t)
+ 'painting (list :exit-text "BaBaBa-BaBa-Ba Letsago"))
+ :warp-points (list 'painting '(0 0 0 peachs-castle-wannabe:thwomp-area)))
(ensure-zone (0 -2 -1 peachs-castle-wannabe)
- :name "Castle Hallway"
- :description "Some crappy version of Peach's Castle"
- :enter-text "You're wandering around the castle"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe
- :stairs (list :down)
- :props (list
- :sign (make-instance
- 'prop
- :name "Sign"
- :description "Notice: Due to a koopa making a mess on the floor because we can't be fucked to install toilets, all koopas will be required to wear these leak proof shells because they're cheaper than diapers and hold a lot more. They will be allowed to the underground pipes once a month for emptying. The princess and Bowser on the other hand will be allowed to wear diapers because as royalty we deserve to live in comfort dammit.")))
+ :name "Castle Hallway"
+ :description "Some crappy version of Peach's Castle"
+ :enter-text "You're wandering around the castle"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe
+ :stairs (list :down)
+ :props (list
+ :sign (make-instance
+ 'prop
+ :name "Sign"
+ :description "Notice: Due to a koopa making a mess on the floor because we can't be fucked to install toilets, all koopas will be required to wear these leak proof shells because they're cheaper than diapers and hold a lot more. They will be allowed to the underground pipes once a month for emptying. The princess and Bowser on the other hand will be allowed to wear diapers because as royalty we deserve to live in comfort dammit.")))
(ensure-zone (0 -1 -1 peachs-castle-wannabe)
- :name "Castle Hallway"
- :description "Some crappy version of Peach's Castle"
- :enter-text "You're wandering around the castle"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe
- :stairs (list :down)
- :direction-attributes (list 'painting (list :exit-text "BaBaBa-BaBa-Ba Letsago"))
- :warp-points (list 'painting '(0 0 0 peachs-castle-wannabe:eggman-area)))
+ :name "Castle Hallway"
+ :description "Some crappy version of Peach's Castle"
+ :enter-text "You're wandering around the castle"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe
+ :stairs (list :down)
+ :direction-attributes (list 'painting (list :exit-text "BaBaBa-BaBa-Ba Letsago"))
+ :warp-points (list 'painting '(0 0 0 peachs-castle-wannabe:eggman-area)))
(ensure-zone (0 0 0 peachs-castle-wannabe:race-area)
- :name "Race Area Map"
- :description "Race Area Map"
- :enter-text "You're wandering around the level"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe
- :events '(yadfa-events:enter-race-area-1)
- :props (list
- :truck (make-instance 'prop
- :name "Truck"
- :description "It's that truck from Big Rigs: Over The Road Racing. Stop expecting it to move, it's never going to happen.")))
+ :name "Race Area Map"
+ :description "Race Area Map"
+ :enter-text "You're wandering around the level"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe
+ :events '(yadfa-events:enter-race-area-1)
+ :props (list
+ :truck (make-instance 'prop
+ :name "Truck"
+ :description "It's that truck from Big Rigs: Over The Road Racing. Stop expecting it to move, it's never going to happen.")))
(ensure-zone (0 -1 0 peachs-castle-wannabe:race-area)
- :name "Race Area"
- :description "Race Area"
- :enter-text "You're wandering around the level"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe
- :events '(yadfa-events:win-race-area-1)
- :warp-points (list 'back-to-castle '(-2 -2 0 peachs-castle-wannabe))
- :props (list
- :truck (make-instance 'prop
- :name "Truck"
- :description "It's that truck from Big Rigs: Over The Road Racing. Stop expecting it to move, it's never going to happen.")))
+ :name "Race Area"
+ :description "Race Area"
+ :enter-text "You're wandering around the level"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe
+ :events '(yadfa-events:win-race-area-1)
+ :warp-points (list 'back-to-castle '(-2 -2 0 peachs-castle-wannabe))
+ :props (list
+ :truck (make-instance 'prop
+ :name "Truck"
+ :description "It's that truck from Big Rigs: Over The Road Racing. Stop expecting it to move, it's never going to happen.")))
(ensure-zone (0 0 0 peachs-castle-wannabe:thwomp-area)
- :name "Thwomp Area"
- :description "Thwomp Area"
- :enter-text "You're wandering around the level"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe
- :events '(yadfa-events:enter-thwomp-area-1))
+ :name "Thwomp Area"
+ :description "Thwomp Area"
+ :enter-text "You're wandering around the level"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe
+ :events '(yadfa-events:enter-thwomp-area-1))
(ensure-zone (0 -1 0 peachs-castle-wannabe:thwomp-area)
- :name "Thwomp Area"
- :description "Thwomp Area"
- :enter-text "You walk around the thwomp and move to the north"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe
- :warp-points (list 'back-to-castle '(2 -2 0 peachs-castle-wannabe))
- :events '(yadfa-events:win-thwomp-area-1))
+ :name "Thwomp Area"
+ :description "Thwomp Area"
+ :enter-text "You walk around the thwomp and move to the north"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe
+ :warp-points (list 'back-to-castle '(2 -2 0 peachs-castle-wannabe))
+ :events '(yadfa-events:win-thwomp-area-1))
(ensure-zone (0 0 0 peachs-castle-wannabe:pokemon-area)
- :name "Pokémon Area"
- :description "Pokémon Area"
- :enter-text "You're wandering around the level"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe
- :events '(yadfa-events:enter-pokemon-area-1)
- :warp-points (list 'back-to-castle '(-1 -4 1 peachs-castle-wannabe)))
+ :name "Pokémon Area"
+ :description "Pokémon Area"
+ :enter-text "You're wandering around the level"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe
+ :events '(yadfa-events:enter-pokemon-area-1)
+ :warp-points (list 'back-to-castle '(-1 -4 1 peachs-castle-wannabe)))
(ensure-zone (0 0 0 peachs-castle-wannabe:blank-area)
- :name "Pokémon Area"
- :description "Pokémon Area"
- :enter-text "You're wandering around the level"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe
- :events '(yadfa-events:enter-blank-area-1)
- :warp-points (list 'back-to-castle '(1 -4 1 peachs-castle-wannabe)))
+ :name "Pokémon Area"
+ :description "Pokémon Area"
+ :enter-text "You're wandering around the level"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe
+ :events '(yadfa-events:enter-blank-area-1)
+ :warp-points (list 'back-to-castle '(1 -4 1 peachs-castle-wannabe)))
(ensure-zone (0 0 0 peachs-castle-wannabe:eggman-area)
- :name "Eggman Area"
- :description "Eggman Area"
- :enter-text "You're wandering around the level"
- :can-potty 'can-potty-peachs-castle-wannabe
- :potty-trigger 'potty-trigger-peachs-castle-wannabe
- :events '(yadfa-events:enter-eggman-area-1)
- :warp-points (list 'back-to-castle '(0 -1 -1 peachs-castle-wannabe)))
+ :name "Eggman Area"
+ :description "Eggman Area"
+ :enter-text "You're wandering around the level"
+ :can-potty 'can-potty-peachs-castle-wannabe
+ :potty-trigger 'potty-trigger-peachs-castle-wannabe
+ :events '(yadfa-events:enter-eggman-area-1)
+ :warp-points (list 'back-to-castle '(0 -1 -1 peachs-castle-wannabe)))
diff --git a/data/map/pirates-cove.lisp b/data/map/pirates-cove.lisp
index f974e26..f923e85 100644
--- a/data/map/pirates-cove.lisp
+++ b/data/map/pirates-cove.lisp
@@ -1,50 +1,50 @@
;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa-zones"; coding: utf-8-unix; -*-
(in-package :yadfa-zones)
(ensure-zone (0 0 0 pirates-cove)
- :name "Pirate's Cove Entrance"
- :description "The entrance to Pirate's Cove"
- :enter-text "You're inside Pirate's Cove"
- :enemy-spawn-list (list '(:chance 1/8
- :enemies ((yadfa-enemies:diaper-pirate . (list :level (random-from-range 4 8)))))))
+ :name "Pirate's Cove Entrance"
+ :description "The entrance to Pirate's Cove"
+ :enter-text "You're inside Pirate's Cove"
+ :enemy-spawn-list (list '(:chance 1/8
+ :enemies ((yadfa-enemies:diaper-pirate . (list :level (random-from-range 4 8)))))))
(ensure-zone (0 1 0 pirates-cove)
- :name "Pirate's Cove"
- :description "Where a bunch of pirates live"
- :enter-text "You're inside Pirate's Cove"
- :enemy-spawn-list (list '(:chance 1/8
- :enemies ((yadfa-enemies:diaper-pirate . (list :level (random-from-range 4 8)))))))
+ :name "Pirate's Cove"
+ :description "Where a bunch of pirates live"
+ :enter-text "You're inside Pirate's Cove"
+ :enemy-spawn-list (list '(:chance 1/8
+ :enemies ((yadfa-enemies:diaper-pirate . (list :level (random-from-range 4 8)))))))
(ensure-zone (0 2 0 pirates-cove)
- :name "Pirate's Cove"
- :description "Where a bunch of pirates live"
- :enter-text "You're inside Pirate's Cove"
- :enemy-spawn-list (list '(:chance 1/8
- :enemies ((yadfa-enemies:diaper-pirate . (list :level (random-from-range 4 8)))))))
+ :name "Pirate's Cove"
+ :description "Where a bunch of pirates live"
+ :enter-text "You're inside Pirate's Cove"
+ :enemy-spawn-list (list '(:chance 1/8
+ :enemies ((yadfa-enemies:diaper-pirate . (list :level (random-from-range 4 8)))))))
(ensure-zone (0 3 0 pirates-cove)
- :name "Pirate's Cove"
- :description "Where a bunch of pirates live"
- :enter-text "You're inside Pirate's Cove"
- :events '(yadfa-events:pirates-cove-1)
- :enemy-spawn-list (list '(:chance 1/8
- :enemies ((yadfa-enemies:diaper-pirate . (list :level (random-from-range 4 8)))))))
+ :name "Pirate's Cove"
+ :description "Where a bunch of pirates live"
+ :enter-text "You're inside Pirate's Cove"
+ :events '(yadfa-events:pirates-cove-1)
+ :enemy-spawn-list (list '(:chance 1/8
+ :enemies ((yadfa-enemies:diaper-pirate . (list :level (random-from-range 4 8)))))))
(ensure-zone (1 0 0 pirates-cove)
- :name "Pirate's Cove Lighthouse"
- :description "A lighthouse"
- :enter-text "You're inside Pirate's Cove"
- :enemy-spawn-list (list '(:chance 1/8
- :enemies ((yadfa-enemies:diaper-pirate . (list :level (random-from-range 4 8)))))))
+ :name "Pirate's Cove Lighthouse"
+ :description "A lighthouse"
+ :enter-text "You're inside Pirate's Cove"
+ :enemy-spawn-list (list '(:chance 1/8
+ :enemies ((yadfa-enemies:diaper-pirate . (list :level (random-from-range 4 8)))))))
#.`(progn
,@(iter (for i from 0 to 10)
- (collect `(ensure-zone (1 0 ,i pirates-cove)
- :name "Pirate's Cove Lighthouse"
- :description "A lighthouse"
- :enter-text "You're inside Pirate's Cove"
- :stairs (list ,@(typecase i
- ((eql 0)
- '(:up))
- ((eql 10)
- '(:down))
- (t '(:up :down))))
- :enemy-spawn-list '((:chance 1/8
- :enemies ((yadfa-enemies:diaper-pirate .
- (list :level (random-from-range 4 8))))))
- ,@(when (= i 10)
- '(:events '(yadfa-events:pirates-cove-2)))))))
+ (collect `(ensure-zone (1 0 ,i pirates-cove)
+ :name "Pirate's Cove Lighthouse"
+ :description "A lighthouse"
+ :enter-text "You're inside Pirate's Cove"
+ :stairs (list ,@(typecase i
+ ((eql 0)
+ '(:up))
+ ((eql 10)
+ '(:down))
+ (t '(:up :down))))
+ :enemy-spawn-list '((:chance 1/8
+ :enemies ((yadfa-enemies:diaper-pirate .
+ (list :level (random-from-range 4 8))))))
+ ,@(when (= i 10)
+ '(:events '(yadfa-events:pirates-cove-2)))))))
diff --git a/data/map/pyramid.lisp b/data/map/pyramid.lisp
index fc0c7fb..59101c6 100644
--- a/data/map/pyramid.lisp
+++ b/data/map/pyramid.lisp
@@ -1,17 +1,17 @@
;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa-zones"; coding: utf-8-unix; -*-
(in-package :yadfa-zones)
(ensure-zone (0 0 0 yadfa-zones:pyramid)
- :name "Pyramid Entrance"
- :description "You're at the pyramid entrance"
- :must-wear 'pyramid
- :must-not-wear 'pyramid
- :must-wear* 'pyramid
- :must-not-wear* 'pyramid)
+ :name "Pyramid Entrance"
+ :description "You're at the pyramid entrance"
+ :must-wear 'pyramid
+ :must-not-wear 'pyramid
+ :must-wear* 'pyramid
+ :must-not-wear* 'pyramid)
(ensure-zone (1 0 0 yadfa-zones:pyramid)
- :name "Pyramid Hall"
- :description "You're at the pyramid entrance"
- :must-wear 'pyramid
- :must-not-wear 'pyramid
- :must-wear* 'pyramid
- :must-not-wear* 'pyramid
- :events '(yadfa-events:pyramid-puzzle-1))
+ :name "Pyramid Hall"
+ :description "You're at the pyramid entrance"
+ :must-wear 'pyramid
+ :must-not-wear 'pyramid
+ :must-wear* 'pyramid
+ :must-not-wear* 'pyramid
+ :events '(yadfa-events:pyramid-puzzle-1))
diff --git a/data/map/rpgmaker-dungeon.lisp b/data/map/rpgmaker-dungeon.lisp
index 49be2c0..f5c0a80 100644
--- a/data/map/rpgmaker-dungeon.lisp
+++ b/data/map/rpgmaker-dungeon.lisp
@@ -17,25 +17,25 @@
(labels ((walk (x y width height)
(push (list x y) visited)
(iter (for (u v w) in (alexandria:shuffle (neighbors x y width height)))
- (unless (member (list u v) visited :test #'equal)
- (setf (getf-direction `(,x ,y 0 rpgmaker-dungeon) w :hidden) nil
- (getf-direction `(,u ,v 0 rpgmaker-dungeon)
- (getf '(:south :north
- :north :south
- :east :west
- :west :east) w) :hidden) nil)
- (walk u v width height)))))
+ (unless (member (list u v) visited :test #'equal)
+ (setf (getf-direction `(,x ,y 0 rpgmaker-dungeon) w :hidden) nil
+ (getf-direction `(,u ,v 0 rpgmaker-dungeon)
+ (getf '(:south :north
+ :north :south
+ :east :west
+ :west :east) w) :hidden) nil)
+ (walk u v width height)))))
(walk (random width) (random height) width height))))
(iter (for x from 0 to (1- width))
- (iter (for y from 0 to (1- height))
- (defzone* `(,x ,y 0 rpgmaker-dungeon)
- :name "Generic Cookie Cutter Dungeon"
- :description "Time for an \"adventure\""
- :direction-attributes (list :north (list :hidden t)
- :south (list :hidden t)
- :east (list :hidden t)
- :west (list :hidden t))
- :enemy-spawn-list 'rpgmaker-dungeon)))
+ (iter (for y from 0 to (1- height))
+ (defzone* `(,x ,y 0 rpgmaker-dungeon)
+ :name "Generic Cookie Cutter Dungeon"
+ :description "Time for an \"adventure\""
+ :direction-attributes (list :north (list :hidden t)
+ :south (list :hidden t)
+ :east (list :hidden t)
+ :west (list :hidden t))
+ :enemy-spawn-list 'rpgmaker-dungeon)))
(remove-wall width height)
(setf (getf (warp-points-of (get-zone '(5 9 0 rpgmaker-dungeon))) 'bandits-domain)
'(0 31 0 bandits-domain)
diff --git a/data/map/secret-underground.lisp b/data/map/secret-underground.lisp
index ff55ff4..af3ebb5 100644
--- a/data/map/secret-underground.lisp
+++ b/data/map/secret-underground.lisp
@@ -1,48 +1,48 @@
;;;; -*- mode: Common-Lisp; sly-buffer-package: "yadfa-zones"; coding: utf-8-unix; -*-
(in-package :yadfa-zones)
(ensure-zone (0 0 0 secret-underground)
- :name "Secret Underground"
- :description "You see several warp pipes in here going to various places"
- :enter-text "You're wandering around in the secret underground"
- :warp-points (list 'home '(0 1 0 home)
- 'ironside '(2 0 0 ironside)
- 'bandits-domain '(-3 21 0 bandits-domain)))
+ :name "Secret Underground"
+ :description "You see several warp pipes in here going to various places"
+ :enter-text "You're wandering around in the secret underground"
+ :warp-points (list 'home '(0 1 0 home)
+ 'ironside '(2 0 0 ironside)
+ 'bandits-domain '(-3 21 0 bandits-domain)))
(ensure-zone (0 1 0 secret-underground)
- :name "Secret Underground Path"
- :description "A path"
- :enter-text "You're wandering around in the secret underground")
+ :name "Secret Underground Path"
+ :description "A path"
+ :enter-text "You're wandering around in the secret underground")
(ensure-zone (-1 1 0 secret-underground)
- :name "Secret Underground Base"
- :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)
- :chest (make-instance 'prop
- :name "Dresser"
- :placeable t
- :description "You can store your items here")
- :checkpoint (make-instance 'yadfa-props:checkpoint)
- :diaper-dispenser (make-instance 'prop
- :name "Diaper/Pullup Dispenser"
- :description "Provides an infinite supply of diapers and pullups"
- :actions
- (list :get-diaper (make-action
- :documentation "Get a diaper from the dispenser, pass :diaper to OUT-ITEM to get a diaper or :pullups to get pullups"
- :lambda '(lambda
- (prop &rest keys &key (out-item :diaper) &allow-other-keys)
- (declare (type prop prop)
- (type (or (eql :diaper) (eql :pullup)) out-item)
- (ignore prop))
- (check-type prop prop)
- (check-type out-item '(or (eql :diaper) (eql :pullup)))
- (push (make-instance
- (cond ((eq out-item :diaper) 'yadfa-items:diaper)
- ((eq out-item :pullups) 'yadfa-items:pullups)))
- (inventory-of (player-of *game*)))))))))
+ :name "Secret Underground Base"
+ :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)
+ :chest (make-instance 'prop
+ :name "Dresser"
+ :placeable t
+ :description "You can store your items here")
+ :checkpoint (make-instance 'yadfa-props:checkpoint)
+ :diaper-dispenser (make-instance 'prop
+ :name "Diaper/Pullup Dispenser"
+ :description "Provides an infinite supply of diapers and pullups"
+ :actions
+ (list :get-diaper (make-action
+ :documentation "Get a diaper from the dispenser, pass :diaper to OUT-ITEM to get a diaper or :pullups to get pullups"
+ :lambda '(lambda
+ (prop &rest keys &key (out-item :diaper) &allow-other-keys)
+ (declare (type prop prop)
+ (type (or (eql :diaper) (eql :pullup)) out-item)
+ (ignore prop))
+ (check-type prop prop)
+ (check-type out-item '(or (eql :diaper) (eql :pullup)))
+ (push (make-instance
+ (cond ((eq out-item :diaper) 'yadfa-items:diaper)
+ ((eq out-item :pullups) 'yadfa-items:pullups)))
+ (inventory-of (player-of *game*)))))))))
(ensure-zone (1 1 0 secret-underground)
- :name "Secret Underground 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)))))
+ :name "Secret Underground 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/map/silver-cape.lisp b/data/map/silver-cape.lisp
index 04f0c96..c604fdf 100644
--- a/data/map/silver-cape.lisp
+++ b/data/map/silver-cape.lisp
@@ -2,225 +2,225 @@
(in-package :yadfa-zones)
#.`(progn
,@(iter (for i from 0 to 20)
- (collect
- `(ensure-zone (0 ,i 0 silver-cape)
- :name "Silver Cape Street"
- :description "A busy street with various furries moving back and forth"
- :enter-text "You enter the street"
- :warp-points ,(when (= i 0) '(list 'rpgmaker-dungeon '(0 5 0 rpgmaker-dungeon)))
- ,@(cond ((= i 7)
- '(:direction-attributes (list :east (list :hidden t)))))
- ,@(when (= i 0) '(:events '(yadfa-events:enter-silver-cape-1 yadfa-events:secret-underground-pipe-silver-cape))))))
+ (collect
+ `(ensure-zone (0 ,i 0 silver-cape)
+ :name "Silver Cape Street"
+ :description "A busy street with various furries moving back and forth"
+ :enter-text "You enter the street"
+ :warp-points ,(when (= i 0) '(list 'rpgmaker-dungeon '(0 5 0 rpgmaker-dungeon)))
+ ,@(cond ((= i 7)
+ '(:direction-attributes (list :east (list :hidden t)))))
+ ,@(when (= i 0) '(:events '(yadfa-events:enter-silver-cape-1 yadfa-events:secret-underground-pipe-silver-cape))))))
,@(iter (for i from -10 to 10)
- (unless (= i 0)
- (collect
- `(ensure-zone (,i 10 0 silver-cape)
- :name "Silver Cape Street"
- :description "A busy street with various furries moving back and forth"
- :enter-text "You enter the street")))))
+ (unless (= i 0)
+ (collect
+ `(ensure-zone (,i 10 0 silver-cape)
+ :name "Silver Cape Street"
+ :description "A busy street with various furries moving back and forth"
+ :enter-text "You enter the street")))))
(ensure-zone (-1 6 0 silver-cape)
- :name "Silver Cape Navy HQ Entrance"
- :description "The entrance to Navy HQ."
- :enter-text "You're inside Navy HQ. The navy here seems to mostly consist of various aquatic creatures. They're mostly potty trained but still wear pullups just in case they don't make it in time, or if they don't want to hold it any longer. Due to pullups having a lower capacity than diapers, some of them supplement pullups with stuffers.")
+ :name "Silver Cape Navy HQ Entrance"
+ :description "The entrance to Navy HQ."
+ :enter-text "You're inside Navy HQ. The navy here seems to mostly consist of various aquatic creatures. They're mostly potty trained but still wear pullups just in case they don't make it in time, or if they don't want to hold it any longer. Due to pullups having a lower capacity than diapers, some of them supplement pullups with stuffers.")
(ensure-zone (-2 6 -1 silver-cape)
- :name "Silver Cape Jail"
- :description "The jail beneath Navy HQ"
- :enter-text "You're inside Navy HQ"
- :locked t
- :stairs (list :up)
- :events '(yadfa-events:get-location-to-pirate-cove-1))
+ :name "Silver Cape Jail"
+ :description "The jail beneath Navy HQ"
+ :enter-text "You're inside Navy HQ"
+ :locked t
+ :stairs (list :up)
+ :events '(yadfa-events:get-location-to-pirate-cove-1))
(ensure-zone (-2 6 0 silver-cape)
- :name "Silver Cape Navy HQ Lobby"
- :description "The lobby of Navy HQ"
- :stairs (list :down)
- :enter-text "You're inside Navy HQ. A guard doing a potty dance in a soggy pullup is guarding the entrance to the Jail underneath"
- :props (list :guard (make-instance 'prop
- :name "Dolphin Navy Guard"
- :description "The dolphin is hopping around while holding the front of his soggy pullups squishing with each hop"
- :actions
- (list :talk (make-action
- :documentation "Talk to the guard"
- :lambda '(lambda
- (prop &rest keys &key &allow-other-keys)
- (declare (type prop prop) (ignore prop))
- (check-type prop prop)
- (write-line "Dolphin: Welcome to navy HQ")
- (format t "~a: Why don't you go to the bathroom and change your pullups?~%" (name-of (player-of *game*)))
- (write-line "Dolphin: I'm not allowed to go to the bathroom during my shift and if I leak again they'll put me back in diapers and put me in the nursery.")
- (format t "~a: Ok~%" (name-of (player-of *game*)))
- (setf (getf-action-from-prop (position-of (player-of *game*)) :guard :tickle)
- (make-action :documentation "Tickle the dolphin"
- :lambda '(lambda
- (prop &rest keys &key &allow-other-keys)
- (declare (type prop prop) (ignore prop))
- (write-line "Dolphin: ACK!! NO!! PLEASE!!! DON'T!!!")
- (write-line "*The dolphin giggles and thrashes about then leaves a puddle on the floor*")
- (write-line "*One of the Navy orcas take notice and crinkles over*")
- (write-line "Orca: Looks like the baby dolphin still hasn't learned to not leave puddles everywhere")
- (write-line "Dolphin: I'm not a baby!!!")
- (write-line "Orca: Says the baby in leaky pullups. Since you keep leaving puddles, we're putting you back in diapers.")
- (write-line "*The Orca lays the dolphin on the floor*")
- (write-line "Dolphin: Please don't change me here!!! Everyone can see me!!!!!")
- (write-line "*The Orca ignores his pleas and changes his soggy pullups and puts him in a thick diaper then stands him back up. The diaper is so thick that his legs are forced apart. The dolphin hides his face in embarrassment as he is escorted to a nursery*")
- (write-line "*The Jail beneath the cell is now unguarded and can be entered*")
- (setf (lockedp (get-zone '(-2 6 -1 silver-cape))) :nil
- (enter-text-of (get-zone (-2 6 0 silver-cape))) "You're inside Navy HQ.")
- (remf (get-props-from-zone (position-of (player-of *game*))) :guard))))
- (setf (getf-action-from-prop (position-of (player-of *game*)) :guard :give-pad)
- (make-action
- :documentation "Give the dolphin a stuffer so he can go without making a puddle"
- :lambda '(lambda (prop &rest keys &key &allow-other-keys)
- (declare (type prop prop) (ignore prop))
- (block nil
- (let
- ((a (iter (for i in (inventory-of (player-of *game*)))
- (when (and (typep i 'stuffer) (<= (sogginess-of i) 0))
- (collect i)))))
- (unless a
- (write-line "You don't have a clean stuffer to give her")
- (return))
- (write-line "*You hand the dolphin a stuffer*")
- (format t "~a: Here, you might want this~%" (name-of (player-of *game*)))
- (write-line "Dolphin: I'm no infant. I can hold it in.")
- (write-line "*The dolphin panics as his bladder leaks a little*")
- (write-line "Dolphin: OK, OK, I'll take them.")
- (write-line "*The dolphin quickly inserts the stuffer into his pullups and floods himself*")
- (write-line "Dolphin: Don't tell anyone about this incident and I'll let you through")
- (write-line "*The Jail beneath can now be entered*")
- (removef (inventory-of (player-of *game*)) (car a))
- (setf (lockedp (get-zone '(-2 6 -1 silver-cape))) :nil
- (enter-text-of (get-zone (-2 6 0 silver-cape))) "You're inside Navy HQ."
- (actions-of (getf (get-props-from-zone (position-of (player-of *game*)))
- :guard))
- (list :talk (make-action
- :documentation "Talk to the guard"
- :lambda '(lambda
- (prop &rest keys &key &allow-other-keys)
- (declare (type prop prop) (ignore prop))
- (write-line "Dolphin: Welcome to navy HQ"))))
- (description-of
- (getf (get-props-from-zone (position-of (player-of *game*))) :guard))
- "A dolphin wearing pullups"))))))))))))
+ :name "Silver Cape Navy HQ Lobby"
+ :description "The lobby of Navy HQ"
+ :stairs (list :down)
+ :enter-text "You're inside Navy HQ. A guard doing a potty dance in a soggy pullup is guarding the entrance to the Jail underneath"
+ :props (list :guard (make-instance 'prop
+ :name "Dolphin Navy Guard"
+ :description "The dolphin is hopping around while holding the front of his soggy pullups squishing with each hop"
+ :actions
+ (list :talk (make-action
+ :documentation "Talk to the guard"
+ :lambda '(lambda
+ (prop &rest keys &key &allow-other-keys)
+ (declare (type prop prop) (ignore prop))
+ (check-type prop prop)
+ (write-line "Dolphin: Welcome to navy HQ")
+ (format t "~a: Why don't you go to the bathroom and change your pullups?~%" (name-of (player-of *game*)))
+ (write-line "Dolphin: I'm not allowed to go to the bathroom during my shift and if I leak again they'll put me back in diapers and put me in the nursery.")
+ (format t "~a: Ok~%" (name-of (player-of *game*)))
+ (setf (getf-action-from-prop (position-of (player-of *game*)) :guard :tickle)
+ (make-action :documentation "Tickle the dolphin"
+ :lambda '(lambda
+ (prop &rest keys &key &allow-other-keys)
+ (declare (type prop prop) (ignore prop))
+ (write-line "Dolphin: ACK!! NO!! PLEASE!!! DON'T!!!")
+ (write-line "*The dolphin giggles and thrashes about then leaves a puddle on the floor*")
+ (write-line "*One of the Navy orcas take notice and crinkles over*")
+ (write-line "Orca: Looks like the baby dolphin still hasn't learned to not leave puddles everywhere")
+ (write-line "Dolphin: I'm not a baby!!!")
+ (write-line "Orca: Says the baby in leaky pullups. Since you keep leaving puddles, we're putting you back in diapers.")
+ (write-line "*The Orca lays the dolphin on the floor*")
+ (write-line "Dolphin: Please don't change me here!!! Everyone can see me!!!!!")
+ (write-line "*The Orca ignores his pleas and changes his soggy pullups and puts him in a thick diaper then stands him back up. The diaper is so thick that his legs are forced apart. The dolphin hides his face in embarrassment as he is escorted to a nursery*")
+ (write-line "*The Jail beneath the cell is now unguarded and can be entered*")
+ (setf (lockedp (get-zone '(-2 6 -1 silver-cape))) :nil
+ (enter-text-of (get-zone (-2 6 0 silver-cape))) "You're inside Navy HQ.")
+ (remf (get-props-from-zone (position-of (player-of *game*))) :guard))))
+ (setf (getf-action-from-prop (position-of (player-of *game*)) :guard :give-pad)
+ (make-action
+ :documentation "Give the dolphin a stuffer so he can go without making a puddle"
+ :lambda '(lambda (prop &rest keys &key &allow-other-keys)
+ (declare (type prop prop) (ignore prop))
+ (block nil
+ (let
+ ((a (iter (for i in (inventory-of (player-of *game*)))
+ (when (and (typep i 'stuffer) (<= (sogginess-of i) 0))
+ (collect i)))))
+ (unless a
+ (write-line "You don't have a clean stuffer to give her")
+ (return))
+ (write-line "*You hand the dolphin a stuffer*")
+ (format t "~a: Here, you might want this~%" (name-of (player-of *game*)))
+ (write-line "Dolphin: I'm no infant. I can hold it in.")
+ (write-line "*The dolphin panics as his bladder leaks a little*")
+ (write-line "Dolphin: OK, OK, I'll take them.")
+ (write-line "*The dolphin quickly inserts the stuffer into his pullups and floods himself*")
+ (write-line "Dolphin: Don't tell anyone about this incident and I'll let you through")
+ (write-line "*The Jail beneath can now be entered*")
+ (removef (inventory-of (player-of *game*)) (car a))
+ (setf (lockedp (get-zone '(-2 6 -1 silver-cape))) :nil
+ (enter-text-of (get-zone (-2 6 0 silver-cape))) "You're inside Navy HQ."
+ (actions-of (getf (get-props-from-zone (position-of (player-of *game*)))
+ :guard))
+ (list :talk (make-action
+ :documentation "Talk to the guard"
+ :lambda '(lambda
+ (prop &rest keys &key &allow-other-keys)
+ (declare (type prop prop) (ignore prop))
+ (write-line "Dolphin: Welcome to navy HQ"))))
+ (description-of
+ (getf (get-props-from-zone (position-of (player-of *game*))) :guard))
+ "A dolphin wearing pullups"))))))))))))
(ensure-zone (1 5 0 silver-cape)
- :name "Silver Cape Pokémon Center"
- :description "A place to heal your Pokémon"
- :enter-text "You enter the street"
- :direction-attributes (list :south (list :hidden t))
- :props (list :magic-healing-machine (make-instance 'prop
- :name "Magic Healing Machine"
- :description "Heal your Pokémon here"
- :actions (list
- :use (make-action
- :documentation "Heal your Pokémon"
- :lambda '(lambda
- (prop &rest keys &key &allow-other-keys)
- (declare (type prop prop) (ignore prop))
- (check-type prop prop)
- (format t "~a~%" "https://youtu.be/wcg5n2UVMss?t=134")
- (setf (health-of user) (calculate-stat user :health))
- (setf (energy-of user) (calculate-stat user :energy))))))))
+ :name "Silver Cape Pokémon Center"
+ :description "A place to heal your Pokémon"
+ :enter-text "You enter the street"
+ :direction-attributes (list :south (list :hidden t))
+ :props (list :magic-healing-machine (make-instance 'prop
+ :name "Magic Healing Machine"
+ :description "Heal your Pokémon here"
+ :actions (list
+ :use (make-action
+ :documentation "Heal your Pokémon"
+ :lambda '(lambda
+ (prop &rest keys &key &allow-other-keys)
+ (declare (type prop prop) (ignore prop))
+ (check-type prop prop)
+ (format t "~a~%" "https://youtu.be/wcg5n2UVMss?t=134")
+ (setf (health-of user) (calculate-stat user :health))
+ (setf (energy-of user) (calculate-stat user :energy))))))))
(ensure-zone (1 6 0 silver-cape)
- :name "Quadruple Bypazz"
- :description "The local fastfood joint"
- :enter-text "You enter the street"
- :direction-attributes (list :north (list :hidden t))
- :props (list
- :register (make-instance 'prop
- :name "Register"
- :description "Order Here"
- :actions (list
- :talk (make-action
- :documentation "Talk to the cashier"
- :lambda '(lambda
- (prop &rest keys &key &allow-other-keys)
- (declare (type prop prop) (ignore prop))
- (check-type prop prop)
- (write-line "Cashier: Welcome To The Quadruple Bypazz. We recently to moved to automated kiosks for placing your orders, since that is now all the rage nowadays, so we got one designed by the IRS, written in IBM 7074 assembly of course. What you do is you take this form and fill out your order. You fill in your name and payment method, your order number and internal serial number (cause our new automated order system is too crappy to figure this out on its own) credit/debit card information (cause our new automated order system is too crappy to get this from the card reader) and the food you want to order and its prices and sales tax (cause our new automated order system is too crappy to get the menu and pricing information out of it). You then mail this form to our main HQ where we'll manually enter it into the system by hand and you should get your food in about 3 weeks.")
- (write-line "*You decide ordering isn't worth the hassle*")))))))
+ :name "Quadruple Bypazz"
+ :description "The local fastfood joint"
+ :enter-text "You enter the street"
+ :direction-attributes (list :north (list :hidden t))
+ :props (list
+ :register (make-instance 'prop
+ :name "Register"
+ :description "Order Here"
+ :actions (list
+ :talk (make-action
+ :documentation "Talk to the cashier"
+ :lambda '(lambda
+ (prop &rest keys &key &allow-other-keys)
+ (declare (type prop prop) (ignore prop))
+ (check-type prop prop)
+ (write-line "Cashier: Welcome To The Quadruple Bypazz. We recently to moved to automated kiosks for placing your orders, since that is now all the rage nowadays, so we got one designed by the IRS, written in IBM 7074 assembly of course. What you do is you take this form and fill out your order. You fill in your name and payment method, your order number and internal serial number (cause our new automated order system is too crappy to figure this out on its own) credit/debit card information (cause our new automated order system is too crappy to get this from the card reader) and the food you want to order and its prices and sales tax (cause our new automated order system is too crappy to get the menu and pricing information out of it). You then mail this form to our main HQ where we'll manually enter it into the system by hand and you should get your food in about 3 weeks.")
+ (write-line "*You decide ordering isn't worth the hassle*")))))))
(ensure-zone (1 7 0 silver-cape)
- :name "Bathroom Door"
- :description "It's always occupied so nyah"
- :direction-attributes (list :west (list :hidden t))
- :enter-text '(lambda ()
- (cond ((>= (bladder/contents-of (player-of *game*)) (bladder/potty-dance-limit-of (player-of *game*)))
- (alexandria:random-elt '("One of the diapered raccoon bandits waddles by you crinkling clutching the front of his diaper and scurries into the bathroom and locks the door. You groan while doing a potty dance in response."
- "An orca in pullups rushes by you clutching the front of his pullups and runs into the bathroom and locks the door. You groan while doing a potty dance in response."
- "A diapered raccoon bandit is whining hopping from foot to foot in front of the locked bathroom door holding the front of his diaper waiting for it to open until he floods his diapers, then waddles away in embarrassment. You nearly piddle yourself from the sound of him piddling."
- "You see a diapered skunk in front of the locked bathroom door with a look of relief on his face flooding his diapers. You're almost jealous of him."
- "You head to the bathroom then groan while doing a potty dance when you find that the door is locked."
- #.(format nil "You see a diapered skunk leaking all over in front of the locked bathroom door with a look of relief on his face flooding his already overflowing diapers and leaving a puddle on the floor.~%~%Diapered Raccoon Bandit holding his nose with both paws: Can you please go be stinky somewhere else?"))))
- ((>= (bowels/contents-of (player-of *game*)) (bowels/potty-dance-limit-of (player-of *game*)))
- (alexandria:random-elt '("One of the diapered raccoon bandits waddles by you crinkling clutching the front of his diaper and scurries into the bathroom and locks the door. You groan while doing a potty dance in response."
- "An orca in pullups rushes by you clutching the front of his pullups and runs into the bathroom and locks the door. You groan while doing a potty dance in response."
- "A diapered raccoon bandit waiting in front of the bathroom door involuntarily squats down and messes his pamps, then waddles away in embarrassment. You nearly mess yourself from the sound of him messing."
- "You see a diapered skunk in front of the locked bathroom door squatting down and filling his diapers. You're almost jealous of him."
- "You head to the bathroom then groan while doing a potty dance when you find that the door is locked."
- #.(format nil "You see a diapered skunk leaking all over in front of the locked bathroom door squatting down and filling his already overflowing diapers and leaving a mess on the floor.~%~%Diapered Raccoon Bandit holding his nose with both paws: Can you please go be stinky somewhere else?"))))
- (t
- (alexandria:random-elt '("One of the diapered raccoon bandits waddles by you crinkling clutching the front of his diaper and scurries into the bathroom and locks the door."
- "An orca in pullups rushes by you clutching the front of his pullups and runs into the bathroom and locks the door."
- "A diapered raccoon bandit is whining hopping from foot to foot in front of the locked bathroom door holding the front of his diaper waiting for it to open until he floods his diapers, then waddles away in embarrassment."
- "A diapered raccoon bandit waiting in front of the bathroom door involuntarily squats down and messes his pamps, then waddles away in embarrassment."
- "You're standing in front of a locked bathroom door."))))))
+ :name "Bathroom Door"
+ :description "It's always occupied so nyah"
+ :direction-attributes (list :west (list :hidden t))
+ :enter-text '(lambda ()
+ (cond ((>= (bladder/contents-of (player-of *game*)) (bladder/potty-dance-limit-of (player-of *game*)))
+ (alexandria:random-elt '("One of the diapered raccoon bandits waddles by you crinkling clutching the front of his diaper and scurries into the bathroom and locks the door. You groan while doing a potty dance in response."
+ "An orca in pullups rushes by you clutching the front of his pullups and runs into the bathroom and locks the door. You groan while doing a potty dance in response."
+ "A diapered raccoon bandit is whining hopping from foot to foot in front of the locked bathroom door holding the front of his diaper waiting for it to open until he floods his diapers, then waddles away in embarrassment. You nearly piddle yourself from the sound of him piddling."
+ "You see a diapered skunk in front of the locked bathroom door with a look of relief on his face flooding his diapers. You're almost jealous of him."
+ "You head to the bathroom then groan while doing a potty dance when you find that the door is locked."
+ #.(format nil "You see a diapered skunk leaking all over in front of the locked bathroom door with a look of relief on his face flooding his already overflowing diapers and leaving a puddle on the floor.~%~%Diapered Raccoon Bandit holding his nose with both paws: Can you please go be stinky somewhere else?"))))
+ ((>= (bowels/contents-of (player-of *game*)) (bowels/potty-dance-limit-of (player-of *game*)))
+ (alexandria:random-elt '("One of the diapered raccoon bandits waddles by you crinkling clutching the front of his diaper and scurries into the bathroom and locks the door. You groan while doing a potty dance in response."
+ "An orca in pullups rushes by you clutching the front of his pullups and runs into the bathroom and locks the door. You groan while doing a potty dance in response."
+ "A diapered raccoon bandit waiting in front of the bathroom door involuntarily squats down and messes his pamps, then waddles away in embarrassment. You nearly mess yourself from the sound of him messing."
+ "You see a diapered skunk in front of the locked bathroom door squatting down and filling his diapers. You're almost jealous of him."
+ "You head to the bathroom then groan while doing a potty dance when you find that the door is locked."
+ #.(format nil "You see a diapered skunk leaking all over in front of the locked bathroom door squatting down and filling his already overflowing diapers and leaving a mess on the floor.~%~%Diapered Raccoon Bandit holding his nose with both paws: Can you please go be stinky somewhere else?"))))
+ (t
+ (alexandria:random-elt '("One of the diapered raccoon bandits waddles by you crinkling clutching the front of his diaper and scurries into the bathroom and locks the door."
+ "An orca in pullups rushes by you clutching the front of his pullups and runs into the bathroom and locks the door."
+ "A diapered raccoon bandit is whining hopping from foot to foot in front of the locked bathroom door holding the front of his diaper waiting for it to open until he floods his diapers, then waddles away in embarrassment."
+ "A diapered raccoon bandit waiting in front of the bathroom door involuntarily squats down and messes his pamps, then waddles away in embarrassment."
+ "You're standing in front of a locked bathroom door."))))))
(ensure-zone (0 21 0 silver-cape)
- :name "Silver Cape Dock"
- :description "A Dock that heads to the ocean"
- :enter-text "You enter the street"
- :warp-points (list :your-ship '(-1 6 0 yadfa-zones:your-ship)))
+ :name "Silver Cape Dock"
+ :description "A Dock that heads to the ocean"
+ :enter-text "You enter the street"
+ :warp-points (list :your-ship '(-1 6 0 yadfa-zones:your-ship)))
(ensure-zone (-6 9 0 silver-cape)
- :name "Silver Cape Recycling Center"
- :description "Welcome To Silver Cape Recycling Center. We take all your crap, send it to a recycling plant across the country in a truck belching smoke and pollution, process your crap to turn it into less quality crap in machines belching more smoke and pollution, stockpile it and beg people to buy it, then send it all to ~a's garbage collector. Think of it as a more expensive and less environmentally friendly way to throw your stuff away."
- :enter-text "Welcome To Silver Cape Recycling Center. We take all your crap, send it to a recycling plant across the country in a truck belching smoke and pollution, process your crap to turn it into less quality crap in machines belching more smoke and pollution, stockpile it and beg people to buy it, then send it all to ~a's garbage collector. Think of it as a more expensive and less environmentally friendly way to throw your stuff away."
- :props (list
- :recycling-bin
- (make-instance 'prop
- :name "Magic Recycling Bin"
- :description "Throw your crap here and pretend it gets recycled into itself. Use the :TOSS action instead of YADFA-WORLD:PLACE because this game's \"engine\" is too stupid to figure out what to do with it otherwise."
- :actions (list
- :toss (make-action
- :documentation "Toss your items"
- :lambda '(lambda
- (prop &rest keys &key items &allow-other-keys)
- (declare
- (type prop prop)
- (type list items)
- (ignore keys))
- (check-type prop prop)
- (check-type items list)
- (block lambda
- (let ((items (sort (remove-duplicates items) #'<)))
- (setf items (iter (generate i in items)
- (for j in (inventory-of (player-of *game*)))
- (for k upfrom 0)
- (when (first-iteration-p)
- (next i))
- (when (= k i)
- (collect j)
- (next i))))
- (unless items
- (format t "Those items aren't valid")
- (return-from lambda))
- (iter (for i in items)
- (when (not (tossablep i))
- (format t "To avoid breaking the game, we don't accept your ~a~%~%"
- (name-of i))
- (return-from lambda))
- (iter (for i in items)
- (format t
- "You toss your ~a into the bin and pretend you're saving the planet~%"
- (name-of i)))
- (alexandria:deletef (inventory-of (player-of *game*)) items
- :test (lambda (o e)
- (member e o))))))))))))
+ :name "Silver Cape Recycling Center"
+ :description "Welcome To Silver Cape Recycling Center. We take all your crap, send it to a recycling plant across the country in a truck belching smoke and pollution, process your crap to turn it into less quality crap in machines belching more smoke and pollution, stockpile it and beg people to buy it, then send it all to ~a's garbage collector. Think of it as a more expensive and less environmentally friendly way to throw your stuff away."
+ :enter-text "Welcome To Silver Cape Recycling Center. We take all your crap, send it to a recycling plant across the country in a truck belching smoke and pollution, process your crap to turn it into less quality crap in machines belching more smoke and pollution, stockpile it and beg people to buy it, then send it all to ~a's garbage collector. Think of it as a more expensive and less environmentally friendly way to throw your stuff away."
+ :props (list
+ :recycling-bin
+ (make-instance 'prop
+ :name "Magic Recycling Bin"
+ :description "Throw your crap here and pretend it gets recycled into itself. Use the :TOSS action instead of YADFA-WORLD:PLACE because this game's \"engine\" is too stupid to figure out what to do with it otherwise."
+ :actions (list
+ :toss (make-action
+ :documentation "Toss your items"
+ :lambda '(lambda
+ (prop &rest keys &key items &allow-other-keys)
+ (declare
+ (type prop prop)
+ (type list items)
+ (ignore keys))
+ (check-type prop prop)
+ (check-type items list)
+ (block lambda
+ (let ((items (sort (remove-duplicates items) #'<)))
+ (setf items (iter (generate i in items)
+ (for j in (inventory-of (player-of *game*)))
+ (for k upfrom 0)
+ (when (first-iteration-p)
+ (next i))
+ (when (= k i)
+ (collect j)
+ (next i))))
+ (unless items
+ (format t "Those items aren't valid")
+ (return-from lambda))
+ (iter (for i in items)
+ (when (not (tossablep i))
+ (format t "To avoid breaking the game, we don't accept your ~a~%~%"
+ (name-of i))
+ (return-from lambda))
+ (iter (for i in items)
+ (format t
+ "You toss your ~a into the bin and pretend you're saving the planet~%"
+ (name-of i)))
+ (alexandria:deletef (inventory-of (player-of *game*)) items
+ :test (lambda (o e)
+ (member e o))))))))))))
(ensure-zone (6 11 0 silver-cape)
- :name "To Peach's Castle"
- :description "Path to a crappy version of Peach's Castle"
- :enter-text "You're at the entrance to some castle"
- :warp-points (list 'peachs-castle-wannabe '(0 0 0 peachs-castle-wannabe)))
+ :name "To Peach's Castle"
+ :description "Path to a crappy version of Peach's Castle"
+ :enter-text "You're at the entrance to some castle"
+ :warp-points (list 'peachs-castle-wannabe '(0 0 0 peachs-castle-wannabe)))
(ensure-zone (-1 14 0 silver-cape)
- :name "Silver Cape Launch Pad"
- :description "You're at the launch pad"
- :enter-text "Come one coma all to a trip to the Candle Carnival. An amusement park in the sky based on a dream Pouar had. For some reason, it looked a lot better in the dream. Still under construction. Use the rocket over there to fly there."
- :warp-points (list 'rocket '(0 0 0 candle-carnival))
- :direction-attributes (list 'rocket (list :exit-text "You fly over to Candle Carnival.")))
+ :name "Silver Cape Launch Pad"
+ :description "You're at the launch pad"
+ :enter-text "Come one coma all to a trip to the Candle Carnival. An amusement park in the sky based on a dream Pouar had. For some reason, it looked a lot better in the dream. Still under construction. Use the rocket over there to fly there."
+ :warp-points (list 'rocket '(0 0 0 candle-carnival))
+ :direction-attributes (list 'rocket (list :exit-text "You fly over to Candle Carnival.")))
diff --git a/data/map/sky.lisp b/data/map/sky.lisp
index 369a365..09f1ba7 100644
--- a/data/map/sky.lisp
+++ b/data/map/sky.lisp
@@ -1,87 +1,87 @@
(in-package :yadfa-zones)
(ensure-zone (0 0 0 candle-carnival)
- :name "Candle Carnival Entrance"
- :description "Welcome to Candle Carnival. An awesome theme park in the sky"
- :enter-text "Welcome to Candle Carnival. An awesome theme park in the sky"
- :events '(yadfa-events:secret-underground-pipe-candle-carnival))
+ :name "Candle Carnival Entrance"
+ :description "Welcome to Candle Carnival. An awesome theme park in the sky"
+ :enter-text "Welcome to Candle Carnival. An awesome theme park in the sky"
+ :events '(yadfa-events:secret-underground-pipe-candle-carnival))
(ensure-zone (0 -1 0 candle-carnival)
- :name "Candle Carnival Pool"
- :description "The entrance to the pool"
- :enter-text "You're swimming in the pool"
- :underwater t)
+ :name "Candle Carnival Pool"
+ :description "The entrance to the pool"
+ :enter-text "You're swimming in the pool"
+ :underwater t)
#.`(progn
,@(iter (for x from -10 to 10)
- (iter (for y from -2 downto -17)
- (collect `(ensure-zone (,x ,y 0 candle-carnival)
- :name "Candle Carnival Pool"
- :description "This pool makes up most of this floor"
- :enter-text "You're swimming in the pool"
- :underwater t)))))
+ (iter (for y from -2 downto -17)
+ (collect `(ensure-zone (,x ,y 0 candle-carnival)
+ :name "Candle Carnival Pool"
+ :description "This pool makes up most of this floor"
+ :enter-text "You're swimming in the pool"
+ :underwater t)))))
(ensure-zone (0 -18 0 candle-carnival)
- :name "Elevator"
- :description "An elevator to the upper deck"
- :enter-text "You enter the elevator"
- :stairs (list :up)
- :direction-attributes (list :up (list :exit-text "Going up")))
+ :name "Elevator"
+ :description "An elevator to the upper deck"
+ :enter-text "You enter the elevator"
+ :stairs (list :up)
+ :direction-attributes (list :up (list :exit-text "Going up")))
(ensure-zone (0 -18 1 candle-carnival)
- :name "Elevator"
- :description "An elevator to the upper deck"
- :enter-text "You enter the elevator"
- :stairs (list :down)
- :direction-attributes (list :down (list :exit-text "Going down")))
+ :name "Elevator"
+ :description "An elevator to the upper deck"
+ :enter-text "You enter the elevator"
+ :stairs (list :down)
+ :direction-attributes (list :down (list :exit-text "Going down")))
#.`(progn
,@(iter (for i from -10 to 10)
- (unless (= i -10)
- (collect `(ensure-zone (i -10 1 candle-carnival)
- :name "Catwalk"
- :description "A catwalk over the pool"
- :enter-text "You're swimming in the pool"
- :warp-points '(dive (i -10 0 candle-carnival)))))))
+ (unless (= i -10)
+ (collect `(ensure-zone (i -10 1 candle-carnival)
+ :name "Catwalk"
+ :description "A catwalk over the pool"
+ :enter-text "You're swimming in the pool"
+ :warp-points '(dive (i -10 0 candle-carnival)))))))
(ensure-zone (-11 -10 1 candle-carnival)
- :name "Water slide"
- :description "A water slide that lets you slide to the bottom"
- :enter-text "You look down the water slide"
- :warp-points '(slide-down (-10 -9 0 candle-carnival)))
+ :name "Water slide"
+ :description "A water slide that lets you slide to the bottom"
+ :enter-text "You look down the water slide"
+ :warp-points '(slide-down (-10 -9 0 candle-carnival)))
(ensure-zone (11 -10 1 candle-carnival)
- :name "Power room"
- :description "Apparently this place is powered by monkeys in hamster wheels"
- :enter-text "You're inside the power room")
+ :name "Power room"
+ :description "Apparently this place is powered by monkeys in hamster wheels"
+ :enter-text "You're inside the power room")
(ensure-zone (4 -1 1 candle-carnival)
- :name "Rocket Pad"
- :description "A rocket pad"
- :enter-text "You enter the rocket pad"
- :warp-points (list 'rocket '(0 0 0 sky-base-landing-pad))
- :direction-attributes (list 'rocket (list :exit-text "You fly over to Sky Base then drop off the rocket. The base's anti-gravity slingshot device emits a force that pulls you back up and lands you on a platform like an invisible bungee cord, but one that pulls you to different platforms instead of just one. It seems this is the primary mode of transportation here.")))
+ :name "Rocket Pad"
+ :description "A rocket pad"
+ :enter-text "You enter the rocket pad"
+ :warp-points (list 'rocket '(0 0 0 sky-base-landing-pad))
+ :direction-attributes (list 'rocket (list :exit-text "You fly over to Sky Base then drop off the rocket. The base's anti-gravity slingshot device emits a force that pulls you back up and lands you on a platform like an invisible bungee cord, but one that pulls you to different platforms instead of just one. It seems this is the primary mode of transportation here.")))
(ensure-zone (4 -18 0 candle-carnival)
- :name "Changing room"
- :description "Apparently this place is powered by monkeys in hamster wheels"
- :enter-text "You're inside the power room"
- :props (list
- :vending-machine (make-instance 'yadfa-props:shop
- :items-for-sale '((yadfa-items:disposable-swim-diaper . (list :value 10))
- (yadfa-items:diaper . (list :value 10))))))
+ :name "Changing room"
+ :description "Apparently this place is powered by monkeys in hamster wheels"
+ :enter-text "You're inside the power room"
+ :props (list
+ :vending-machine (make-instance 'yadfa-props:shop
+ :items-for-sale '((yadfa-items:disposable-swim-diaper . (list :value 10))
+ (yadfa-items:diaper . (list :value 10))))))
(ensure-zone (4 -18 0 candle-carnival)
- :name "Changing room"
- :description "A place where you can change your clothes for swimming. There's a vending machine for people to buy diapers from while they're here"
- :enter-text "You enter the changing room"
- :props (list
- :vending-machine (make-instance 'yadfa-props:vending-machine
- :items-for-sale '((yadfa-items:disposable-swim-diaper . (list :value 11))
- (yadfa-items:diaper . (list :value 10))
- (yadfa-items:pullups . (list :value 5))))))
+ :name "Changing room"
+ :description "A place where you can change your clothes for swimming. There's a vending machine for people to buy diapers from while they're here"
+ :enter-text "You enter the changing room"
+ :props (list
+ :vending-machine (make-instance 'yadfa-props:vending-machine
+ :items-for-sale '((yadfa-items:disposable-swim-diaper . (list :value 11))
+ (yadfa-items:diaper . (list :value 10))
+ (yadfa-items:pullups . (list :value 5))))))
(ensure-zone (-4 -18 0 candle-carnival)
- :name "Gift Shop"
- :description "Here you can buy stuff"
- :enter-text "You enter the shop"
- :props (list
- :shop (make-instance 'yadfa-props:shop
- :items-for-sale '((yadfa-items:disposable-swim-diaper-package)
- (yadfa-items:swim-diaper-cover)
- (yadfa-items:blanket)
- (yadfa-items:plushie)
- (yadfa-items:pirate-dress)
- (yadfa-items:pirate-shirt)
- (yadfa-items:orca-suit-lite)))))
+ :name "Gift Shop"
+ :description "Here you can buy stuff"
+ :enter-text "You enter the shop"
+ :props (list
+ :shop (make-instance 'yadfa-props:shop
+ :items-for-sale '((yadfa-items:disposable-swim-diaper-package)
+ (yadfa-items:swim-diaper-cover)
+ (yadfa-items:blanket)
+ (yadfa-items:plushie)
+ (yadfa-items:pirate-dress)
+ (yadfa-items:pirate-shirt)
+ (yadfa-items:orca-suit-lite)))))
(uiop:define-package #:sky-base
(:export
#:main-office
@@ -108,116 +108,116 @@
"Sky Base Launch Pad")))
`(progn
,@(iter
- (for sym in syms)
- (collect `(defparameter ,sym ',sym)))
+ (for sym in syms)
+ (collect `(defparameter ,sym ',sym)))
,@(iter
- (for sym in syms)
- (for name in names)
- (for desc in '("The entrance to Sky Base"
- "Where many residents of the sky base stay"
- "The entrance to the main office"
- "The entrance to Sky Base Shop"
- "A place for ABDLs to hang out"
- "Your own personal quarters"
- "Use this to head to the next area"))
- (collect `(ensure-zone (0 0 0 ,sym)
- :name ,name
- :description ,desc
- :enter-text ,(format nil "You step on the ~a entrance" name)
- :direction-attributes ',(iter (for i in syms)
- (for i-name in names)
- (unless (eq i sym)
- (collect i)
- (collect `(:exit-text ,(format nil "You jump from the ~a to the ~a" name i-name)))))
- :warp-points ',(iter (for i in syms)
- (unless (eq i sym)
- (collect i)
- (collect `(0 0 0 ,i))))
- ,@(when (eq sym 'sky-base:landing-pad)
- '(:events '(yadfa-events:secret-underground-pipe-sky-base))))))))
+ (for sym in syms)
+ (for name in names)
+ (for desc in '("The entrance to Sky Base"
+ "Where many residents of the sky base stay"
+ "The entrance to the main office"
+ "The entrance to Sky Base Shop"
+ "A place for ABDLs to hang out"
+ "Your own personal quarters"
+ "Use this to head to the next area"))
+ (collect `(ensure-zone (0 0 0 ,sym)
+ :name ,name
+ :description ,desc
+ :enter-text ,(format nil "You step on the ~a entrance" name)
+ :direction-attributes ',(iter (for i in syms)
+ (for i-name in names)
+ (unless (eq i sym)
+ (collect i)
+ (collect `(:exit-text ,(format nil "You jump from the ~a to the ~a" name i-name)))))
+ :warp-points ',(iter (for i in syms)
+ (unless (eq i sym)
+ (collect i)
+ (collect `(0 0 0 ,i))))
+ ,@(when (eq sym 'sky-base:landing-pad)
+ '(:events '(yadfa-events:secret-underground-pipe-sky-base))))))))
(ensure-zone (0 -1 0 sky-base:launch-pad)
- :name "Rocket Pad"
- :description "A rocket pad"
- :enter-text "You enter the rocket pad"
- :warp-points (list 'rocket '(0 0 0 star-city))
- :direction-attributes (list 'rocket (list :exit-text "You fly over to Star City")))
+ :name "Rocket Pad"
+ :description "A rocket pad"
+ :enter-text "You enter the rocket pad"
+ :warp-points (list 'rocket '(0 0 0 star-city))
+ :direction-attributes (list 'rocket (list :exit-text "You fly over to Star City")))
(ensure-zone (0 0 0 star-city)
- :name "Star City"
- :description "A city orbiting the planet on a giant platform"
- :enter-text "You're on the part of the pathway that acts as the city's gangway"
- :events '(yadfa-events:secret-underground-pipe-star-city))
+ :name "Star City"
+ :description "A city orbiting the planet on a giant platform"
+ :enter-text "You're on the part of the pathway that acts as the city's gangway"
+ :events '(yadfa-events:secret-underground-pipe-star-city))
#.`(progn
,@(iter
- (with a = ())
- (for y from 1 to 21)
- (alexandria:appendf
- a
- (iter (for x from -10 to 10)
- (when (or (= x 0) (= y 11))
- (collect `(ensure-zone (,x ,y 0 star-city)
- :name "Star City"
- :description "A city orbiting the planet on a giant platform"
- :enter-text "You're wondering across the platform")))))
- (finally (return a))))
+ (with a = ())
+ (for y from 1 to 21)
+ (alexandria:appendf
+ a
+ (iter (for x from -10 to 10)
+ (when (or (= x 0) (= y 11))
+ (collect `(ensure-zone (,x ,y 0 star-city)
+ :name "Star City"
+ :description "A city orbiting the planet on a giant platform"
+ :enter-text "You're wondering across the platform")))))
+ (finally (return a))))
(ensure-zone (-2 3 0 star-city)
- :name "Star City Hotel Lobby"
- :description "A luxurious hotel"
- :enter-text "you're in the hotel lobby"
- :stairs (list :up))
+ :name "Star City Hotel Lobby"
+ :description "A luxurious hotel"
+ :enter-text "you're in the hotel lobby"
+ :stairs (list :up))
#.`(progn
,@(iter (for x from -3 downto -7)
- (collect `(ensure-zone (,x 3 0 star-city)
- :name "Star City Hotel Hall"
- :description "A luxurious hotel"
- :enter-text "you're in the hall"))))
+ (collect `(ensure-zone (,x 3 0 star-city)
+ :name "Star City Hotel Hall"
+ :description "A luxurious hotel"
+ :enter-text "you're in the hall"))))
(ensure-zone (-3 2 0 star-city)
- :name "Star City Hotel Diner"
- :description "A luxurious hotel"
- :enter-text "Welcome to the diner"
- :direction-attributes (list :east (list :hidden t)
- :west (list :hidden t)))
+ :name "Star City Hotel Diner"
+ :description "A luxurious hotel"
+ :enter-text "Welcome to the diner"
+ :direction-attributes (list :east (list :hidden t)
+ :west (list :hidden t)))
(ensure-zone (-4 2 0 star-city)
- :name "Star City Hotel Shop"
- :description "A luxurious hotel"
- :enter-text "Welcome to the shop"
- :direction-attributes (list :east (list :hidden t)
- :west (list :hidden t)))
+ :name "Star City Hotel Shop"
+ :description "A luxurious hotel"
+ :enter-text "Welcome to the shop"
+ :direction-attributes (list :east (list :hidden t)
+ :west (list :hidden t)))
(ensure-zone (-5 2 0 star-city)
- :name "Star City Hotel Spa"
- :description "A luxurious hotel"
- :enter-text "Welcome to the spa"
- :direction-attributes (list :east (list :hidden t)
- :west (list :hidden t)))
+ :name "Star City Hotel Spa"
+ :description "A luxurious hotel"
+ :enter-text "Welcome to the spa"
+ :direction-attributes (list :east (list :hidden t)
+ :west (list :hidden t)))
(ensure-zone (-6 2 0 star-city)
- :name "Star City Hotel Gym"
- :description "A luxurious hotel"
- :enter-text "Welcome to the gym"
- :direction-attributes (list :east (list :hidden t)
- :west (list :hidden t)))
+ :name "Star City Hotel Gym"
+ :description "A luxurious hotel"
+ :enter-text "Welcome to the gym"
+ :direction-attributes (list :east (list :hidden t)
+ :west (list :hidden t)))
(ensure-zone (-7 2 0 star-city)
- :name "Star City Hotel Pool"
- :description "Welcome to the pool"
- :enter-text "you're in the hall"
- :direction-attributes (list :east (list :hidden t)
- :west (list :hidden t)))
+ :name "Star City Hotel Pool"
+ :description "Welcome to the pool"
+ :enter-text "you're in the hall"
+ :direction-attributes (list :east (list :hidden t)
+ :west (list :hidden t)))
(ensure-zone (-1 3 0 star-city)
- :name "Star City"
- :description "A city orbiting the planet on a giant platform"
- :enter-text "You're wondering across the platform")
+ :name "Star City"
+ :description "A city orbiting the planet on a giant platform"
+ :enter-text "You're wondering across the platform")
(ensure-zone (-2 3 1 star-city)
- :name "Star City Hotel Hallway"
- :description "A luxurious hotel"
- :enter-text "you're in the hall"
- :stairs (list :up :down))
+ :name "Star City Hotel Hallway"
+ :description "A luxurious hotel"
+ :enter-text "you're in the hall"
+ :stairs (list :up :down))
#.`(progn
,@(iter (for x from -1 downto -5)
- (collect `(ensure-zone (,x 3 1 star-city)
- :name "Star City Hotel Hall"
- :description "A luxurious hotel"
- :enter-text "you're in the hall"))))
+ (collect `(ensure-zone (,x 3 1 star-city)
+ :name "Star City Hotel Hall"
+ :description "A luxurious hotel"
+ :enter-text "you're in the hall"))))
(ensure-zone (0 22 0 star-city)
- :name "Star City"
- :description "A city orbiting the planet on a giant platform"
- :enter-text "You're wondering across the platform"
- :warp-points (list 'rainbow-slide '(6 11 0 silver-cape))
- :direction-attributes (list 'rainbow-slide (list :exit-text "You slide down the slide back to the planet.")))
+ :name "Star City"
+ :description "A city orbiting the planet on a giant platform"
+ :enter-text "You're wondering across the platform"
+ :warp-points (list 'rainbow-slide '(6 11 0 silver-cape))
+ :direction-attributes (list 'rainbow-slide (list :exit-text "You slide down the slide back to the planet.")))
diff --git a/data/map/your-ship.lisp b/data/map/your-ship.lisp
index 460f90a..c621d10 100644
--- a/data/map/your-ship.lisp
+++ b/data/map/your-ship.lisp
@@ -2,171 +2,171 @@
(in-package :yadfa-zones)
#.`(progn
,@(iter (for y from 0 to 2)
- (iter (for x from (- y) to y)
- (collect `(ensure-zone (,x ,y 0 your-ship)
- :name "Emacs"
- :description "The bow of your ship"
- :direction-attributes (list :south (list
- :hidden ,(and
- (or (= x 1) (= x -1))
- (= y 2)))
- :down (list :hidden t)
- :up (list :hidden t))))))
+ (iter (for x from (- y) to y)
+ (collect `(ensure-zone (,x ,y 0 your-ship)
+ :name "Emacs"
+ :description "The bow of your ship"
+ :direction-attributes (list :south (list
+ :hidden ,(and
+ (or (= x 1) (= x -1))
+ (= y 2)))
+ :down (list :hidden t)
+ :up (list :hidden t))))))
,@(iter (for i from -2 to 2)
- (collect `(ensure-zone (,i 11 0 your-ship)
- :name "Emacs"
- :description "The stern of your ship"
- :direction-attributes (list :north (list :hidden ,(or (= i 1) (= i -1)))
- :down (list :hidden t)
- :up (list :hidden t)))))
+ (collect `(ensure-zone (,i 11 0 your-ship)
+ :name "Emacs"
+ :description "The stern of your ship"
+ :direction-attributes (list :north (list :hidden ,(or (= i 1) (= i -1)))
+ :down (list :hidden t)
+ :up (list :hidden t)))))
,@(iter (for i from 3 to 10)
- (collect `(ensure-zone (-2 ,i 0 your-ship)
- :name "Emacs"
- :description "The port of your ship"
- :direction-attributes (list :east (list :hidden ,(not (= i 6))))))
- (collect `(ensure-zone (2 ,i 0 your-ship)
- :name "Emacs"
- :description "The starboard of your ship"
- :direction-attributes (list :west (list :hidden ,(not (= i 6))))))
- (collect `(ensure-zone (0 ,i 0 your-ship)
- :name "Passage Way"
- :description "The passage way of your ship"
- ,@(when (= i 3) '(:stairs (list :up :down)))))))
+ (collect `(ensure-zone (-2 ,i 0 your-ship)
+ :name "Emacs"
+ :description "The port of your ship"
+ :direction-attributes (list :east (list :hidden ,(not (= i 6))))))
+ (collect `(ensure-zone (2 ,i 0 your-ship)
+ :name "Emacs"
+ :description "The starboard of your ship"
+ :direction-attributes (list :west (list :hidden ,(not (= i 6))))))
+ (collect `(ensure-zone (0 ,i 0 your-ship)
+ :name "Passage Way"
+ :description "The passage way of your ship"
+ ,@(when (= i 3) '(:stairs (list :up :down)))))))
(ensure-zone (0 3 1 your-ship)
- :name "Bridge"
- :description "You can steer your ship from here"
- :props (list
- :controls (make-instance 'prop
- :name "Controls"
- :description "The ships controls"
- :attributes (list :destinations (list '(0 21 0 silver-cape) '(1 21 0 bandits-domain)))
- :actions
- (list
- :list-places-to-sail (make-action
- :documentation "List valid destinations"
- :lambda
- '(lambda
- (prop &rest keys &key &allow-other-keys)
- (format t "~4a~30a~30a" "Index" "Name of destination" "Coordinates")
- (iter (for i from 0 to (1- (list-length (getf (attributes-of prop) :destinations))))
- (format t "~4d~30a~30s"
- i
- (name-of (get-zone (nth i (getf (attributes-of prop) :destinations))))
- (nth i (getf (attributes-of prop) :destinations))))))
- :describe-place (make-action
- :documentation "display the description of a destination. INDEX is an index from :list-places-to-sail"
- :lambda
- '(lambda
- (prop &rest keys &key index &allow-other-keys)
- (if (nth index (getf (attributes-of prop) :destinations))
- (progn
- (format t "Name: ~a~%~%Description: ~a~%~%Coordinates: ~s~%~%"
- (name-of (nth index (getf (attributes-of prop) :destinations)))
- (description-of (nth index (getf (attributes-of prop) :destinations)))
- (nth index (getf (attributes-of prop) :destinations))))
- (format t "That's not a valid destination~%"))))
- :set-sail (make-action
- :documentation "Set sail to a place. INDEX is an index from :list-places-to-sail"
- :lambda '(lambda
- (prop &rest keys &key index &allow-other-keys)
- (if (nth index (getf (attributes-of prop) :destinations))
- (progn (remf (warp-points-of (get-zone (getf (warp-points-of (get-zone '(-1 6 0 your-ship)))
- :exit)))
- :your-ship)
- (setf (getf (warp-points-of (get-zone '(-1 6 0 your-ship))) :exit)
- (nth index (getf (attributes-of prop) :destinations))
- (getf (warp-points-of (get-zone (nth index (getf (attributes-of prop) :destinations))))
- :your-ship)
- '(-1 6 0 your-ship)))
- (format t "That's not a valid destination~%"))))))))
+ :name "Bridge"
+ :description "You can steer your ship from here"
+ :props (list
+ :controls (make-instance 'prop
+ :name "Controls"
+ :description "The ships controls"
+ :attributes (list :destinations (list '(0 21 0 silver-cape) '(1 21 0 bandits-domain)))
+ :actions
+ (list
+ :list-places-to-sail (make-action
+ :documentation "List valid destinations"
+ :lambda
+ '(lambda
+ (prop &rest keys &key &allow-other-keys)
+ (format t "~4a~30a~30a" "Index" "Name of destination" "Coordinates")
+ (iter (for i from 0 to (1- (list-length (getf (attributes-of prop) :destinations))))
+ (format t "~4d~30a~30s"
+ i
+ (name-of (get-zone (nth i (getf (attributes-of prop) :destinations))))
+ (nth i (getf (attributes-of prop) :destinations))))))
+ :describe-place (make-action
+ :documentation "display the description of a destination. INDEX is an index from :list-places-to-sail"
+ :lambda
+ '(lambda
+ (prop &rest keys &key index &allow-other-keys)
+ (if (nth index (getf (attributes-of prop) :destinations))
+ (progn
+ (format t "Name: ~a~%~%Description: ~a~%~%Coordinates: ~s~%~%"
+ (name-of (nth index (getf (attributes-of prop) :destinations)))
+ (description-of (nth index (getf (attributes-of prop) :destinations)))
+ (nth index (getf (attributes-of prop) :destinations))))
+ (format t "That's not a valid destination~%"))))
+ :set-sail (make-action
+ :documentation "Set sail to a place. INDEX is an index from :list-places-to-sail"
+ :lambda '(lambda
+ (prop &rest keys &key index &allow-other-keys)
+ (if (nth index (getf (attributes-of prop) :destinations))
+ (progn (remf (warp-points-of (get-zone (getf (warp-points-of (get-zone '(-1 6 0 your-ship)))
+ :exit)))
+ :your-ship)
+ (setf (getf (warp-points-of (get-zone '(-1 6 0 your-ship))) :exit)
+ (nth index (getf (attributes-of prop) :destinations))
+ (getf (warp-points-of (get-zone (nth index (getf (attributes-of prop) :destinations))))
+ :your-ship)
+ '(-1 6 0 your-ship)))
+ (format t "That's not a valid destination~%"))))))))
(ensure-zone (0 3 -1 your-ship)
- :name "Hold"
- :description "You have a chest here that can hold your crap"
- :props (list
- :chest (make-instance 'prop
- :name "Chest"
- :description "Place all your crap here"
- :placeable t)))
+ :name "Hold"
+ :description "You have a chest here that can hold your crap"
+ :props (list
+ :chest (make-instance 'prop
+ :name "Chest"
+ :description "Place all your crap here"
+ :placeable t)))
#.`(progn
,@(iter (for i from -1 to 1)
- (unless (= i 0)
- (collect `(ensure-zone (,i 6 0 your-ship)
- :name "Passage Way"
- :description "The passage way of your ship"
- :direction-attributes (list :north (list :hidden t)
- :south (list :hidden t))
- :warp-points ,(if (= i -1)
- '(list :exit '(0 21 0 silver-cape))
- ()))))))
+ (unless (= i 0)
+ (collect `(ensure-zone (,i 6 0 your-ship)
+ :name "Passage Way"
+ :description "The passage way of your ship"
+ :direction-attributes (list :north (list :hidden t)
+ :south (list :hidden t))
+ :warp-points ,(if (= i -1)
+ '(list :exit '(0 21 0 silver-cape))
+ ()))))))
(ensure-zone (-1 5 0 your-ship)
- :name "Cabin"
- :description "A Cabin of your ship"
- :direction-attributes (list :north (list :hidden t)
- :south (list :hidden t)
- :west (list :hidden t)))
+ :name "Cabin"
+ :description "A Cabin of your ship"
+ :direction-attributes (list :north (list :hidden t)
+ :south (list :hidden t)
+ :west (list :hidden t)))
(ensure-zone (1 5 0 your-ship)
- :name "Cabin"
- :description "A Cabin of your ship"
- :direction-attributes (list :north (list :hidden t)
- :south (list :hidden t)
- :east (list :hidden t)))
+ :name "Cabin"
+ :description "A Cabin of your ship"
+ :direction-attributes (list :north (list :hidden t)
+ :south (list :hidden t)
+ :east (list :hidden t)))
(ensure-zone (-1 6 0 your-ship)
- :name "Cabin"
- :description "A Cabin of your ship"
- :direction-attributes (list :north (list :hidden t)
- :south (list :hidden t)
- :west (list :hidden t)))
+ :name "Cabin"
+ :description "A Cabin of your ship"
+ :direction-attributes (list :north (list :hidden t)
+ :south (list :hidden t)
+ :west (list :hidden t)))
(ensure-zone (1 6 0 your-ship)
- :name "Galley"
- :description "A Cabin of your ship"
- :direction-attributes (list :north (list :hidden t)
- :south (list :hidden t)
- :east (list :hidden t)))
+ :name "Galley"
+ :description "A Cabin of your ship"
+ :direction-attributes (list :north (list :hidden t)
+ :south (list :hidden t)
+ :east (list :hidden t)))
(ensure-zone (-1 7 0 your-ship)
- :name "Cabin"
- :description "A Cabin of your ship"
- :direction-attributes (list :north (list :hidden t)
- :south (list :hidden t)
- :west (list :hidden t)))
+ :name "Cabin"
+ :description "A Cabin of your ship"
+ :direction-attributes (list :north (list :hidden t)
+ :south (list :hidden t)
+ :west (list :hidden t)))
(ensure-zone (1 7 0 your-ship)
- :name "Cabin"
- :description "A Cabin of your ship"
- :direction-attributes (list :north (list :hidden t)
- :south (list :hidden t)
- :east (list :hidden t)))
+ :name "Cabin"
+ :description "A Cabin of your ship"
+ :direction-attributes (list :north (list :hidden t)
+ :south (list :hidden t)
+ :east (list :hidden t)))
(ensure-zone (-1 8 0 your-ship)
- :name "Cabin"
- :description "A Cabin of your ship"
- :direction-attributes (list :north (list :hidden t)
- :south (list :hidden t)
- :west (list :hidden t)))
+ :name "Cabin"
+ :description "A Cabin of your ship"
+ :direction-attributes (list :north (list :hidden t)
+ :south (list :hidden t)
+ :west (list :hidden t)))
(ensure-zone (1 8 0 your-ship)
- :name "Cabin"
- :description "A Cabin of your ship"
- :direction-attributes (list :north (list :hidden t)
- :south (list :hidden t)
- :east (list :hidden t)))
+ :name "Cabin"
+ :description "A Cabin of your ship"
+ :direction-attributes (list :north (list :hidden t)
+ :south (list :hidden t)
+ :east (list :hidden t)))
(ensure-zone (-1 9 0 your-ship)
- :name "Cabin"
- :description "A Cabin of your ship"
- :direction-attributes (list :north (list :hidden t)
- :south (list :hidden t)
- :west (list :hidden t)))
+ :name "Cabin"
+ :description "A Cabin of your ship"
+ :direction-attributes (list :north (list :hidden t)
+ :south (list :hidden t)
+ :west (list :hidden t)))
(ensure-zone (1 9 0 your-ship)
- :name "Cabin"
- :description "A Cabin of your ship"
- :direction-attributes (list :north (list :hidden t)
- :south (list :hidden t)
- :east (list :hidden t)))
+ :name "Cabin"
+ :description "A Cabin of your ship"
+ :direction-attributes (list :north (list :hidden t)
+ :south (list :hidden t)
+ :east (list :hidden t)))
(ensure-zone (-1 10 0 your-ship)
- :name "Cabin"
- :description "A Cabin of your ship"
- :direction-attributes (list :north (list :hidden t)
- :south (list :hidden t)
- :west (list :hidden t)))
+ :name "Cabin"
+ :description "A Cabin of your ship"
+ :direction-attributes (list :north (list :hidden t)
+ :south (list :hidden t)
+ :west (list :hidden t)))
(ensure-zone (1 10 0 your-ship)
- :name "Cabin"
- :description "A Cabin of your ship"
- :direction-attributes (list :north (list :hidden t)
- :south (list :hidden t)
- :east (list :hidden t)))
+ :name "Cabin"
+ :description "A Cabin of your ship"
+ :direction-attributes (list :north (list :hidden t)
+ :south (list :hidden t)
+ :east (list :hidden t)))
diff --git a/data/moves/pokemon.lisp b/data/moves/pokemon.lisp
index 15a40da..27e1e62 100644
--- a/data/moves/pokemon.lisp
+++ b/data/moves/pokemon.lisp
@@ -57,8 +57,8 @@
(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))))
+ (set-status-condition 'yadfa-status-conditions:skunked i)
+ (format t "~a is grossed out by the smell~%" (name-of i))))
(defclass tickle (move) ()
(:default-initargs
:name "Tickle"
@@ -85,13 +85,13 @@
(unless (iter (for i in (if (typep user 'team-member)
(enemies-of *battle*)
(team-of *game*)))
- (with j = nil)
- (when (>= (bladder/contents-of i) (bladder/need-to-potty-limit-of i))
- (format t "~a jumps and wets ~aself~%" (name-of i) (if (malep i) "him" "her"))
- (wet :wetter i)
- (set-status-condition 'yadfa-status-conditions:wetting i)
- (setf j t))
- (finally (return j)))
+ (with j = nil)
+ (when (>= (bladder/contents-of i) (bladder/need-to-potty-limit-of i))
+ (format t "~a jumps and wets ~aself~%" (name-of i) (if (malep i) "him" "her"))
+ (wet :wetter i)
+ (set-status-condition 'yadfa-status-conditions:wetting i)
+ (setf j t))
+ (finally (return j)))
(write-line "it had no effect")))
(defclass bite (move) ()
(:default-initargs
diff --git a/data/moves/regular.lisp b/data/moves/regular.lisp
index a400024..6d7a797 100644
--- a/data/moves/regular.lisp
+++ b/data/moves/regular.lisp
@@ -29,15 +29,15 @@
(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)))))))
+ (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)))))
@@ -68,8 +68,8 @@
(let ((audience (iter (for i in (if (typep target 'enemy)
(enemies-of *battle*)
(team-of *game*)))
- (unless (eq target i)
- (collect i)))))
+ (unless (eq target i)
+ (collect i)))))
(when audience
(format t (if (> (list-length audience) 1)
"~a's team mates start laughing at ~a~%"
@@ -80,7 +80,7 @@
"her"))
(unless old-condition
(iter (for i in audience)
- (set-status-condition 'yadfa-status-conditions:laughing i))))))
+ (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))))))
@@ -94,14 +94,14 @@
(format t "~a used ~a~%" (name-of user) (name-of attack))
(let ((amount 50))
(iter (while (> amount 0))
- (for i in (reverse (wear-of user)))
- (when (typep i 'closed-bottoms)
- (cond ((> amount (- (sogginess-capacity-of i) (sogginess-of i)))
- (decf amount (- (sogginess-capacity-of i) (sogginess-of i)))
- (setf (sogginess-of i) (sogginess-capacity-of i)))
- ((> amount 0)
- (incf (sogginess-of i) amount)
- (setf amount 0))))))
+ (for i in (reverse (wear-of user)))
+ (when (typep i 'closed-bottoms)
+ (cond ((> amount (- (sogginess-capacity-of i) (sogginess-of i)))
+ (decf amount (- (sogginess-capacity-of i) (sogginess-of i)))
+ (setf (sogginess-of i) (sogginess-capacity-of i)))
+ ((> amount 0)
+ (incf (sogginess-of i) amount)
+ (setf amount 0))))))
(let ((clothing (filter-items (wear-of user) 'closed-bottoms)))
(cond
((filter-items clothing 'incontinence-product)
@@ -217,16 +217,16 @@
(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)))
+ (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))))
+ (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))
@@ -236,24 +236,24 @@
(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)))
+ (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))))
+ (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)))
+ (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))))
(defclass spank (move) ()
(:default-initargs
diff --git a/data/prolog/enemies.lisp b/data/prolog/enemies.lisp
index bcc6557..da717c6 100644
--- a/data/prolog/enemies.lisp
+++ b/data/prolog/enemies.lisp
@@ -2,7 +2,7 @@
(in-package :yadfa-enemies)
(defmacro make-instances (&rest symbols)
`(list ,@(iter (for symbol in symbols)
- (collect `(make-instance ',symbol)))))
+ (collect `(make-instance ',symbol)))))
(defclass catchable-enemy (enemy)
((catch-chance
:initarg :catch-chance
diff --git a/data/prolog/map.lisp b/data/prolog/map.lisp
index bbbe791..8a9b505 100644
--- a/data/prolog/map.lisp
+++ b/data/prolog/map.lisp
@@ -47,11 +47,11 @@
(defun change-the-baby (user &rest new-diaper)
(let ((b (apply #'make-instance new-diaper)))
(iter (for clothes on (wear-of user))
- (when (typep (car clothes) 'bottoms)
- (handler-case (toggle-onesie (car clothes) clothes user)
- (onesie-locked (c)
- (setf (lockedp (car (clothes-of c))) nil)
- (toggle-onesie (car (clothes-of c)) (clothes-of c) (user-of c))))))
+ (when (typep (car clothes) 'bottoms)
+ (handler-case (toggle-onesie (car clothes) clothes user)
+ (onesie-locked (c)
+ (setf (lockedp (car (clothes-of c))) nil)
+ (toggle-onesie (car (clothes-of c)) (clothes-of c) (user-of c))))))
(setf (inventory-of (player-of *game*)) (append (inventory-of (player-of *game*)) (filter-items (wear-of user) 'closed-bottoms))
(wear-of user) (remove-if (lambda (a)
(typep a 'closed-bottoms))
@@ -60,15 +60,15 @@
(push b (cdr (last (wear-of user))))
(push b (wear-of user)))
(iter (for clothes on (wear-of user))
- (let ((nth (car clothes))
- (nthcdr (cdr clothes)))
- (when (or (and (typep nth 'bottoms) (thickness-capacity-of nth) nthcdr
- (> (total-thickness nthcdr) (thickness-capacity-of nth)))
- (and (typep nth 'closed-bottoms)
- (or (>= (sogginess-of nth) (/ (sogginess-capacity-of nth) 4))
- (>= (messiness-of nth) (/ (messiness-capacity-of nth) 4)))))
- (push nth (inventory-of (player-of *game*)))
- (setf (wear-of user) (s:delq nth (wear-of user))))))))
+ (let ((nth (car clothes))
+ (nthcdr (cdr clothes)))
+ (when (or (and (typep nth 'bottoms) (thickness-capacity-of nth) nthcdr
+ (> (total-thickness nthcdr) (thickness-capacity-of nth)))
+ (and (typep nth 'closed-bottoms)
+ (or (>= (sogginess-of nth) (/ (sogginess-capacity-of nth) 4))
+ (>= (messiness-of nth) (/ (messiness-capacity-of nth) 4)))))
+ (push nth (inventory-of (player-of *game*)))
+ (setf (wear-of user) (s:delq nth (wear-of user))))))))
(defun trigger-diaper-police (had-accident user)
(when (or (and (getf (car had-accident) :leak-amount) (> (getf (car had-accident) :leak-amount) 0))
(and (getf (cdr had-accident) :leak-amount) (> (getf (cdr had-accident) :leak-amount) 0)))
diff --git a/data/props/base.lisp b/data/props/base.lisp
index 6d386f2..0223079 100644
--- a/data/props/base.lisp
+++ b/data/props/base.lisp
@@ -3,11 +3,11 @@
(defun change-the-baby (user &rest new-diaper)
(let ((b (apply #'make-instance new-diaper)))
(iter (for clothes on (wear-of user))
- (when (typep (car clothes) 'bottoms)
- (handler-case (toggle-onesie (car clothes) clothes user)
- (onesie-locked (c)
- (setf (lockedp (car (clothes-of c))) nil)
- (toggle-onesie (car (clothes-of c)) (clothes-of c) (user-of c))))))
+ (when (typep (car clothes) 'bottoms)
+ (handler-case (toggle-onesie (car clothes) clothes user)
+ (onesie-locked (c)
+ (setf (lockedp (car (clothes-of c))) nil)
+ (toggle-onesie (car (clothes-of c)) (clothes-of c) (user-of c))))))
(setf (inventory-of (player-of *game*)) (append (inventory-of (player-of *game*)) (filter-items (wear-of user) 'closed-bottoms))
(wear-of user) (remove-if (lambda (a)
(typep a 'closed-bottoms))
@@ -16,15 +16,15 @@
(push b (cdr (last (wear-of user))))
(push b (wear-of user)))
(iter (for clothes on (wear-of user))
- (let ((nth (car clothes))
- (nthcdr (cdr clothes)))
- (when (or (and (typep nth 'bottoms) (thickness-capacity-of nth) nthcdr
- (> (total-thickness nthcdr) (thickness-capacity-of nth)))
- (and (typep nth 'closed-bottoms)
- (or (>= (sogginess-of nth) (/ (sogginess-capacity-of nth) 4))
- (>= (messiness-of nth) (/ (messiness-capacity-of nth) 4)))))
- (push nth (inventory-of (player-of *game*)))
- (setf (wear-of user) (s:delq nth (wear-of user))))))))
+ (let ((nth (car clothes))
+ (nthcdr (cdr clothes)))
+ (when (or (and (typep nth 'bottoms) (thickness-capacity-of nth) nthcdr
+ (> (total-thickness nthcdr) (thickness-capacity-of nth)))
+ (and (typep nth 'closed-bottoms)
+ (or (>= (sogginess-of nth) (/ (sogginess-capacity-of nth) 4))
+ (>= (messiness-of nth) (/ (messiness-capacity-of nth) 4)))))
+ (push nth (inventory-of (player-of *game*)))
+ (setf (wear-of user) (s:delq nth (wear-of user))))))))
(defclass toilet (prop) ()
(:default-initargs
:name "Toilet"
@@ -86,38 +86,38 @@
(ignore keys))
#-sbcl (check-type prop prop)
(iter (for j in (append (list (player-of *game*)) (allies-of *game*)))
- (let ((a (calculate-diaper-usage j)))
- (when (and
- (or
- (>=
- (getf a :sogginess)
- (/ (getf a :sogginess-capacity) 4))
- (>=
- (getf a :messiness)
- (/ (getf a :messiness-capacity) 4)))
- (filter-items (wear-of j) 'closed-bottoms))
- (format t "Mechanical arms come out of the changing table and strap ~a down on the table to prevent ~a from escaping and proceeds to change ~a~%~%"
- (name-of j)
- (if (malep j) "him" "her")
- (if (malep j) "him" "her"))
- (if (filter-items (wear-of j) 'padding)
- (progn
- (format t "~a: Hey!!! Don't change me here!!! People can see me!!! Stop!!!~%~%"
- (name-of j)))
- (progn
- (format t "~a: Hey!!! I don't need diapers!!! Stop!!!~%~%"
- (name-of j))))
- (change-the-baby j 'yadfa-items:kurikia-thick-diaper :locked t)
- (format t "*The machine removes ~a's soggy clothing (and any clothing that doesn't fit over the new diaper) and puts a thick diaper on ~a, then locks it to prevent the baby from removing it.*~%~%"
- (name-of j)
- (if (malep j) "him" "her"))
- (format t "*The machine unstraps ~a from the table and lets ~a go. The diaper is so thick ~a's legs are spread apart forcing ~a to waddle*~%~%"
- (name-of j)
- (if (malep j) "him" "her")
- (name-of j)
- (if (malep j) "him" "her"))
- (when (trigger-event 'yadfa-events:get-diaper-locked-1)
- (format t "*~a tugs at the tabs trying to remove them, but they won't budge. Better find a solution before its too late*~%~%" (name-of j))))))))))
+ (let ((a (calculate-diaper-usage j)))
+ (when (and
+ (or
+ (>=
+ (getf a :sogginess)
+ (/ (getf a :sogginess-capacity) 4))
+ (>=
+ (getf a :messiness)
+ (/ (getf a :messiness-capacity) 4)))
+ (filter-items (wear-of j) 'closed-bottoms))
+ (format t "Mechanical arms come out of the changing table and strap ~a down on the table to prevent ~a from escaping and proceeds to change ~a~%~%"
+ (name-of j)
+ (if (malep j) "him" "her")
+ (if (malep j) "him" "her"))
+ (if (filter-items (wear-of j) 'padding)
+ (progn
+ (format t "~a: Hey!!! Don't change me here!!! People can see me!!! Stop!!!~%~%"
+ (name-of j)))
+ (progn
+ (format t "~a: Hey!!! I don't need diapers!!! Stop!!!~%~%"
+ (name-of j))))
+ (change-the-baby j 'yadfa-items:kurikia-thick-diaper :locked t)
+ (format t "*The machine removes ~a's soggy clothing (and any clothing that doesn't fit over the new diaper) and puts a thick diaper on ~a, then locks it to prevent the baby from removing it.*~%~%"
+ (name-of j)
+ (if (malep j) "him" "her"))
+ (format t "*The machine unstraps ~a from the table and lets ~a go. The diaper is so thick ~a's legs are spread apart forcing ~a to waddle*~%~%"
+ (name-of j)
+ (if (malep j) "him" "her")
+ (name-of j)
+ (if (malep j) "him" "her"))
+ (when (trigger-event 'yadfa-events:get-diaper-locked-1)
+ (format t "*~a tugs at the tabs trying to remove them, but they won't budge. Better find a solution before its too late*~%~%" (name-of j))))))))))
(:documentation "Class for washers, you can wash your diapers and all the clothes you've ruined in these."))
(defclass checkpoint (prop) ()
(:default-initargs
@@ -220,15 +220,15 @@
#-sbcl (check-type prop prop)
(shopfun (let ((a ()))
(iter (for i in (list-all-packages))
- (unless (equal i (find-package :yadfa))
- (do-external-symbols (s i)
- (when (and
- (find-class s nil)
- (c2mop:subclassp
- (find-class s)
- (find-class 'item))
- (tossablep (make-instance s)))
- (push (cons s nil) a)))))
+ (unless (equal i (find-package :yadfa))
+ (do-external-symbols (s i)
+ (when (and
+ (find-class s nil)
+ (c2mop:subclassp
+ (find-class s)
+ (find-class 'item))
+ (tossablep (make-instance s)))
+ (push (cons s nil) a)))))
a)
:format-items t)))
(getf (actions-of c) :buy-items)
@@ -243,16 +243,16 @@
(shopfun
(let ((a ()))
(iter (for i in (list-all-packages))
- (unless
- (equal i (find-package :yadfa))
- (do-external-symbols (s i)
- (when (and
- (find-class s nil)
- (c2mop:subclassp
- (find-class s)
- (find-class 'item))
- (tossablep (make-instance s)))
- (push (cons s nil) a)))))
+ (unless
+ (equal i (find-package :yadfa))
+ (do-external-symbols (s i)
+ (when (and
+ (find-class s nil)
+ (c2mop:subclassp
+ (find-class s)
+ (find-class 'item))
+ (tossablep (make-instance s)))
+ (push (cons s nil) a)))))
a)
:items-to-buy items
:user (player-of *game*))))
@@ -268,16 +268,16 @@
(shopfun
(let ((a ()))
(iter
- (for i in (list-all-packages))
- (unless (equal i (find-package :yadfa))
- (do-external-symbols (s i)
- (when (and
- (find-class s nil)
- (c2mop:subclassp
- (find-class s)
- (find-class 'item))
- (tossablep (make-instance s)))
- (push (cons s nil) a)))))
+ (for i in (list-all-packages))
+ (unless (equal i (find-package :yadfa))
+ (do-external-symbols (s i)
+ (when (and
+ (find-class s nil)
+ (c2mop:subclassp
+ (find-class s)
+ (find-class 'item))
+ (tossablep (make-instance s)))
+ (push (cons s nil) a)))))
a)
:items-to-sell items
:user (player-of *game*))))))
diff --git a/data/team-members/catchables.lisp b/data/team-members/catchables.lisp
index c408f8c..fa2f112 100644
--- a/data/team-members/catchables.lisp
+++ b/data/team-members/catchables.lisp
@@ -19,7 +19,7 @@
:bladder/contents (random 500)
:bowels/contents (random 700)
:inventory (iter (for i from 0 to (random 10))
- (collect (make-instance 'yadfa-items:cloth-diaper)))
+ (collect (make-instance 'yadfa-items:cloth-diaper)))
:moves (list (make-instance 'yadfa-moves:watersport)
(make-instance 'yadfa-moves:mudsport))))
(defmethod initialize-instance :after
diff --git a/run.lisp b/run.lisp
index aa175f3..400c09f 100755
--- a/run.lisp
+++ b/run.lisp
@@ -33,7 +33,7 @@
(sleep 2))
(ql:quickload (loop for i in (asdf:system-depends-on (asdf:find-system :yadfa))
when (stringp i) collect i
- when (and (listp i) (eq (first i) :feature) (uiop:featurep (second i))) collect (third i)))
+ when (and (listp i) (eq (first i) :feature) (uiop:featurep (second i))) collect (third i)))
(declaim (optimize (debug 2)))
(setf *read-default-float-format* 'long-float)
(ql:quickload :yadfa)
diff --git a/t/main.lisp b/t/main.lisp
index c6c5f51..c43d872 100644
--- a/t/main.lisp
+++ b/t/main.lisp
@@ -5,20 +5,20 @@
(in-suite initialization-tests)
(defmacro test-initialize-package (package)
`(iter (for class in-package ,package external-only t)
- (when (find-class class nil)
- (let ((result (handler-case (class-of (make-instance class))
- (error (c) c))))
- (is (eq result (find-class class nil))
- "Class ~s failed to initialize:~%~8t~a" class result)))))
+ (when (find-class class nil)
+ (let ((result (handler-case (class-of (make-instance class))
+ (error (c) c))))
+ (is (eq result (find-class class nil))
+ "Class ~s failed to initialize:~%~8t~a" class result)))))
(test initialize-items
- (test-initialize-package :yadfa-items))
+ (test-initialize-package :yadfa-items))
(test initialize-enemies
- (test-initialize-package :yadfa-enemies))
+ (test-initialize-package :yadfa-enemies))
(test initialize-moves
- (test-initialize-package :yadfa-moves))
+ (test-initialize-package :yadfa-moves))
(test initialize-props
- (test-initialize-package :yadfa-props))
+ (test-initialize-package :yadfa-props))
(test initialize-status-conditions
- (test-initialize-package :yadfa-status-conditions))
+ (test-initialize-package :yadfa-status-conditions))
(test initialize-allies
- (test-initialize-package :yadfa-allies))
+ (test-initialize-package :yadfa-allies))