
(define *middle-A* 440)
(define *halfstep* (expt 2 (/ 1 12)))
(define *wholestep* (* *halfstep* *halfstep*))
(define (sharp freq) (* freq *halfstep*))
(define *middle-B* (sharp *middle-A*))
(define *middle-H* (sharp *middle-B*))
(define *high-C* (sharp *middle-H*))
(define *middle-C* (/ *high-C* 2))
(define *middle-D* (sharp (sharp *middle-C*)))
(define *middle-E* (sharp (sharp *middle-D*)))
(define *middle-F* (sharp *middle-E*))
(define *middle-G* (sharp (sharp *middle-F*)))

(define *tones*
  `((#\C ,*middle-C*)
    (#\D ,*middle-D*)
    (#\E ,*middle-E*)
    (#\F ,*middle-F*)
    (#\G ,*middle-G*)
    (#\A ,*middle-A*)
    (#\B ,*middle-B*)
    (#\H ,*middle-H*)))

(define (note->freq note)
  (and
    (symbol? note)
    (let* ((n (symbol->string note))
	   (len (string-length n)))
      (and
	(<= 2 len)
	(let ((tone (assv (char-upcase (string-ref n 0)) *tones*))
	      (octave (string->number (string (string-ref n (- len 1))))))
	  (and
	    tone octave
	    (let loop ((index 1)
		       (basefreq (* (cadr tone) (expt 2 (- octave 4)))))
	      (if (>= index (- len 1)) basefreq
		(case (string-ref n index)
		  ((#\-) (loop (+ index 1) basefreq))
		  ((#\#) (loop (+ index 1) (* basefreq *halfstep*)))
		  ((#\x) (loop (+ index 1) (* basefreq *wholestep*)))
		  ((#\b) (loop (+ index 1) (/ basefreq *halfstep*)))
		  (else #f))))))))))

(define (score-reader freq score)
  (let ((interval (freq->inexact-samples freq))
	(samples-left 0)
	(current-value 0))
    (lambda ()
      (if (<= samples-left 0)
	(let ((next-note (car score)))
	  (set! samples-left (+ samples-left interval))
	  (cond ((string=? next-note "...") #t)
		((string=? next-note "^^^")
		 (set! current-value 0))
		(else (set! current-value
			(note->freq (string->symbol next-note)))))
	  (set! score (cdr score))))
      (set! samples-left (- samples-left 1))
      current-value)))

(define (read-lines port)
  (let ((cur (read-line port)))
    (if (eof-object? cur) '()
      (cons cur (read-lines port)))))
