SE701:April 7

;;; File:    music.lisp
;;; Author:  John Hamer
;;; Date:    7 April 2008
;;; Purpose: illustrate Common Lisp generic functions and classes

(defclass music () ())

(defgeneric duration (music))

;; A single note
(defclass note (music)
  ((key      :initarg :key
	     :initform (error "Must specify the note key")
	     :accessor note-key) ; should be :reader
   (duration :initarg :duration
	     :initform (error "Must specify the note duration")
	     :reader duration)))

(defmethod print-object ((n note) stream)
  (with-slots (key duration) n
    (setf (note-key n) 120) ; illustrating that with-slots is not a simple (let ...)
    (print-unreadable-object (n stream :type t)
      (format stream "~a, ~a" key duration))))

;; Silence
(defclass musical-rest (music)
  ((duration :initarg :duration :initform 0 :reader duration)))



;; Sequential and parallel composition   
(defclass music-composite (music)
  ((terms :initarg :terms :reader terms)))

(defclass par (music-composite) ())
(defclass seq (music-composite) ())

(defun seq (&rest terms)
  (make-instance 'seq :terms terms))
(defun par (&rest terms)
  (make-instance 'par :terms terms))

(defmethod initialize-instance :after ((mc music-composite) &key)
  (with-slots (terms) mc
    (assert (every #'(lambda (m) (subtypep m 'music)) terms)
	    (terms)
	    "Music-composites require a list of music: ~a" terms)))

(defmethod print-object ((mc music-composite) stream)
  (print-unreadable-object (mc stream :type t)
    (format stream "~{~a~}" (terms mc))))



;; Decorators

(defclass music-decorator (music)
  ((term :initarg :term
	 :initform (error "Must specify the music term")
	 :reader term)))

;; Tempo
(defclass tempo (music-decorator)
  ((tempo-ratio :initarg :ratio :reader tempo-ratio)))

(defun tempo (m r)
  (make-instance 'tempo :term m :ratio r))


;; Transpose
(defclass trans (music-decorator)
  ((offset :initarg :offset :reader offset)))

(defun trans (m d)
  (make-instance 'trans :term m :offset d))

;; Instrument
(defclass instr (music-decorator)
  ((instrument :initarg :instrument :reader instrument)))

(defun instr (m i)
  (make-instance 'instr :term m :instrument i))

;; Phrase
(defclass phrase (music-decorator)
  ((phrasing :initarg :phrasing :reader phrasing)))

(defun phrase (m p)
  (make-instance 'phrase :term m :phrasing p))


;; Duration of complex music pieces
(defmethod duration ((m seq))
  (reduce #'+ (terms m) :key #'duration))
(defmethod duration ((m par))
  (reduce #'max (terms m) :key #'duration))
(defmethod duration ((m tempo))
  (/ (duration (term m)) (tempo-ratio m)))
(defmethod duration ((m music-decorator))
  (duration (term m)))

;;;- Retro
(defgeneric retro (music)
  (:documentation "MUSIC played backwards"))

(defmethod retro ((m music))
  m)
(defmethod retro ((p par))
  (par (mapcar #'retro (terms p))))
(defmethod retro ((s seq))
  (seq (nreverse (mapcar #'retro (terms s)))))
(defmethod retro ((m tempo))
  (tempo (retro (term m)) (tempo-ratio m)))
(defmethod retro ((m trans))
  (trans (retro (term m)) (offset m)))
(defmethod retro ((m instr))
  (instr (retro (term m)) (instrument m)))
(defmethod retro ((m phrase))
  (phrase (retro (term m)) (phrasing m)))