Lisp Music Scales, Chords and Progressions

2006-02-22 13:18:00

I wanted to be able to ask the computer certain music questions. For instance:

(major-scale A#)
(major-chord A#)
(chord-progression (I III V) A#)

After a little lisp programming last night I was up to the level where I could define what a scale is by the language of that domain. I could pick up my book of scales and key them in just like they where listed.

(make-scale major-scale '(W W H W W W H))

Another example of lisp's supriority. All that is left to do now is to teach lisp how to build chords and chord progressions, both should be straight forward.

(defparameter *notes* '(A (A# Bb) B C (C# Cb) D (D# Eb) E F (F# Gb) G (G# Ab)))

(defun sharp (x)
  (car x))

(defun flat (x)
  (cdr x))

(defun find-note (note)
  (labels ((do-search (notes i)
       (cond
         ((null notes) nil)
         ((and (atom (car notes)) (eq note (car notes))) i)
         ((and (consp (car notes)) 
         (or (eq note (first (car notes)))
       (eq note (second (car notes))))) i)
         (t (do-search (cdr notes) (+ i 1))))))
    (do-search *notes* 0)))
      
(defun get-note (idx)
  "Handels wrap around when asking for a note. Anything over 11 gets
wrapped"
  (nth (mod idx 12) *notes*))

(defmacro make-stepper (name amount)
  `(defun ,name (note) 
      (get-note 
       (+ (find-note 
     (if (consp note) (first note) note))
    ,amount))))

(defmacro make-scale (name steps)
  `(defun ,name (note)
    (let ((steps ,steps))
      (labels ((build-scale (scale step note)
     (cond ((null (car step)) (nreverse scale))
           (t 
      (setf note (funcall (car step) note))
      (build-scale (cons note scale) (cdr step) note)))))
  (build-scale (list note) steps note)))))

(defun item-from-cons (list idx)
  "Scroll through a list if you find a cons return the item specified"
  (labels ((fix-list (old-list new-list)
       (cond
         ((null old-list) (nreverse new-list))
         ((consp (car old-list))
    (fix-list (cdr old-list) (cons (funcall idx (car old-list)) new-list)))
         (t
    (fix-list (cdr old-list) (cons (car old-list) new-list))))))
    (fix-list list '())))
         
(defun show-sharps (list)
  (item-from-cons list 'first))

(defun show-flats (list)
  (item-from-cons list 'second))

(make-stepper H  1)
(make-stepper W  2)
(make-stepper Wh 3)
                        
(make-scale major-scale '(W W H W W W H))
(make-scale major-pentationic '(W W Wh W Wh))
(make-scale natural-minor-scale '(W H W W H W W))
(make-scale minor-pentatonic '(Wh W W Wh W))
(make-scale blues-scale '(Wh W H H Wh W))
(make-scale mixo-blues-scale '(W H H H H H W H W))
(make-scale mixolydian-mode '(W W H W W H W))
(make-scale dorian-mode '(W H W W W H W))
(make-scale melodic-minor-scale '(W H W W W W H))
(make-scale harmonic-minor-scale '(W H W W H Wh H))
(make-scale phrygian-mode '(H W W W H W W))
(make-scale locrian-mode '(H W W H W W W))
(make-scale lydian-mode '(W W W H W W H))
(make-scale diminished-half-whole '(H W H W H W H W))
(make-scale diminished-scale-whole-half '(W H W H W H W H))
(make-scale chromatic-scale '(H H H H H H H H H H H H))
(make-scale whole-tone '(W W W W W W))

Here is some example output form the program:

CL-USER> (major-scale 'c)
(C D E F G A B C)
CL-USER> (whole-tone 'c)
(C D E (F# GB) (G# AB) (A# BB) C)
CL-USER> (show-sharps (whole-tone 'c))
(C D E F# G# A# C)
CL-USER> (show-sharps (natural-minor-scale 'a#))
(A# C C# D# F F# G# A#)