;;; bird songs -- (load "bird.scm") then (make-birds)
;;;   writes "test.snd" unless you give it a file name as in (make-birds "hiho.snd")

;;; translated (semi-automatically) from a Sambox note list to bird.clm, then bird.scm

(use-modules (ice-9 optargs) (ice-9 format))
(if (not (defined? '*output*)) (load-from-path "ws.scm"))

(definstrument (bigbird start dur frequency freqskew amplitude freq-envelope amp-envelope partials)
  "(bigbird start dur frequency freqskew amplitude freq-envelope amp-envelope partials)"

  (define (sum-partials lst sum)
    (if (null? lst)
	sum
	(sum-partials (cddr lst) (+ sum (cadr lst)))))
    
  (define (scale-partials lst scl newlst)
    (if (null? lst)
	newlst
	(scale-partials (cddr lst) scl (append newlst (list (car lst) (* scl (cadr lst)))))))
    
  (define (normalize-partials lst)
    (scale-partials lst (/ 1.0 (sum-partials lst 0.0)) '()))
    
  (let* ((gls-env (make-env freq-envelope (hz->radians freqskew) dur))
	 (os (make-oscil :frequency frequency))
	 (coeffs (partials->polynomial (normalize-partials partials)))
	 (amp-env (make-env amp-envelope amplitude dur))
	 (beg (inexact->exact (round (* (mus-srate) start))))
	 (len (inexact->exact (round (* (mus-srate) dur))))
	 (end (+ beg len)))
    (if (c-g?) (throw 'with-sound-interrupt))
    (run
     (lambda ()
       (do ((i beg (1+ i)))
	   ((= i end))
	 (outa i (* (env amp-env)
		    (polynomial coeffs
				(oscil os (env gls-env))))
	       *output*))))))

(definstrument (bird start dur frequency freqskew amplitude freq-envelope amp-envelope)
  "(bird start dur frequency freqskew amplitude freq-envelope amp-envelope)"
  (let* ((gls-env (make-env freq-envelope (hz->radians freqskew) dur))
	 (os (make-oscil :frequency frequency))
	 (amp-env (make-env amp-envelope amplitude dur))
	 (len (inexact->exact (round (* (mus-srate) dur))))
	 (beg (inexact->exact (round (* (mus-srate) start))))
	 (end (+ beg len)))
    (if (c-g?) (throw 'with-sound-interrupt))
    (run
     (lambda ()
       (do ((i beg (1+ i)))
	   ((= i end))
	 (outa i (* (env amp-env)
		    (oscil os (env gls-env)))
	       *output*))))))
(define bird-amp '(.00 .00 .25 1.00 .75 1.00 1.00 .0))
  
(define (simple_sinusoid beg)
  (let ((freq_envelope '(.00 .00 1.0 1.0))
	(amp_envelope '(.00 .00 .25 1.00 .75 1.00 1.00 .0)))
    (set! beg (- beg .6))
    (bird (+ beg .6) 2 400 500 .5 freq_envelope amp_envelope)))

;;definstrument (bigbird start dur frequency freqskew amplitude freq-envelope amp-envelope partials)
(define (simple_sound beg)
  (let ((freq_envelope '(.00 .00 1.0 1.0))
	(amp_envelope '(.00 .00 .25 1.00 .75 1.00 1.00 .0)))
    (set! beg (- beg .6))
    (bigbird (+ beg .6) 2 400 500 .5 freq_envelope amp_envelope '(1 1 2 .02 3 .05))))



(define (make-birds)
  "(make-birds) calls all the birds in bird.scm"
  (with-sound (:srate 48000.0)
    (simple_sound 0)))