#+Title: Generation of Music through Theory
#+AUTHOR: Sam Flint
#+EMAIL: swflint@flintfam.org
#+DATE: \today
#+INFOJS_OPT: view:info toc:nil path:http://flintfam.org/org-info.js
#+OPTIONS: toc:nil H:5 ':t *:t
#+PROPERTY: noweb tangle
#+PROPERTY: comments noweb
#+LATEX_HEADER: \usepackage[color]{showkeys}
#+LATEX_HEADER: \parskip=5pt
#+LATEX_HEADER: \lstset{texcl=true,breaklines=true,columns=fullflexible,frame=lines,literate={lambda}{$\lambda$}{1} {set}{$\gets$}1 {setq}{$\gets$}1 {setf}{$\gets$}1 {<=}{$\leq$}1 {>=}{$\geq$}1}

#+BEGIN_abstract
While music is really cool, attempts to create it mechanically have often been fairly simple.  I've built another system to do so before, but this time, I'd like to make something that is a bit more complex, using Music Theory to inform its design.
#+END_abstract

#+TOC: headlines 3
#+TOC: listings

* Keys
  :PROPERTIES:
  :ID: 75e7db58-8b69-4955-a73d-6b168f57300b
  :END:

  One of the more important parts of generating music is the ability to actually have correct note output, in key.  To do this, I use a key lookup alist, and a note lookup alist.

#+Caption: Keys and mappings
#+Name: keys-and-mappings
#+BEGIN_SRC lisp
  (defvar *numbers-to-notes*
    '(:a-major (1 "a" 2 "b" 3 "cis'" 4 "d'" 5 "e'" 6 "fis'" 7 "gis'" 8 "a'")
      :b-major (1 "b" 2 "cis'" 3 "dis'" 4 "e'" 5 "fis'" 6 "gis'" 7 "ais'" 8 "b'")
      :c-major (1 "c'" 2 "d'" 3 "e'" 4 "f'" 5 "g'" 6 "a'" 7 "b'" 8 "c''")
      :d-major (1 "d'" 2 "e'" 3 "fis'" 4 "g'" 5 "a'" 6 "b'" 7 "cis''" 8 "d''")
      :e-major (1 "e'" 2 "fis'" 3 "gis'" 4 "a'" 5 "b'" 6 "cis''" 7 "dis''" 8 "e''")
      :f-major (1 "f'" 2 "g'" 3 "a'" 4 "bes'" 5 "c''" 6 "d''" 7 "e''" 8 "f''")
      :g-major (1 "g'" 2 "a'" 3 "b'" 4 "c''" 5 "d''" 6 "e''" 7 "fis''" 8 "g''")
      :a-minor (1 "a" 2 "b" 3 "c'" 4 "d'" 5 "e'" 6 "f'" 7 "g'" 8 "a'")
      :b-minor (1 "b" 2 "cis'" 3 "d'" 4 "e'" 5 "fis'" 6 "g'" 7 "a'" 8 "b'")
      :c-minor (1 "c'" 2 "d'" 3 "ees'" 4 "f'" 5 "g'" 6 "aes'" 7 "bes'" 8 "c''")
      :d-minor (1 "d'" 2 "e'" 3 "f'" 4 "g'" 5 "a'" 6 "bes'" 7 "c''" 8 "d''")
      :e-minor (1 "e'" 2 "fis'" 3 "g'" 4 "a'" 5 "b'" 6 "c''" 7 "d''" 8 "e''")
      :f-minor (1 "f'" 2 "g'" 3 "aes'" 4 "bes'" 5 "c''" 6 "des''" 7 "ees''" 8 "f''")
      :g-minor (1 "g'" 2 "a'" 3 "bes'" 4 "c''" 5 "d''" 6 "ees''" 7 "f''" 8 "g''")))

  (defvar *key-signature*
    '(:a-major "\\key a \\major"
      :b-major "\\key b \\major"
      :c-major "\\key c \\major"
      :d-major "\\key d \\major"
      :e-major "\\key e \\major"
      :f-major "\\key f \\major"
      :g-major "\\key g \\major"
      :a-minor "\\key a \\minor"
      :b-minor "\\key b \\minor"
      :c-minor "\\key c \\minor"
      :d-minor "\\key d \\minor"
      :e-minor "\\key e \\minor"
      :f-minor "\\key f \\minor"
      :g-minor "\\key g \\minor"))

  (defvar *chords*
    (map 'list #'(lambda (chord)
                   (concatenate 'string "<<"
                                chord
                                ">>"))
         '("c e g"
           "cis eis gis"
           "des f aes"
           "d fis a"
           "dis fisis ais"
           "ees g bes"
           "e gis b"
           "f a c"
           "fes aes ces")))
#+END_SRC

* Timing
  :PROPERTIES:
  :ID: e7583e67-5059-430e-adeb-07f9aa76107d
  :END:

  Timing, time signatures and the rhythms valid in those time signatures are very important.  To store time signature data, a lookup table with entries of the form ~(:name total-32nds "representation" max-length)~ is created.  To store information about rhythms, another lookup table is created, entries this time are of the form ~(name duration "representation")~.

  This structure allows for tremendous flexibility in rhythm and timing, letting the rhythm generation routine be more dynamic, without having things hard-coded.

#+Caption: Timing
#+Name: timing
#+BEGIN_SRC lisp
  (defvar *time-signatures*
    '((:common 32 "4/4" 9)
      (:3/4 24 "3/4" 8)
      (:2/4 16 "2/4" 7)
      (:8/8 32 "8/8" 9)
      (:7/8 28 "7/8" 8)
      (:6/8 24 "6/8" 8)
      (:5/8 20 "5/8" 7)
      (:4/8 16 "4/8" 7)
      (:3/8 12 "3/8" 6)
      (:2/8 8 "2/8" 5)))

  (defvar *rhythms*
    '((32nd 1 "32")
      (16th 2 "16")
      (dotted-16th 3 "16.")
      (8th 4 "8")
      (dotted-8th 6 "8.")
      (4th 8 "4")
      (dotted-4th 12 "4.")
      (2nd 16 "2")
      (dotted-2nd 24 "2.")
      (1st 32 "1")))

  (defun print-out-rhythms (rhythms &optional (output t))
    (flet ((print-rhythm (rhythm)
             (format output "~a " (third (assoc rhythm *rhythms*))) rhythm))
      (map 'list #'print-rhythm rhythms)))
#+END_SRC

* Rhythms
  :PROPERTIES:
  :ID: a05b4255-1493-4707-b29a-6a591be8b4f9
  :END:

  The generation of rhythms is important to the production of music using algorithmic methods.  I've decided to do this symbolically, using lookup tables to help to make sure that multiple time signatures are supported, and to allow for greater flexibility by preventing hard-coding of durations within the function.

  This function takes two arguments, a number of measures and a time signature.  The number of measures is an integer, and the time signature is a keyword.  It then retrieves the time signature information, getting the number of 32nd notes to a measure, and the largest note possible in a measure.  It goes on to figure the total number of 32nd notes in the piece, and begins to determine rhythms.

  To select rhythms, it takes a random number, between 0 and the index of the max value, and retrieves the entry.  If the mod of the total 32nds left is 0, or if it is greater than or equal to the duration of the entry, that rhythm is selected, pushing it's name on to the list and decrementing the count by that number, otherwise, a new rhythm is selected.  This is done until the total count equals 0.

  The rhythm list is then reversed, and that value is returned from the function.

#+Caption: Generate Rhythms
#+Name: gen-rhythms
#+BEGIN_SRC lisp
  (defun generate-rhythms (measures signature)
    (declare (integer measures)
             (keyword signature))
    (let* ((signature (assoc signature *time-signatures*))
           (mult (second signature))
           (max (fourth signature))
           (total (* measures mult))
           (rhythms '()))
      (labels ((gen-rhythm ()
                 (let* ((possible (random (1+ max)))
                        (mod-n (mod total mult))
                        (entry (nth possible *rhythms*))
                        (name (first entry))
                        (dur (second entry)))
                   (if (or (= 0 mod-n)
                          (>= mod-n dur))
                       (progn (push name rhythms)
                              (decf total dur))
                       (gen-rhythm)))))
        (do ()
            ((= 0 total))
          (gen-rhythm))
        (reverse rhythms))))
#+END_SRC

* Data Structures
  :PROPERTIES:
  :ID: 004d1179-bb29-4e4c-82c6-5620684ea15d
  :END:

  While in previous iterations of this system, I had just used lists, going directly from duration to printed representation.  Rather than doing it that way, I'll instead use dedicated classes to represent notes.  These classes will either represent a note for internal use, or a note for output.

  For internal use, the ~<note>~ class contains three slots, ~duration~, ~jump~ and ~note~.  The duration, of course being a symbol representing the duration of the note.  Jump represents the jump of a note, whether it's a first, third, fifth, second or fourth.

#+Caption: Data Structures
#+Name: data-structures
#+BEGIN_SRC lisp
  (defclass <note> ()
    ((duration :type symbol :reader note-duration :initarg :duration)
     (jump :type (or symbol null) :reader note-jump :initarg :jump)
     (note :type (or symbol null) :reader note-note :initarg :note))
    (:documentation "A note. This allows easy representation of a note and a rhythm."))
#+END_SRC

* Helper Functions
  :PROPERTIES:
  :ID: ba319632-76bf-4878-8023-35486bb59b63
  :END:

  Dealing with the data structures directly for the most part isn't a problem, but some convenience functions must be put together.  The most important functions are object printers, both of which simply format the object so as to ensure that information is available during debugging.

  Furthermore, for the toplevel function stuff, there must be a few helper functions, a keyword builder, an unknown option handler, and a small macro to make dealing with certain options easier.

#+Caption: Helper Functions
#+Name: helper-functions
#+BEGIN_SRC lisp
  (defmethod print-object ((object <note>) stream)
    (print-unreadable-object (object stream :type t)
      (with-slots (duration) object
        (let ((note (if (slot-boundp object 'note)
                        (note-note object)
                        nil))
              (jump (if (slot-boundp object 'jump)
                        (note-jump object)
                        nil)))
          (format stream "Duration ~a, Jumping a ~a, Note is ~a" duration jump note)))))

  (defun make-keyword (input)
    (intern (string-upcase input) "KEYWORD"))

  (defun unknown-option (condition)
    (format t "warning: option \"~s\" is unknown~%"
            (opts:option condition))
    (invoke-restart 'skip-option))

  (defmacro when-option ((options opt) &body body)
    `(let ((it (getf ,options ,opt)))
       (when it ,@body)))
#+END_SRC

* Make some music
  :PROPERTIES:
  :ID: e76501ef-2cf5-41eb-b4ab-9154f852b358
  :END:

#+Caption: Make music
#+Name: make-music
#+BEGIN_SRC lisp
  (defun make-music (output &key (time-signature :common) (measures 25) (key :c-major) (title "Algorithmic Composition") (author "Common Lisp"))
    (let ((rhythms (generate-rhythms measures time-signature)))
      (print-out-rhythms rhythms)))
#+END_SRC

* Toplevel Function
  :PROPERTIES:
  :ID: 0f748722-7c6b-4436-ae94-3c8d149d0262
  :END:

  This defines the command line options available to the program, along with the function that processes those options, and properly dispatches them.  Both are fairly simple.

#+Caption: Toplevel Function
#+Name: toplevel-function
#+BEGIN_SRC lisp
  (define-opts
      (:name :help
             :description "Print Help Text"
             :short #\h)
      (:name :output
             :description "Output File"
             :long "output"
             :arg-parser #'identity
             :meta-var "OUTPUT")
    (:name :time-signature
           :description "Time Signature"
           :long "ts"
           :arg-parser #'make-keyword
           :metavar "TIME-SIGNARTURE")
    (:name :measures
           :description "Measure Count"
           :long "measures"
           :arg-parser #'parse-integer
           :meta-var "MEASURES")
    (:name :key
           :description "Key"
           :long "key"
           :arg-parser #'make-keyword
           :meta-var "KEY")
    (:name :title
           :description "Title of piece"
           :long "title"
           :arg-parser #'identity
           :meta-var "TITLE")
    (:name :author
           :description "Author of piece"
           :long "author"
           :arg-parser #'identity
           :meta-var "AUTHOR"))

  (defun main ()
    (multiple-value-bind (options free-args)
        (handler-case
            (handler-bind ((opts:unknown-option #'unknown-option))
              (get-opts))
          (opts:missing-arg (condition)
            (format t "FATAL: Option ~a requires an argument.~%"
                    (opts:option condition))
            (sb-ext:exit :code 1))
          (opts:arg-parser-failed (condition)
            (format t "FATAL: Cannot parse ~s as argument of ~s.~%"
                    (opts:raw-arg condition)
                    (opts:option condition))
            (sb-ext:exit :code 1)))
      (when-option (options :help)
        (opts:describe
         :prefix "music-generator -- A music generation system")
        (sb-ext:exit :code 0))
      (if (not (getf options :output))
          (progn
            (format t "FATAL: Output File Required.~%")
            (sb-ext:exit :code 1)))
      (let ((output (getf options :output))
            (time-signature (or (getf options :time-signature) :common))
            (measures (or (getf options :measures) 25))
            (key (or (getf options :key) :c-major))
            (title (or (getf options :title) "Algorithmic Composition"))
            (author (or (getf options :author)
                       (format nil "~a ~a" (lisp-implementation-type) (lisp-implementation-version)))))
        (make-music output
                    :time-signature time-signature
                    :measures measures
                    :key key
                    :title title
                    :author author))))
#+END_SRC

* Make an executable
  :PROPERTIES:
  :ID: fc1fee10-e683-4486-a815-49717dc9073f
  :END:

  On occasion, it can be handy to turn a lisp program into an executable.  This can be done in a few ways, but as I am using SBCL, I use the ~sb-ext:save-lisp-and-die~ function.  This wraps it and an export expression into a ~progn~ which comes after a feature test, ensuring that this is only compiled on Steel Bank Common Lisp.

#+Caption: Make An Executable
#+Name: make-executable
#+BEGIN_SRC lisp
  ,#+sbcl (progn
           (defun save-an-executable ()
             ,#+lparallel (lparallel:end-kernel)
             (sb-ext:save-lisp-and-die "music-generator"
                                       :toplevel #'main
                                       :executable t
                                       :purify t))
           (export 'save-an-executable))
#+END_SRC

* Packaging
  :PROPERTIES:
  :ID: 8d49f094-d2be-4b9a-8bba-e40b52f6db58
  :END:

  Now that everything is defined, the goal is to put this into a single lisp file, allowing everything to be arranged so it loads correctly, and placing it all in a package to hide implementation details.

#+Caption: Packaging
#+Name: packaging
#+BEGIN_SRC lisp :tangle "music-generator.lisp"
  ;;; music-generator.lisp begins here

  (eval-when (:compile-toplevel :load-toplevel)
    (ql:quickload '(:uiop :unix-opts)))

  (defpackage #:music-generator
    (:use #:cl
          #:uiop)
    (:import-from #:unix-opts
                  #:define-opts
                  #:skip-option
                  #:raw-arg
                  #:option
                  #:get-opts)
    (:export #:make-music))

  (in-package #:music-generator)

  <<keys-and-mappings>>

  <<timing>>

  <<gen-rhythms>>

  <<data-structures>>

  <<helper-functions>>

  <<make-executable>>

  <<toplevel-function>>

  <<make-music>>

  ;;; end of music-generator.lisp
#+END_SRC