pokemon.lisp

(defpackage #:pokémon
  (:use #:cl))

(in-package :pokémon)

;; POKEMON
(defclass pokémon ()
  ((species :accessor species
            :initarg :species)
   (types :accessor types
          :initarg :types
          :initform '())
   (health :accessor health
           :initarg :health
           :initform 10)
   (moves :accessor moves
          :initarg :moves
          :initform '())))

;; Types
(defclass pokémon-type ()
  ((graphic :initarg :graphic
            :accessor graphic)))

(defclass fire (pokémon-type) ())
(defvar *fire* (make-instance 'fire :graphic "🔥"))

(defclass water (pokémon-type) ())
(defvar *water* (make-instance 'water :graphic "🌊"))

(defclass grass (pokémon-type) ())
(defvar *grass* (make-instance 'grass :graphic "🌱"))

(defclass bug (pokémon-type) ())
(defvar *bug* (make-instance 'bug :graphic "🐛"))

(defclass poison (pokémon-type) ())
(defvar *poison* (make-instance 'poison :graphic "🚬"))

(defgeneric show (thing)
  (:documentation "Print some friendly representation of thing and return it"))

;; move class
(defclass move ()
  ((name :initarg :name :accessor name)
   (damage :initarg :damage :accessor damage)
   (affinity :initarg :affinity :accessor affinity)))

(defmethod show ((thing move))
  (with-slots (name damage affinity) thing
    (format t "~a does ~a ~a damage" name damage (graphic affinity))))

(defun new-move (name damage affinity)
  (make-instance 'move :name name :damage damage :affinity affinity))

(defparameter *flame* (new-move "Flame" 5 *fire*))
(defparameter *water-gun* (new-move "Water Gun" 5 *water*))

;; Pokémon species

(defun new-pokémon (species types moves)
  (make-instance 'pokémon :species species :types types :moves moves))

(defparameter *charmander*
  (new-pokémon 'charmander (list *fire*) (list *flame*)))

(defparameter *squirtle*
  (new-pokémon 'squirtle `(,*water*) `(,*water-gun*)))

;; theres a bug here :)
(defparameter *paras*
  (new-pokémon 'paras '(*bug* *grass*)
               '((make-instance 'move :name "Cut" :damage 5 :affinity *bug*))))

(defmethod show ((thing pokémon))
  (with-slots (types species health moves) thing
    (progn
      (format t "A ~a type ~a with ~a health.~%Moves:~%" (mapcar #'graphic types) species health)
      (mapc #'show moves))))

(defclass bulbasaur (grass poison pokémon)
  ())

(defclass lotad (pokémon water grass)
  ())

;; ---------------------------------
;; custom method combination

(defun mult (&rest args)
  (reduce #'* args))

(define-method-combination mult)

(defgeneric effectiveness (type target)
  (:method-combination mult)
  (:documentation "Calculates the damage multiplier for a move of TYPE against TARGET pokémon"))

(defmethod effectiveness mult ((type t) (target t))
  "Baseline effectiveness method"
  1)

(defmethod effectiveness mult ((type move) (target pokémon))
  "Calculates the effectiveness of a move against a pokémon"
  (reduce #'* (mapcar (lambda (e) (apply #'effectiveness (list (affinity type) e))) (types target))))

(defmacro build-effectiveness-methods (type super not-very nope)
  (flet ((method-maker (targets multiplier)
           (loop :for item :in targets
              :collect (list 'defmethod 'effectiveness 'mult
                        (list (list 'type `(eql ,type))
                              (list 'target `(eql ,item)))
                        multiplier))))
    (list* 'progn
           (nconc (method-maker super 2)
                  (method-maker not-very 1/2)
                  (method-maker nope 0)))))

#+nil
(progn
 (build-effectiveness-methods *fire* (*grass* *bug*) (*water*) nil)
 (build-effectiveness-methods *grass* (*water*) (*fire*) nil)
 (build-effectiveness-methods *water* (*fire*) (*grass*) (*poison*)))

(defun effect-string (mult)
  (case mult
    (4 "its super duper effective!")
    (2 "its super effective!")
    (1 "its a normal attack")
    (1/2 "its not very effective…")
    (1/4 "its not very effective at all…")
    (0 "it has no effect…")
    (t "")))

(defun calc-damage (attacker move target)
  (let ((damage (damage move))
        (mult (effectiveness move target)))
    (print mult)
    (when (member (affinity move) (types attacker))
      (terpri)
      (princ "+150% STAB bonus")
      (setq damage (* damage 3/2)))
    (print (effect-string mult))
    (* damage mult)))

(defmacro build-effectiveness-methods (type super not-very nope)
  (flet ((method-maker (targets multiplier)
           (loop
              :for item :in targets
              :collect
                `(defmethod effectiveness mult ((type (eql ,type)) (target (eql ,item)))
                            ,multiplier))))
    `(progn ,@(nconc (method-maker super 2)
                     (method-maker not-very 1/2)
                     (method-maker nope 0)))))

Is a "more conventional" implementation of that macro if that's what you're into.

(defmethod effectiveness mult ((type move) (target pokémon))
  "Calculates the effectiveness of a move against a pokémon"
  (let ((affinity (affinity type))) 
    (reduce #'*
            (mapcar (lambda (e) (effectiveness affinity e))
                    (types target)))))

Not sure why you were doing (apply #'effectiveness (list thing other-thing)) instead of just (effectiveness thing other-thing)

I introduced that binding of affinity since its being reused in every call of that closure. But its debatable whether or not its worth it. I tend to find it makes for less cluttered (i.e. more readable) code in some circumstances, but then again, too many bindings in a let can also make for cluttered code. so its a cointoss. I just made it here so you could see another perspective on style.