experiment with multimethods and macros

pokemon.lisp

(defpackage #:pokemon
  (:use #:cl))

(in-package :pokemon)

;; POKEMON
(defclass pokemon ()
  ((health :accessor health
           :initarg :health
           :initform 10)))

(defmacro defpokemon-types (types)
  (let ((the-classes (loop for item in types collect `(defclass ,item () ()))))
    `(progn ,@the-classes)))

(defpokemon-types (fire water grass poison bug rock))

(defclass charmander (fire pokemon)
  ())

(defclass squirtle (water pokemon)
  ())

(defclass bulbasaur (grass poison pokemon)
  ())

(defclass paras (bug grass pokemon)
  ())

(defclass lotad (pokemon water grass)
  ())

(defclass move ()
  ((damage)
   (multiplier :accessor :multiplier
               :initform 1)))

(defclass flame (fire)
  ((damage :initform 5)))

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

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

(define-method-combination mult)

(defgeneric use-move (type target)
  (:method-combination mult))

(defmethod use-move mult ((type t) (target pokemon))
  1)

(defmacro make-move-methods (type super not-very nope)
  (let ((supers (loop :for item :in super
                      :collect `(defmethod use-move mult ((type ,type) (target ,item))
                                  2)))
        (nots (loop :for item :in not-very
                    :collect `(defmethod use-move mult ((type ,type) (target ,item))
                                1/2)))
        (nopes (loop :for item :in nope
                     :collect `(defmethod use-move mult ((type ,type) (target ,item))
                                 0))))
    `(progn ,@supers ,@nots ,@nopes)))

(make-move-methods fire (grass bug) (water) (rock))
(make-move-methods grass (water rock) (fire) nil)
(make-move-methods water (fire) (grass rock) nil)