;;; -*- Mode:LISP; Package:MIDI; Base:10; Readtable:ZL -*-
;;;
;;;
;;;
;;;

;---
;middle c is 60.

(defun play-scale (&optional (delay 20))
  (dolist (note '(60. 62. 64. 65. 67. 69. 71. 72. 71. 69. 67. 65. 64. 62. 60.))
    (@note-on note)
    (process-sleep delay)
    (@note-off note)))

(defun chromatic-scale (&optional (note-length 10))
  (dotimes (i 127.)
    (play-note i note-length)))

(defun chromatic-scale-down (&optional (note-length 10))
  (dotimes (i 127.)
    (play-note (- 127. i) note-length)))

(defun twinkle ()
  (do-forever (play-note (random 127.) 0)))

(defun play-note (note length &optional (loudness 64.))
  (unwind-protect
      (progn
	(@note-on note 0 loudness)
	(process-sleep (// length 2)))
    (@note-off note)))

(defun all-off (&optional channel)
  (if channel
      (control-change 123. 0 :channel channel)
    (dotimes (c 16)
      (all-off c))))

(deff quiet 'all-off)

(defun win ()
  (play-note 67. 10.)
  (play-note 65. 10.)
  (play-note 67. 10.)
  (play-note 62. 20.)
  (play-note 64. 10.)
  (play-note 60. 30.)
  (play-note 72. 10.))

;----

(defmacro with-quietness-at-the-end (&body body)
  `(condition-bind ((condition) #'(lambda (&rest ignore) (quiet) nil))
     ,@body))

;simple scheme

; list of lists
;  sub-list:  (time-from-start note velocity)
(defvar *simple-note-list* nil)

(defun play-simple-notes (&optional (note-list *simple-note-list*))
  (let ((start-time (time)))
    (dolist (note-desc note-list)
      (do ()
	  ((time-lessp (time-increment start-time (fix (car note-desc)))
		       (time))))
      (cond ((numberp (cadr note-desc))
	     (@note-on (cadr note-desc) 0 (caddr note-desc)))
	    (t
	     (selectq (cadr note-desc)
	       (damper (damper (caddr note-desc)))))
	    )))
  (quiet))


(defun add-to-simple-note-list (time-from-start note velocity duration)
  (block done
    (do ((notes *simple-note-list* (cdr notes))
	 (last-cdr (locf *simple-note-list*) notes))
	((null notes)
	 (rplacd last-cdr
		 (if (numberp note)
		     (list (list time-from-start note velocity)
			   (list (+ time-from-start duration) note 0))
		   (list (list time-from-start note velocity)))))
      (cond ((<= time-from-start (caar notes))
	     (rplacd last-cdr
		     (cons (list time-from-start note velocity)
			   notes))
	     (do ((n-notes notes (cdr n-notes))
		  (dont-step-n-last-cdr nil nil)
		  (n-last-cdr (cdr last-cdr) (if dont-step-n-last-cdr
						 n-last-cdr
					       (cdr n-last-cdr)))
		  )
		 ((null n-notes)
		  (if (numberp note)
		      (rplacd n-last-cdr
			      (list (list (+ time-from-start duration) note 0))))
		  (return-from done nil))
	       (cond ((<= (+ time-from-start duration) (caar n-notes))
		      (if (numberp note)
			  (rplacd n-last-cdr
				  (cons (list (+ time-from-start duration) note 0)
					n-notes)))
		      (return-from done nil))
		     ((and (eq (cadar n-notes) note)
			   (eq (caddar n-notes) 0))
		      (rplacd n-last-cdr (cdr n-notes))
		      (setq dont-step-n-last-cdr t)
		      )
		     
		     ))))
      ))
  *simple-note-list*)

(defun triad ()
  (setq *simple-note-list* nil)
  (add-to-simple-note-list 0 60. 30. 60.)
  (add-to-simple-note-list 30. 60. 30. 60.)
  (add-to-simple-note-list 60. 64. 30. 60.)
  (add-to-simple-note-list 120. 67. 30. 60.)
  (play-simple-notes *simple-note-list*))

(defun damper (on-p)
  (mks-10-damper on-p))

(defun setup-note-properties ()
  (dotimes (octave 8)
    (do ((notes '(("C~D")
		  ("C~D#" "D~D")
		  ("D~D")
		  ("D~D#" "E~D")
		  ("E~D")
		  ("F~D")
		  ("F~D#" "G~D")
		  ("G~D")
		  ("G~D#" "A~D")
		  ("A~D")
		  ("A~D#" "B~D")
		  ("B~D"))
		(cdr notes))
	 (scale-number 0 (1+ scale-number)))
	((null notes))
      (dolist (enharmonic-note (car notes))
	(let ((sym (intern (format nil enharmonic-note octave) (symbol-package 'foo))))
	  (putprop sym
		   (+ (* (1+ octave) 12.) scale-number)
		   'note-number))))))
(setup-note-properties)

(defconst cannon
	  '(
	    (damper t)
	    ((d4 1\8) (d3 1\2) (f3# 1\2) (a3 1\2))
	    (f4# 1\8)
	    (a4 1\8)
	    (d5 1\8)
	    (damper nil)
	    (damper t)
	    ((c4# 1\8) (a2 1\2) (e3 1\2) (a3 1\2))
	    (e4 1\8)
	    (a4 1\8)
	    (c5# 1\8)
	    (damper nil)
	    (damper t)
	    ((b3 1\8) (b2 1\2) (d3 1\2) (f2# 1\2))
	    (d4 1\8)
	    (f4# 1\8)
	    (b4 1\8)
	    (damper nil)
	    (damper t)
	    ((a3 1\8) (f2# 1\2) (c3# 1\2) (f3# 1\2))
	    (c4# 1\8)
	    (f4# 1\8)
	    (a4 1\8)
	    (damper nil)
	    (damper t)
	    ((b3 1\8) (g2 1\2) (d3 1\2) (g3 1\2))
	    (d4 1\8)
	    (g4 1\8)
	    (b4 1\8)
	    (damper nil)
	    (damper t)
	    ((a3 1\8) (d2 1\2) (a2 1\2) (f3# 1\2))
	    (d4 1\8)
	    (f4# 1\8)
	    (a4 1\8)
	    (damper nil)
	    (damper t)
	    ((b3 1\8) (g2 1\2) (d3 1\2) (g3 1\2))
	    (d4 1\8)
	    (g4 1\8)
	    (b4 1\8)
	    (damper nil)
	    (damper t)
	    ((c4# 1\8) (a2 1\2) (e3 1\2) (a3 1\2))
	    (e4 1\8)
	    (a4 1\8)
	    (c5# 1\8)
	    (damper nil)


	    (damper t)
	    ((rest 1\8) (f5# 1\2) (d3 1\2))
	    (a3 1\8)
	    (d4 1\8)
	    (f4# 1\8)
	    (damper nil)
	    (damper t)
	    ((rest 1\8) (e5 1\2) (a2 1\2))
	    (a3 1\8)
	    (c4# 1\8)
	    (e4 1\8)
	    (damper nil)
	    (damper t)
	    ((rest 1\8) (d5 1\2) (b2 1\2))
	    (f3# 1\8)
	    (b3 1\8)
	    (d4 1\8)
	    (damper nil)
	    (damper t)
	    ((rest 1\8) (c5# 1\2) (f2# 1\2))
	    (a3 1\8)
	    (c4# 1\8)
	    (f4# 1\8)
	    (damper nil)
	    (damper t)
	    ((rest 1\8) (b4 1\2) (g2 1\2))
	    (g3 1\8)
	    (b3 1\8)
	    (d4 1\8)
	    (damper nil)
	    (damper t)
	    ((rest 1\8) (a4 1\2) (d2 1\2))
	    (f3# 1\8)
	    (a3 1\8)
	    (d4 1\8)
	    (damper nil)
	    (damper t)
	    ((rest 1\8) (b4 1\2) (g2 1\2))
	    (g3 1\8)
	    (b3 1\8)
	    (d4 1\8)
	    (damper nil)
	    (damper t)
	    ((rest 1\8) (c5# 1\2) (a2 1\2))
	    (a3 1\8)
	    (c4# 1\8)
	    (e4 1\8)
	    (damper nil)
	    ))

(defconst chord '(((c4# 1\2) (a2 1\2) (e3 1\2) (a3 1\2))))

(defconst *midi-package* (find-package 'midi))

(defun midintern (&rest things)
  (intern (apply #'string-append things) *midi-package*))

(defparameter *keyboard-table-sharps*
	      #((c . "") (c . "#") (d . "") (d . "#") (e . "") (f . "") (f . "#")
		(g . "") (g . "#") (a . "") (a . "#") (b . "")))

(defparameter *keyboard-table-flats*
	      #((c . "") (d . "") (d . "") (e . "") (e . "") (f . "") (g . "")
		(g . "") (a . "") (a . "") (b . "") (b . "")))

;;; 0 is c1, and chromatically-upwards we go
(defun note-from-number (n &optional (return-sharps t))
  (multiple-value-bind (octave note) (floor n 12.)
    (let ((kbd-val (aref (if return-sharps
			     *keyboard-table-sharps*
			   *keyboard-table-flats*)
			 note)))
      (midintern (car kbd-val) (format () "~D" (1- octave)) (cdr kbd-val)))))

;;; Some other stuff is in LAM3: RPK.LM; MUSE

(defconst c-chords
	  '(
	    (damper t)
	    ((c3 1\2) (e3 1\2) (g3 1\2) (c2 1\2))
	    (damper nil)
	    (rest 1\8)
	    (damper t)
	    ((c4 1\2) (e4 1\2) (g4 1\2) (c3 1\2))
	    (damper nil)
	    (rest 1\8)
	    (damper t)
	    ((c5 1\2) (e5 1\2) (g5 1\2) (c4 1\2))
	    (damper nil)))

(defconst scale '((c4 1\8)
		  (d4 1\8)
		  (e4 1\8)
		  (f4 1\8)
		  (g4 1\8)
		  (a4 1\8)
		  (b4 1\8)
		  (c5 1\8)))

(defconst c-chord '((c4 1\8)
		    (e4 1\8)
		    (g4 1\8)
		    ))

(defun make-simple-note-list (&optional (song cannon) (reset-simple-note-list t)
			      (current-time 0))
  (if reset-simple-note-list
      (setq *simple-note-list* nil))
  (dolist (clause song)
    (incf current-time (do-simple-note-clause clause current-time)))
  current-time)

(defun do-simple-note-clause (clause start-time)
  (selectq (car clause)
    (damper (add-to-simple-note-list start-time 'damper (cadr clause) 0)
	    0)
    (t
     (cond ((symbolp (car clause))
	    (do-simple-note-note-clause clause start-time))
	   (t
	    (let ((clause-length (do-simple-note-note-clause (car clause) start-time)))
	      (dolist (c clause)
		(do-simple-note-note-clause c start-time))
	      clause-length))))))

(defvar *speed* 180.)

(defun do-simple-note-note-clause (clause start-time)
  (let ((note-number (get (car clause) 'note-number))
	(quantums (* (cadr clause) *speed*)))
    (cond ((eq (car clause) 'rest)
	   quantums)
	  ((null note-number)
	   (ferror nil "bad clause ~s" clause))
	  (t
	   (add-to-simple-note-list start-time note-number 30. quantums)
	   quantums))))

(defun convert-midi-array-to-song ()
  (loop for note in (return-just-notes)
	collect (list (note-from-number note nil) 1\32)))


(defun i14 (&aux (current-time 0))
  (setq *simple-note-list* nil)
  (let ((p1 (make-simple-note-list invention-14-phrase-1-left nil current-time))
	(p2 (make-simple-note-list invention-14-phrase-1-right nil current-time)))
    (cond ((not (= p1 p2))
	   (ferror nil "phases not same length")))
    (setq current-time p1))
  (let ((p1 (make-simple-note-list invention-14-phrase-2-left nil current-time))
	(p2 (make-simple-note-list invention-14-phrase-2-right nil current-time)))
    (cond ((not (= p1 p2))
	   (ferror nil "phases not same length")))
    (setq current-time p1))

  (let ((p1 (make-simple-note-list invention-14-phrase-3-left nil current-time))
	(p2 (make-simple-note-list invention-14-phrase-3-right nil current-time)))
    (cond ((not (= p1 p2))
	   (ferror nil "phases not same length")))
    (setq current-time p1))

  (let ((p1 (make-simple-note-list invention-14-phrase-4-left nil current-time))
	(p2 (make-simple-note-list invention-14-phrase-4-right nil current-time)))
    (cond ((not (= p1 p2))
	   (ferror nil "phases not same length")))
    (setq current-time p1))

  (let ((p1 (make-simple-note-list invention-14-phrase-5-left nil current-time))
	(p2 (make-simple-note-list invention-14-phrase-5-right nil current-time)))
    (cond ((not (= p1 p2))
	   (ferror nil "phases not same length")))
    (setq current-time p1))

  (let ((p1 (make-simple-note-list invention-14-phrase-6-left nil current-time))
	(p2 (make-simple-note-list invention-14-phrase-6-right nil current-time)))
    (cond ((not (= p1 p2))
	   (ferror nil "phases not same length")))
    (setq current-time p1))

  (play-simple-notes))

(defun foo ()
  (setq *simple-note-list* nil)
  (make-simple-note-list invention-14-phrase-6-left nil)
  (make-simple-note-list invention-14-phrase-6-right nil)
  (play-simple-notes))


(defconst invention-14-phrase-1-left
	  '((rest 1\16)
	    (B4 1\32)
	    (C5 1\32)
	    ;.
	    (D5 1\32)
	    (C5 1\32)
	    (B4 1\16)
	    ;.
	    (F5 1\16)
	    (D5 1\16)
	    ;.
	    (B5 1\16)
	    (F5 1\16)
	    ;.
	    (D5 1\16)
	    (F5 1\32)
	    (E5 1\32)
	    ;.
	    (D5 1\32)
	    (e5 1\32)
	    (F5 1\16)
	    ;.
	    (B4 1\16)
	    (D5 1\16)
	    ;.
	    (f4 1\16)
	    (A4 1\16)
            ;---
	    (G4 1\16)
	    (E4 1\32)
	    (F4 1\32)
	    ;.
	    (G4 1\32)
	    (F4 1\32)
	    (E4 1\16)
	    ;.
	    (B4 1\16)
	    (G4 1\16)
	    ;.
	    (E5 1\16)
	    (B4 1\16)
	    ;.
	    (G4 1\16)
	    (B4 1\32)
	    (A4 1\32)
	    ;.
	    (G4 1\32)
	    (A4 1\32)
	    (B4 1\16)
	    ;.
	    (E4 1\16)
	    (G4 1\16)
	    ;.
	    (C4 1\16)
	    (E4 1\16)
	    ;---
	    (A3 1\16)
	    (C4 1\32)
	    (D4 1\32)
	    ;.
	    (E4 1\32)
	    (D4 1\32)
	    (C4 1\16)
	    ;.
	    (A4 1\16)
	    (F4 1\16)
	    ;.
	    (C5 1\16)
	    (A4 1\16)
	    ;.
	    (E5 1\16)
	    (F4 1\32)
	    (G4 1\32)
	    ;.
	    (A4 1\32)
	    (G4 1\32)
	    (F4 1\16)
	    ;.
	    (C5 1\16)
	    (A4 1\16)
	    ;.
	    (F5 1\16)
	    (C5 1\16)))

(defconst invention-14-phrase-1-right
	  '((B3 1\8)
	    (B2 1\8)
	    (D3 1\8)
	    (F3 1\8)
	    (B3 1\4)
	    (rest 1\4)
	    ;---
	    (rest 1\8)
	    (B2 1\8)
	    (E3 1\8)
	    (G3 1\8)
	    (B3 1\4)
	    (rest 1\4)
	    ;---
	    (rest 1\8)
	    (B2 1\8)
	    (C3 1\8)
	    (E3 1\8)
	    (A3 1\4)
	    (rest 1\4)))

(defconst invention-14-phrase-2-left
	  '((D5 1\8)
	    (rest 1\8)
	    (rest 1\16)
	    (G5 1\32)
	    (F5 1\32)
	    (E5 1\32)
	    (F5 1\32)
	    (G5 1\16)
	    (C5 1\8)
	    (rest 1\8)
	    (rest 1\16)
	    (F5 1\32)
	    (E5 1\32)
	    (D5 1\32)
	    (E5 1\32)
	    (F5 1\16)
	    ;---
	    (B4 1\8)
	    (rest 1\8)
	    (rest 1\16)
	    (E5 1\32)
	    (D5 1\32)
	    (C5 1\32)
	    (D5 1\32)
	    (e5 1\16)
	    (A4 1\16)
	    (C5 1\32)
	    (B4 1\32)
	    (A4 1\32)
	    (B4 1\32)
	    (C5 1\16)
	    (F4 1\8)
	    (rest 1\8)
	    ))

(defconst invention-14-phrase-2-right
	  '((rest 1\16)
	    (B3 1\32)
	    (C4 1\32)
	    (D4 1\32)
	    (C4 1\32)
	    (B3 1\16)
	    (E4 1\8)
	    (rest 1\8)
	    (rest 1\16)
	    (A3 1\32)
	    (B3 1\32)
	    (C4 1\32)
	    (B3 1\32)
	    (A3 1\16)
	    (D4 1\8)
	    (rest 1\8)
	    ;---
	    (rest 1\16)
	    (G3 1\32)
	    (A3 1\32)
	    (B3 1\32)
	    (A3 1\32)
	    (G3 1\16)
	    (C4 1\16)
	    (C3 1\32)
	    (D3 1\32)
	    (E3 1\32)
	    (D3 1\32)
	    (C3 1\16)
	    (F3 1\8)
	    (F2 1\8)
	    (rest 1\16)
	    (C4 1\16)
	    (A3 1\16)
	    (f3 1\16)
	    ))

(defconst invention-14-phrase-3-left
	  '((F5 1\8)
	    (F4 1\8)
	    (A4 1\8)
	    (C5 1\8)
	    (F5 1\4)
	    (rest 1\4)
	    ;---
	    (rest 1\8)
	    (F4 1\8)
	    (B4 1\8)
	    (D5 1\8)
	    (F5 1\4)
	    (rest 1\4)
	    ;---
	    (rest 1\8)
	    (G4 1\8)
	    (B4 1\8)
	    (C5 1\8)
	    (E5 1\4)
	    (rest 1\4)
	    ))


(defconst invention-14-phrase-3-right
	  '((rest 1\16)
	    (F3 1\32)
	    (G3 1\32)
	    (A3 1\32)
	    (G3 1\32)
	    (F3 1\16)

	    (C4 1\16)
	    (A3 1\16)
	    (F4 1\16)
	    (C4 1\16)

	    (A3 1\16)
	    (C4 1\32)
	    (B3 1\32)
	    (A3 1\32)
	    (B3 1\32)
	    (C4 1\16)

	    (F3 1\16)
	    (A3 1\16)
	    (C3 1\16)
	    (E3 1\16)

	    (D3 1\16)
	    (B2 1\32)
	    (C3 1\32)
	    (D3 1\32)
	    (C3 1\32)
	    (B2 1\16)

	    (F3 1\16)
	    (D3 1\16)
	    (B3 1\16)
	    (F3 1\16)

	    (D3 1\16)
	    (F3 1\32)
	    (E3 1\32)
	    (D3 1\32)
	    (E3 1\32)
	    (F3 1\16)

	    (B2 1\16)
	    (D3 1\16)
	    (G2 1\16)
	    (B2 1\16)

	    (E2 1\16)
	    (G2 1\32)
	    (A2 1\32)
	    (B2 1\32)
	    (A2 1\32)
	    (G2 1\16)

	    (E3 1\16)
	    (C3 1\16)
	    (G3 1\16)
	    (E3 1\16)

	    (B3 1\16)
	    (C3 1\32)
	    (D3 1\32)
	    (E3 1\32)
	    (D3 1\32)
	    (C3 1\16)

	    (G3 1\16)
	    (E3 1\16)
	    (C4 1\16)
	    (G3 1\16)
	    ))

(defconst invention-14-phrase-4-left
	  '((rest 1\16)
	    (F4 1\32)
	    (G4 1\32)
	    (A4 1\32)
	    (G4 1\32)
	    (F4 1\16)

	    (C5 1\16)
	    (A4 1\16)
	    (F5 1\16)
	    (C5 1\16)

	    (A5 1\16)
	    (E5 1\32)
	    (D5 1\32)
	    (C5 1\32)
	    (D5 1\32)
	    (E5 1\16)

	    (A4 1\16)
	    (C5 1\16)
	    (f4# 1\16)
	    (D5 1\16)
	    ;---
	    (B4 1\8)
	    (D5 1\8)
	    (B4 1\8)
	    (G4 1\8)

	    (A4 1\8)
	    (F5 1\8)
	    (A4 1\8)
	    (F4 1\8)
	    ;---
	    (G4 1\16)
	    (C4 1\32)
	    (D4 1\32)
	    (E4 1\32)
	    (D4 1\32)
	    (C4 1\16)

	    (G4 1\16)
	    (E4 1\16)
	    (C5 1\16)
	    (G4 1\16)

	    (D5 1\16)
	    (A4 1\32)
	    (G4 1\32)
	    (F4 1\32)
	    (G4 1\32)
	    (A4 1\16)

	    (D4 1\16)
	    (F4 1\16)
	    (B3 1\16)
	    (G4 1\16)
	    ))

(defconst invention-14-phrase-4-right
	  '((A3 1\8)
	    (C4 1\8)
	    (A3 1\8)
	    (F3 1\8)

	    (f3# 1\8)
	    (A3 1\8)
	    (f3# 1\8)
	    (D3 1\8)

	    (G3 1\16)
	    (G2 1\32)
	    (A2 1\32)
	    (B2 1\32)
	    (A2 1\32)
	    (G2 1\16)

	    (D3 1\16)
	    (B2 1\16)
	    (G3 1\16)
	    (D3 1\16)

	    (B3 1\16)
	    (A3 1\32)
	    (G3 1\32)
	    (F3 1\32)
	    (G3 1\32)
	    (A3 1\16)

	    (D3 1\16)
	    (F3 1\16)
	    (B2 1\16)
	    (D3 1\16)

	    (E3 1\8)
	    (G3 1\8)
	    (E3 1\8)
	    (C3 1\8)

	    (B2 1\8)
	    (D3 1\8)
	    (B2 1\8)
	    (G2 1\8)))

(defconst invention-14-phrase-5-left
	  '((E4 1\8)
	    (rest 1\8)
	    (rest 1\16)
	    (C4 1\32)
	    (D4 1\32)
	    (E4 1\32)
	    (D4 1\32)
	    (C4 1\16)

	    (C5 3\16)
	    (B4 1\16)
	    (A4 1\16)
	    (F4 1\32)
	    (G4 1\32)
	    (A4 1\32)
	    (G4 1\32)
	    (F4 1\16)

	    (F5 3\16)
	    (e5 1\16)
	    (D5 1\16)
	    (B4 1\32)
	    (C5 1\32)
	    (D5 1\32)
	    (C5 1\32)
	    (B4 1\16)

	    (B5 3\16)
	    (A5 1\16)
	    (G5 1\16)
	    (B5 1\32)
	    (A5 1\32)
	    (G5 1\32)
	    (A5 1\32)
	    (B5 1\16)

	    (E5 1\16)
	    (G5 1\32)
	    (F5 1\32)
	    (E5 1\32)
	    (F5 1\32)
	    (G5 1\16)

	    (C5 1\16)
	    (E5 1\32)
	    (D5 1\32)
	    (C5 1\32)
	    (D5 1\32)
	    (E5 1\16)
	    
	    (A4 1\16)
	    (C5 1\32)
	    (D5 1\32)
	    (E5 1\32)
	    (D5 1\32)
	    (C5 1\16)

	    (F5 1\16)
	    (A4 1\32)
	    (G4 1\32)
	    (F4 1\32)
	    (G4 1\32)
	    (A4 1\16)

	    (G4 1\16)
	    (B4 1\32)
	    (C5 1\32)
	    (D5 1\32)
	    (C5 1\32)
	    (B4 1\16)

	    (E5 1\16)
	    (G4 1\32)
	    (F4 1\32)
	    (E4 1\32)
	    (F4 1\32)
	    (G4 1\16)

	    (F4 1\16)
	    (A4 1\32)
	    (B4 1\32)
	    (C5 1\32)
	    (B4 1\32)
	    (A4 1\16)

	    (D5 1\16)
	    (F4 1\32)
	    (E4 1\32)
	    (D4 1\32)
	    (E4 1\32)
	    (F4 1\16)

	    (E4 1\16)
	    (G4 1\32)
	    (A4 1\32)
	    (B4 1\32)
	    (A4 1\32)
	    (G4 1\16)

	    (C5 1\16)
	    (E4 1\32)
	    (D4 1\32)
	    (C4 1\32)
	    (D4 1\32)
	    (E4 1\16)
	    (D4 1\4)

	    (rest 1\16)
	    (b4 1\32)
	    (c5 1\32)
	    (d5 1\32)
	    (c5 1\32)
	    (b4 1\16)
	    
	    ))

(defconst invention-14-phrase-5-right
	  '((C3 1\16)
	    (C2 1\32)
	    (D2 1\32)
	    (E2 1\32)
	    (D2 1\32)
	    (C2 1\16)

	    (C3 3\16)
	    (B2 1\16)
	    ;---
	    (A2 1\16)
	    (F2 1\32)
	    (G2 1\32)
	    (A2 1\32)
	    (G2 1\32)
	    (F2 1\16)

	    (f3 3\16)
	    (E3 1\16)
	    ;---
	    (D3 1\16)
	    (B2 1\32)
	    (C3 1\32)
	    (D3 1\32)
	    (C3 1\32)
	    (B2 1\16)

	    (B3 3\16)
	    (A3 1\16)

	    (G3 1\16)
	    (E3 1\32)
	    (F3 1\32)
	    (G3 1\32)
	    (F3 1\32)
	    (E3 1\16)

	    (E4 3\16)
	    (D4 1\16)

	    (C4 1\16)
	    (E4 1\32)
	    (D4 1\32)
	    (C4 1\32)
	    (D4 1\32)
	    (E4 1\16)

	    (A3 1\16)
	    (C4 1\32)
	    (B3 1\32)
	    (A3 1\32)
	    (B3 1\32)
	    (C4 1\16)

	    (F3 1\16)
	    (A3 1\32)
	    (B3 1\32)
	    (C4 1\32)
	    (B3 1\32)
	    (A3 1\16)

	    (D4 1\16)
	    (F3 1\32)
	    (E3 1\32)
	    (D3 1\32)
	    (E3 1\32)
	    (F3 1\16)
	    ;---
	    (E3 1\16)
	    (G3 1\32)
	    (A3 1\32)
	    (B3 1\32)
	    (A3 1\32)
	    (G3 1\16)

	    (C4 1\16)
	    (E3 1\32)
	    (D3 1\32)
	    (C3 1\32)
	    (D3 1\32)
	    (E3 1\16)

	    (D3 1\16)
	    (F3 1\32)
	    (G3 1\32)
	    (A3 1\32)
	    (G3 1\32)
	    (F3 1\16)

	    (B3 1\16)
	    (D3 1\32)
	    (C3 1\32)
	    (B2 1\32)
	    (C3 1\32)
	    (D3 1\16)
	    ;---
	    (C3 1\16)
	    (E3 1\32)
	    (F3 1\32)
	    (G3 1\32)
	    (F3 1\32)
	    (E3 1\16)

	    (A3 1\16)
	    (C3 1\32)
	    (B2 1\32)
	    (A2 1\32)
	    (B2 1\32)
	    (C3 1\16)

	    (B2 1\16)
	    (B3 1\32)
	    (C4 1\32)
	    (D4 1\32)
	    (C4 1\32)
	    (B3 1\16)

	    (F4 1\16)
	    (D4 1\16)
	    (B4 1\16)
	    (F4 1\16)))

(defconst invention-14-phrase-6-left
	  '((F5 1\16)
	    (D5 1\16)
	    (B5 1\16)
	    (F5 1\16)

	    (D5 1\16)
	    (F5 1\32)
	    (E5 1\32)
	    (D5 1\32)
	    (E5 1\32)
	    (F5 1\16)
	    ;---
	    (B4 1\16)
	    (E5 1\16)
	    (B4 1\16)
	    (E5 1\16)

	    (G4 1\16)
	    (E4 1\32)
	    (F4 1\32)
	    (G4 1\32)
	    (F4 1\32)
	    (E4 1\16)
	    ;---
	    (B4 1\16)
	    (G4 1\16)
	    (E5 1\16)
	    (B4 1\16)

	    (G4 1\16)
	    (B4 1\32)
	    (A4 1\32)
	    (G4 1\32)
	    (A4 1\32)
	    (B4 1\16)

	    (E4 1\8)

	    (E5 3\16)

	    (E5 1\32)
	    (D5 1\32)
	    (C5 1\32)
	    (D5 1\32)
	    (E5 1\16)
	    ;---
	    (F4 1\8)

	    (E5 3\16)

	    (C5 1\32)
	    (D5 1\32)
	    (E5 1\32)
	    (D5 1\32)
	    (C5 1\16)

	    (F5 1\16)
	    (D5 1\32)
	    (C5 1\32)
	    (B4 1\32)
	    (C5 1\32)
	    (D5 1\16)

	    (F4 1\16)
	    (B4 1\16)
	    (C5 1\16)
	    (A4 1\16)
	    (B4 1)))

(defconst invention-14-phrase-6-right
	  '((B3 1\16)
	    (F4 1\32)
            (E4 1\32)
            (D4 1\32)
            (E4 1\32)
            (F4 1\16)

            (B3 1\16)
            (D4 1\16)
            (F3 1\16)
            (A3 1\16)

            (G3 1\16)
            (E3 1\32)
            (F3 1\32)
            (G3 1\32)
            (F3 1\32)
            (E3 1\16)

            (B3 1\16)
            (G3 1\16)
            (E4 1\16)
            (B3 1\16)

            (G3 1\16)
            (B3 1\32)
            (A3 1\32)
            (G3 1\32)
            (A3 1\32)
            (B3 1\16)

            (E3 1\16)
            (G3 1\16)
            (B2 1\16)
            (D3 1\16)

            (C3 1\16)
            (F2 1\32)
            (G2 1\32)
            (A2 1\32)
            (G2 1\32)
            (F2 1\16)

            (C3 1\16)
            (A2 1\16)
            (E3 1\16)
            (C3 1\16)

            (A2 1\16)
            (C3 1\32)
            (B2 1\32)
            (A2 1\32)
            (B2 1\32)
            (C3 1\16)

            (F2 1\16)
            (A2 1\16)
            (C2 1\16)
            (E2 1\16)

            (D2 1\16)
            (B2 1\32)
            (C3 1\32)
            (D3 1\32)
            (C3 1\32)
            (B2 1\16)

            (F3 1\8)
            (F2 1\8)
            (B2 1)))

(defun write-simple-note-list-to-file (file-name symbol)
  (let ((base 10.)
	(ibase 10.))
    (with-open-file (f file-name :direction :output)
      (format f "~&;;; -*- Mode:Lisp; Package:(MIDI GLOBAL); Base:10 -*-")
      (format f "~2&(defconst ~s '(" symbol)
      (dolist (x (symeval symbol))
	(format f "~&  ~s" x))
      (format f "~&))~&"))))