mi.lisp

;;; https://www.quora.com/Do-C-developers-find-multiple-inheritance-a-useful-feature-Do-Java-developers-ever-find-themselves-wishing-Java-supported-it/answer/Mario-Galindo-Queralt


; Common Lisp: Rainer Joswig, joswig@lisp.de, 2019


;;; ======================================================
;;; Features

(defclass walk ()
  ((speed :initarg :speed :initform 0)))

(defmethod walk ((w walk))
  (format t "  Walk speed ~a~%" (slot-value w 'speed)))

(defclass fly ()
  ((fuel :initarg :fuel :initform 0)))

(defmethod fly ((f fly))
  (with-slots (fuel) f
    (cond ((plusp fuel)
           (format t "  Flying~%")
           (decf fuel))
          (t (format t "  No fuel to fly~%")))))

(defclass gun ()
  ((bullets :initarg :bullets :initform 0)))

(defmethod gun-fire ((g gun))
  (with-slots (bullets) g
    (cond ((plusp bullets)
           (format t "  Gun fire~%")
           (decf bullets))
          (t (format t "  Gun no more bullets~%")))))

(defclass laser ()
  ((intensity :initarg :intensity :initform 2)))

(defmethod initialize-instance :after ((l laser) &key intensity)
  (setf (slot-value l ' intensity) (max 2 (or intensity 2))))

(defmethod laser-fire ((l laser))
  (with-slots (intensity) l
    (format t "  Laser fire intensity ~a~%" intensity)
    (if (> intensity 2) (decf intensity))))

;;; ================================================================
;;; Entities

(defclass basic-entity ()
  ((name :initarg :name)))

(defmethod print-name ((b basic-entity))
  (format t "~%~a:~%" (slot-value b 'name)))

(defmacro entity (name &rest features)
  `(defclass ,name (,@features basic-entity) ()))

(defmacro execute ((name &rest initargs) &body instructions)
  `(let ((,name (make-instance ',name ,@initargs)))
     ,@(loop for i in instructions collect (list i name))
     (values)))

;;; ================================================================
;;; Example

(entity dragon     fly laser)
(entity elephant   walk gun)
(entity airplane   fly gun laser)

(defun example ()

  (execute (dragon :name "Dragon" :fuel 2 :intensity 4)
    print-name fly laser-fire fly fly laser-fire)

  (execute (elephant :name "Elephant" :speed 3 :bullets 2)
    print-name walk gun-fire gun-fire gun-fire)

  (execute (airplane :name "Airplane" :fuel 2 :intensity 3 :bullets 2)
    print-name fly laser-fire gun-fire gun-fire fly laser-fire gun-fire fly))

(example)