aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Pouar <pouar@pouar.net>2020-07-14 14:59:24 -0500
committerGravatar Pouar <pouar@pouar.net>2020-07-14 17:56:27 -0500
commit973ca6a145847a7770e59fc1ddfee1807bd8d280 (patch)
treed5023d65b190cb963dbb6c9076d26aee232884b1
parentuse CLIM:FORMATTING-TABLE as it works with variable width fonts (diff)
add element types, although nothing uses it yet
-rw-r--r--core/classes.lisp33
-rw-r--r--core/libexec.lisp73
-rw-r--r--packages.lisp5
3 files changed, 102 insertions, 9 deletions
diff --git a/core/classes.lisp b/core/classes.lisp
index 1e5d873..17bdee1 100644
--- a/core/classes.lisp
+++ b/core/classes.lisp
@@ -17,7 +17,36 @@
(:documentation "All the classes that are part of the game's core inherit this class"))
(defclass battle-script-mixin () ())
(defclass attack-mixin () ())
-(defclass base-character (yadfa-class)
+(defclass element-type-metaclass (standard-class) ((name :initform nil)))
+(defmethod name-of ((class element-type-metaclass))
+ (or (slot-value class 'name) (class-name class)))
+(defmethod c2mop:validate-superclass ((class element-type-metaclass) (superclass standard-class)) t)
+(defmethod c2mop:validate-superclass ((class standard-class) (superclass element-type-metaclass))
+ (error 'simple-error :format-control "Either you didn't use ~s to define ~s or you tried to inherit a class not defined with ~s" :format-arguments `(define-type ,(class-name class) define-type)))
+(defclass element-type () () (:metaclass element-type-metaclass))
+(defclass element-type-mixin () ((element-type :accessor element-type-of :initform nil :initarg :element-type)))
+(defmethod print-object ((o element-type) s)
+ (let ((class (slot-value (class-of o) 'name)))
+ (if class
+ (print-unreadable-object (o s :type t :identity t)
+ (write class :stream s))
+ (call-next-method))))
+(defgeneric coerce-element-type (element)
+ (:method ((element-type (eql nil)))
+ nil)
+ (:method ((element-type symbol))
+ (make-instance element-type))
+ (:method ((element-type element-type))
+ element-type))
+(defgeneric type-match (source target)
+ (:documentation "Used to determine the effectiveness of element type @var{SOURCE} against element type @var{TARGET}. Valid return values are @code{NIL}, @code{:SUPER-EFFECTIVE}, @code{:NOT-VERY-EFFECTIVE}, and @code{:NO-EFFECT}, which represent the effectiveness")
+ (:method (source target) (type-match (coerce-element-type source) (coerce-element-type target)))
+ (:method ((source element-type) (target element-type)) nil)
+ (:method ((source (eql nil)) target)
+ nil)
+ (:method (source (target (eql nil)))
+ nil))
+(defclass base-character (yadfa-class element-type-mixin)
((name
:initarg :name
:initform :missingno.
@@ -274,7 +303,7 @@
:accessor persistentp
:documentation "Whether items or moves that cure statuses cure this"))
(:documentation "Base class for all the status conditions "))
-(defclass move (yadfa-class attack-mixin)
+(defclass move (yadfa-class attack-mixin element-type-mixin)
((name
:initarg :name
:initform :-
diff --git a/core/libexec.lisp b/core/libexec.lisp
index 949f924..388bc89 100644
--- a/core/libexec.lisp
+++ b/core/libexec.lisp
@@ -152,6 +152,32 @@
'<))
1)
(or (eq attack t) (not (typep (get-move attack character) '(or mess-move-mixin wet-move-mixin))))))
+(defmacro defmatch (source target &body return)
+ (flet ((arg (arg sym)
+ (if (typep arg '(and list (not null)))
+ arg
+ (list (a:make-gensym sym) arg))))
+ `(progn (defmethod type-match (,(arg source 'source)
+ ,(arg target 'target))
+ ,@return)
+ t)))
+(defmacro define-type (name (&rest superclasses) (&rest slot-specifiers) &rest class-options)
+ `(progn (defclass ,name (,@superclasses element-type) ,slot-specifiers
+ (:metaclass element-type-metaclass)
+ ,@(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))))
+ ,@(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 `(unless (find-class ',target nil)
+ (defclass ,target (element-type) () (:metaclass element-type-metaclass))))
+ (collect `(defmatch ,name ,target ,option-name)))))
+ (collect `(setf (slot-value (find-class ',name) 'name) ,(if (eq option-name :element-name)
+ (second class-option)
+ nil)))))
+ t))
(defunassert get-positions-of-type (type list)
(type type-specifier
list list)
@@ -387,7 +413,7 @@
(format t "~a received ~a damage~%" (name-of target) a)
a))
(:method ((target base-character) (user base-character) (attack move))
- (let ((a (calculate-damage target user (power-of attack))))
+ (let ((a (calculate-damage target user attack)))
(format t "~a used ~a~%" (name-of user) (name-of attack))
(decf (health-of target) a)
(format t "~a received ~a damage~%" (name-of target) a)
@@ -3314,11 +3340,7 @@
* (level-of user))
/ 100)
+ 5))))
-(declaim (ftype (function (base-character base-character real) (values real real &optional)) calculate-damage))
-(defunassert calculate-damage (target user attack-base)
- (user base-character
- target base-character
- attack-base real)
+(defmethod calculate-damage ((target base-character) (user base-character) (attack real))
"Figures out the damage dealt, we use the formula
@mathjax{\\left({\\left({2 \\times level \\over 5}+2\\right) \\times attackbase \\times {attack \\over defense} \\over 50}+2\\right) \\times {randomrange \\over 100}}
@@ -3334,10 +3356,47 @@ attack is @code{(calculate-stat @var{user} :attack)}
defense is @code{(calculate-stat @var{user} :defense)}
randomrange is @code{(random-from-range 85 100)}"
- (round (u:$ (u:$ (u:$ (u:$ (u:$ (u:$ (u:$ 2 * (level-of user)) / 5) + 2) * attack-base * (u:$ (calculate-stat user :attack) / (calculate-stat target :defense)))
+ (round (u:$ (u:$ (u:$ (u:$ (u:$ (u:$ (u:$ 2 * (level-of user)) / 5) + 2) * attack * (u:$ (calculate-stat user :attack) / (calculate-stat target :defense)))
/ 50)
+ 2)
* (u:$ (random-from-range 85 100) / 100))))
+(defmethod calculate-damage ((target base-character) (user base-character) (attack move))
+ "Figures out the damage dealt, we use the formula
+
+ @mathjax{\\left({\\left({2 \\times level \\over 5}+2\\right) \\times attackbase \\times {attack \\over defense} \\over 50}+2\\right) \\times {randomrange \\over 100}}
+
+ which is the same as Pokèmon
+
+level is @code{(level-of @var{user})}
+
+attackbase is @var{attack-base}
+
+attack is @code{(calculate-stat @var{user} :attack)}
+
+defense is @code{(calculate-stat @var{user} :defense)}
+
+randomrange is @code{(random-from-range 85 100)}"
+ (let ((attack-element-type (element-type-of attack))
+ (target-element-types (element-type-of target))
+ (user-element-types (element-type-of user)))
+ (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 (member :no-effect target-element-types
+ :test (lambda (o e)
+ (eq o (type-match attack-element-type e))))
+ 0
+ (expt 2 (iter (with ret = 0) (for target-element-type in target-element-types)
+ (case (type-match attack-element-type target-element-type)
+ (:super-effective (incf ret))
+ (:not-very-effective (decf ret))
+ (:no-effect (error "This should not happen")))
+ (finally (return ret)))))
+ (if (find attack-element-type user-element-types
+ :key 'coerce-element-type)
+ 1.5
+ 1))))))
(defun present-stats (user)
(updating-present-with-effective-frame (*query-io* :unique-id `(stats% ,user) :id-test #'equal)
(clim:updating-output (*query-io*)
diff --git a/packages.lisp b/packages.lisp
index f25e690..0ad5e44 100644
--- a/packages.lisp
+++ b/packages.lisp
@@ -55,6 +55,8 @@
#:with-effective-frame
#:present-with-effective-frame
#:updating-present-with-effective-frame
+ #:defmatch
+ #:define-type
;;functions
#:finished-events
#:unfinished-events
@@ -124,6 +126,8 @@
#:wear-script
#:wield-script
#:toggle-onesie
+ #:type-match
+ #:coerce-element-type
;;constructors
#:make-action
;;classes
@@ -193,6 +197,7 @@
#:skin-of
#:config-of
#:stairs-of
+ #:element-type-of
#:last-process-potty-time-of
#:process-battle-accident-of
#:process-potty-dance-of