Moved to a different directory

algorithmic-music.org

@@ -0,0 +1,435 @@
+#+Title: Algorithmic Music
+#+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
+Music is absolutely fascinating.  However, very few people are skilled in its composition.  Computers may not produce the most pleasing music, but they can produce interesting music, using permutations of a scale, and random numbers.
+#+END_abstract
+
+#+TOC: headlines 3
+#+TOC: listings
+
+* Create a Score
+  :PROPERTIES:
+  :ID:       87e383f5-5e4f-4f3e-a344-b4e921c25358
+  :END:
+
+  The creation of a score is the primary feature of this program.  To do this, it builds on other parts of the program, first, generating a score description, from ~(generate-score-notes)~, formatting the notes for output, and generating a header.  After that, it will assemble a file in [[http://lilypond.org][GNU LilyPond]] syntax, and run the ~lilypond~ program to produce a PDF.
+
+#+Caption: Create a score
+#+Name: create-a-score
+#+BEGIN_SRC lisp
+(defun generate-score-contents (&optional (title "Algorithmic Composition") (composer "Common Lisp") (key :c-major) (measures 25))
+  (let* ((score (generate-score-notes measures))
+         (notes (format nil "~{~a~}"
+                        (loop for note-pair in score
+                           collect (generate-note (car note-pair) (cdr note-pair) key))))
+         (header (format nil "\\header {title = \"~a\" composer = \"~a\" tagline = \"\"}~&\\score {" title composer)))
+    (with-output-to-string (output-file)
+      (format output-file "\\version \"2.18.2\"~&#(set-default-paper-size \"letter\")~&")
+      (format output-file "~a~&" header)
+      (format output-file "\\new Staff {~a ~a\\bar \"|.\"}\\layout {}\\midi{}}" (getf *key-signature* key) notes))))
+
+(defun create-score (file &key (title "Algorithmic Composition") (composer "Common Lisp") (key :c-major) (measures 25))
+  (with-open-file (output-file file
+                               :direction :output
+                               :if-exists :overwrite
+                               :if-does-not-exist :create)
+    (format output-file "~a" (generate-score-contents title composer key measures))
+    (run-program (list "lilypond" file))))
+#+END_SRC
+
+* Create a note
+  :PROPERTIES:
+  :ID:       a3b3368b-ebc0-44d2-a12d-6c401a9d9941
+  :END:
+
+  To generate proper syntax for a note from a note number and a duration, this function is used.  It takes the note number, the duration and the key.  It then looks up the note, based on the key, and raises 2 to the duration, and formats the note.
+
+  Durations are found using the following table:
+
+#+Caption: Durations
+#+Name: durations-table
+|   | Duration | Beats |
+|---+----------+-------|
+| ! |      dur | beats |
+| # |        0 |     1 |
+| # |        1 |   1:2 |
+| # |        2 |   1:4 |
+| # |        3 |   1:8 |
+| # |        4 |  1:16 |
+#+TBLFM: @3$3=1/(2^$dur);F::@4$3=1/(2^$dur);F::@5$3=1/(2^$dur);F::@6$3=1/(2^$dur);F::@7$3=1/(2^$dur);F
+
+
+#+Caption: Generate Note Output
+#+Name: generate-note
+#+BEGIN_SRC lisp
+(defun generate-note (number &optional (duration 2) (key :c-major))
+  (declare (type (integer 1 8) number)
+           (type (integer 0 4) duration)
+           (keyword key))
+  (let ((note (getf (getf *numbers-to-notes* key) number))
+        (true-duration (expt 2 duration)))
+    (format nil "~a~d " note true-duration)))
+#+END_SRC
+
+* Generate a set of notes
+  :PROPERTIES:
+  :ID:       f347583d-1f7b-44ac-9acd-036feb428f69
+  :END:
+
+  Actually generating notes is perhaps one of the more difficult parts.  To do so, the number of measures must first be known, and is used to generate a list of rhythms.  After that, a set of changes is generated, which is used for the picking of notes.  For each rhythm, a number, from 0 to 8 is chosen.  If the number chosen is 0, then the system will go through a single permutation of the octave for the next 8 rhythms, otherwise, that note will be used for the next rhythm.  Notes and rhythms are consed and pushed on to a list, which is the reversed and returned.
+
+#+Caption: Generate a set of notes
+#+Name: generate-set-of-notes
+#+BEGIN_SRC lisp
+  (defun generate-score-notes (number-of-measures)
+    (let ((score '())
+          (durations (generate-durations number-of-measures))
+          (changes (steinhous-johnson-trotter 8)))
+      (do ()
+          ((null durations))
+        (let ((note-source (random 9)))
+          (if (= note-source 0)
+              (loop for note in (pop changes)
+                 if (not (null durations))
+                 do (push (cons note (pop durations)) score))
+              (push (cons note-source (pop durations)) score))))
+      (reverse score)))
+#+END_SRC
+
+* Generate Durations
+  :PROPERTIES:
+  :ID:       cd1b3240-a55e-49ec-b093-3d88452da527
+  :END:
+
+  One of the more important parts of generating music is creating sensible rhythms.  To do so, a number between 0 and 4 is chosen, and then checked to see if it makes sense, if it does, it is pushed on to a list of durations, and then the appropriate number of beats is deducted from the beats-left count.  Finally, the duration list is reversed and returned.
+
+#+Caption: Generate Durations
+#+Name: generate-durations
+#+BEGIN_SRC lisp
+  (defun generate-durations (number-of-measures)
+    (let ((durations '())
+          (n-left (* 16 number-of-measures)))
+      (labels ((try-make-duration ()
+                 (let ((dur (random 5)))
+                   (case dur
+                     (0
+                      (if (= 0 (mod n-left 16))
+                          (progn
+                            (push dur durations)
+                            (decf n-left 16))
+                          (try-make-duration)))
+                     (1
+                      (if (= 0 (mod n-left 8))
+                          (progn
+                            (push dur durations)
+                            (decf n-left 8))
+                          (try-make-duration)))
+                     (2
+                      (decf n-left 4)
+                      (push dur durations))
+                     (3
+                      (decf n-left 2)
+                      (push dur durations))
+                     (4
+                      (decf n-left)
+                      (push dur durations))))))
+        (do ()
+            ((= 0 n-left))
+          (try-make-duration)))
+      (reverse durations)))
+#+END_SRC
+
+* 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
+
+* Generate Permutations
+  :PROPERTIES:
+  :ID:       0924c151-0a4e-4545-8a8b-0cb051c76097
+  :END:
+
+  One of the more interesting ways this produces music is through the use of Plain Changes, a type of permutation based on single transpostions.  To do this, I use the Steinhaus-Johnson-Trotter algorithm, explained in Figure [[steinhaus-johnson-trotter-img]].
+
+#+Caption: Steinhaus-Johnson-Trotter Algorithm
+#+Name: steinhaus-johnson-trotter
+#+BEGIN_SRC dot :file "steinhaus-johnson-trotter.png" :export results
+  digraph {
+          start [label = "Start"];
+          stop [label = "End"];
+          swap [label = "Swap around change"];
+          swapdone [label = "Changes left?", shape = rectangle];
+          if_three [label = "Length == 3?", shape = rectangle];
+
+          subgraph cluster_generate_changes {
+                   generate_changes_previous [label = "Generate Changes For Number - 1"];
+
+                   subgraph cluster_inner_change_loop {
+                            previous_left [label = "Previous changes left?", shape = rectangle];
+                            loop_from_1_to_num [label = "Loop from 1 to Number"];
+                            insert_from_previous_1_plus [label = "Insert from previous change plus 1"]
+                            loop_from_1_minus_num_to_1 [label = "Loop from Number - 1 to 1"];
+                            insert_from_previous [label = "Insert from previous change"];
+
+                            previous_left -> loop_from_1_to_num [label = "True"];
+                            loop_from_1_to_num -> insert_from_previous_1_plus;
+                            insert_from_previous_1_plus -> loop_from_1_minus_num_to_1;
+                            loop_from_1_minus_num_to_1 -> insert_from_previous;
+                            insert_from_previous -> previous_left;
+                   }
+
+                   generate_changes_previous -> previous_left;
+          }
+
+
+
+          start -> if_three;
+          if_three -> stop [label = "True,\n(2 1 2 1 2)"];
+          if_three -> generate_changes_previous [label = "False"];
+          previous_left -> swap [label = "False"];
+          swap -> swapdone;
+          swapdone -> swap [label = "True"];
+          swapdone -> stop [label = "False"];
+  }
+#+END_SRC
+
+#+Caption: Steinhaus-Johnson-Trotter Algorithm
+#+Name: steinhaus-johnson-trotter-img
+#+RESULTS: steinhaus-johnson-trotter
+[[file:steinhaus-johnson-trotter.png]]
+
+#+Caption: Generate Permutations (Steinhaus-Johnson-Trotter)
+#+Name: generate-permutations
+#+BEGIN_SRC lisp
+  (defun plain-changes (n)
+    (if (= n 2)
+        '(1)
+        (if (= n 3)
+            '(2 1 2 1 2)
+            (let ((up (xrange (1- n)))
+                  (down (xrange (- n 2) t))
+                  (recur (remove-if #'null (plain-changes (1- n))))
+                  (changes '()))
+              (do ()
+                  ((null recur))
+                (loop for x in down
+                   do (push x changes))
+                (push (1+ (pop recur)) changes)
+                (loop for x in up
+                   do (push x changes))
+                (push (pop recur) changes))
+              (remove-if #'null changes)))))
+
+  (defun steinhous-johnson-trotter (n)
+    (let ((permutations '()))
+      (push (xrange n) permutations)
+      (loop for i in (plain-changes n)
+         do (let* ((old-permutation (pop permutations))
+                   (old-a (nth (1- i) old-permutation))
+                   (old-b (nth i old-permutation))
+                   (new-permutation (copy-list old-permutation)))
+              (push old-permutation permutations)
+              (setf (nth (1- i) new-permutation) old-b
+                    (nth i new-permutation) old-a)
+              (push new-permutation permutations)))
+      permutations))
+#+END_SRC
+
+* Helper Functions
+  :PROPERTIES:
+  :ID:       7382b9fa-4d86-4bfd-b8a9-c5865b3818b7
+  :END:
+
+  To correctly generate the permutations, an ~xrange~ function is needed, similar to the one built into Python.  It is implemented using the ~loop~ macro, although, I had originally planned on using ~iter~.
+
+#+Caption: Helper Functions
+#+Name: helper-functions
+#+BEGIN_SRC lisp
+  (defun xrange (length &optional (reverse-p nil))
+    (let ((range (loop for i from 1 to length
+                    collect i)))
+      (if reverse-p
+          (reverse range)
+          range)))
+#+END_SRC
+
+* Putting it together
+
+  The full logic of the music generation program is shown in Figure [[figure:overview]].
+
+#+Caption: Overview
+#+Name: overview
+#+BEGIN_SRC dot :file "overview.png" :export results
+  digraph {
+          entry [label = "Program Entry"];
+          exit [label = "Program Exit"];
+
+          subgraph cluster_generate_rhythms {
+                   rank = same;
+                   beat_count [label = "Multiply Measure number by 4"];
+                   continue [label = "Beat Count = 0?", shape = rectangle]
+                   reverse [label = "Reverse Rhythms"]
+
+                   subgraph cluster_check_valid {
+                            pick_random [label = "Pick Random number\n0 -- 4"];
+                            case_0 [label = "Number is 0\n(Whole Note)"];
+                            case_1 [label = "Number is 1\n(Half Note)"];
+                            case_2 [label = "Number is 2\n(Quarter Note)"];
+                            case_3 [label = "Number is 3\n(Eighth Note)"];
+                            case_4 [label = "Number is 4\n(Sixteenth Note)"];
+                            mod_4 [label = "Beats mod 4 == 0", shape = rectangle];
+                            mod_2 [label = "Beats mod 2 == 0", shape = rectangle];
+                            push_to_rhythm [label = "Push correct number to the rhythms list."];
+                            decrement_beat_count [label = "Decrement number of beats."];
+
+                            pick_random -> {case_0, case_1, case_2, case_3, case_4};
+                            case_0 -> mod_4;
+                            case_1 -> mod_2;
+                            {mod_4, mod_2} -> pick_random [label = "False"];
+                            {mod_4, mod_2} -> push_to_rhythm [label = "True"];
+                            {case_2, case_3, case_4} -> push_to_rhythm;
+                            push_to_rhythm -> decrement_beat_count;
+                   }
+
+                   beat_count -> pick_random;
+                   decrement_beat_count -> continue;
+                   continue -> pick_random [label = "False"];
+                   continue -> reverse [label = "True"];
+          }
+          subgraph cluster_generate_notes {
+                   rank = same;
+                   for_rhythms [label = "For Each Rhythm", shape = rectangle, rank = top];
+                   pick_random2 [label = "Pick a random number\n0--8"];
+                   if_0 [label = "Number == 0", shape = rectangle];
+                   reverse_notes [label = "Reverse Note Order"];
+                   push_note [label = "Push Note"];
+                   do_changes [label = "Push Set of Changes."];
+                   rhythms_left [label = "Rhythms-Count == 0", shape = rectangle];
+                   decrement_rhythms [label = "Decrement Rhythm Count"];
+                   merge_rhythms_notes [label = "Merge Rhythms and Notes"];
+
+                   for_rhythms -> pick_random2;
+                   pick_random2 -> if_0;
+                   if_0 -> do_changes [label = "True"];
+                   if_0 -> push_note [label = "False"];
+                   {do_changes, push_note} -> decrement_rhythms;
+                   decrement_rhythms -> rhythms_left;
+                   rhythms_left -> for_rhythms [label = "False"];
+                   rhythms_left -> reverse_notes [label = "True"];
+                   reverse_notes -> merge_rhythms_notes;
+          }
+          subgraph cluster_generate_score {
+                   rank = same;
+                   for_rhythm_note_pair [label = "For Each Rhythm", shape = rectangle];
+                   format_header [label = "Format Header"];
+                   format_note [label = "Format Note"];
+                   process_lilypond [label = "Process Lilypond File"];
+                   notes_left [label = "Notes-left == 0", shape = rectangle];
+
+                   format_header -> for_rhythm_note_pair;
+                   for_rhythm_note_pair -> format_note;
+                   format_note -> notes_left;
+                   notes_left -> for_rhythm_note_pair [label = "False"];
+                   notes_left -> process_lilypond [label = "True"];
+          }
+
+          entry -> beat_count;
+          reverse -> for_rhythms;
+          merge_rhythms_notes -> format_header;
+          process_lilypond -> exit;
+  }
+#+END_SRC
+
+#+Caption: General Overview
+#+Name: figure:overview
+#+RESULTS: overview
+[[file:overview.png]]
+
+#+Caption: Putting it Together
+#+Name: put-together
+#+BEGIN_SRC lisp :tangle "johnson-trotter.lisp"
+  (defpackage #:muzic
+    (:use #:cl
+          #:uiop)
+    (:export #:create-score))
+
+  (in-package #:muzic)
+
+  <<keys-and-mappings>>
+
+  <<helper-functions>>
+
+  <<generate-permutations>>
+
+  <<generate-durations>>
+
+  <<generate-set-of-notes>>
+
+  <<generate-note>>
+
+  <<create-a-score>>
+#+END_SRC

music-theory-based-generation.org

@@ -0,0 +1,376 @@
+#+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

music-theory-based-generation.org_archive

@@ -0,0 +1,72 @@
+#    -*- mode: org -*-
+
+
+Archived entries from file /home/swflint/org/music-theory-based-generation.org
+
+
+* Keys
+  :PROPERTIES:
+  :ARCHIVE_TIME: 2015-08-02 Sun 14:32
+  :ARCHIVE_FILE: ~/org/music-theory-based-generation.org
+  :ARCHIVE_CATEGORY: music-theory-based-generation
+  :END:
+
+#+Caption: Keys and Calculation
+#+Name: keys-and-calculation
+#+BEGIN_SRC lisp
+  (defvar *notes*
+    '(:c-flat-c
+      :c-sharp-d-flat
+      :d :d-sharp-e-flat
+      :e-e-sharp-f-flat-f
+      :f-sharp-g-flat
+      :g :g-sharp-a-flat
+      :a :a-sharp-b-flat
+      :b-b-sharp-c-flat-c
+      :c-sharp-d-flat
+      :d :d-sharp-e-flat
+      :e-e-sharp-f-flat-f
+      :f-sharp-g-flat
+      :g :g-sharp-a-flat
+      :a :a-sharp-b-flat
+      :b-b-sharp-c-flat-c
+      :c-sharp))
+
+  (defvar *note-index*
+    '((:c-flat 0)
+      (:c 0)
+      (:c-sharp 1)
+      (:d-flat 1)
+      (:d 2)
+      (:d-sharp 3)
+      (:e-flat 3)
+      (:e 4)
+      (:e-sharp 4)
+      (:f-flat 4)
+      (:f 4)
+      (:f-sharp 5)
+      (:g-flat 5)
+      (:g 6)
+      (:g-sharp 7)
+      (:a-flat 7)
+      (:a 8)
+      (:a-sharp 9)
+      (:b-flat 9)
+      (:b 10)
+      (:b-sharp 10)))
+
+  (defvar *whole-step* 2)
+  (defvar *half-step* 1)
+
+  (defun calculate-scale (starting-note &optional (major-or-minor :major))
+    (let ((index (cadr (assoc starting-note *note-index*)))
+          (notes (list)))
+      (dolist (index-add (list *whole-step* *whole-step* *half-step* *whole-step* *whole-step* *whole-step* *half-step*))
+        (push (nth index *notes*) notes)
+        (setf index (+ index index-add)))
+      (reverse notes)))
+
+  (defvar *notes*
+    '((:c-flat :c :c-sharp)
+      ))
+#+END_SRC