(load "blit.lisp")

(defun envelope-or-number (in)
  (if (numberp in)
    (list 0 in 1 in)
    in
  ))

(defmacro bounded (in val eps) ;;  abs(in - value) <= eps
  `(<= (abs (- ,in ,val)) ,eps)
  )

	  
(definstrument good-sync (start-time duration frequency &optional (amp 1.0)
				    &key (amp-env '(0 1.0 1.0 1.0))
				    (freq-env '(0 1 1.0 1)) ;frequency envelope as a factor of original frequency
				    (leak (- 1 (/ 35 *srate*))) ; -0.5 dB at 20 Hz   0.99841
				    (limit .9) ;attenuation at Nyquist, affects sharpness of waveform, eliminates Gibb's phenomena (!! Must be less than 1.0)
				    (glide 1)  ;exponent of portamento (quartic functions approximate logarithmic behavior)
				    (phase 0) ;between 0 and 1
				    (master 45)
;				    (eps 0.001)
				    (hardness 1.0)  ;1 = hardsync, smaller values give soft sync
				    )

  
  (multiple-value-bind (beg end) (times->samples start-time duration)
    (let* (
	   (blit1 (make-blit-init :frequency frequency :phase phase :nyquist limit))
	   (blit2 (make-blit-init :frequency frequency :phase (+ phase 0.5) :nyquist limit))
	   
	   (integrator1 (make-one-pole :a0 1
				      :b1 (- leak)))

	   (integrator2 (make-one-pole :a0 1
				      :b1 (- leak)))
	   
	   (amp (make-env :envelope amp-env
			  :scaler amp
			  :duration duration))
	   (slavefreq (make-env :envelope (envelope-exp freq-env glide)
			   :scaler frequency
			   :duration duration))
	   (masterfreq (make-env :envelope (envelope-exp (envelope-or-number master) glide)
				:duration duration))
	   (masterphase1 0)
	   (masterphase2 0.5)
	   phaseinc
	   window1
	   window2
	   masterf
	   slavef
	   out1
	   out2
	   )
      (run
       (loop for i from beg below end do	 
	 ;cos^2 windows
	 (setf window1 (cos (* pi (- masterphase1 0.5)))
	       window1 (* window1 window1)
	       window2 (cos (* pi (- masterphase2 0.5)))
	       window2 (* window2 window2)
	       slavef (env slavefreq)
	       masterf (env masterfreq)
	       phaseinc (/ masterf *srate*)
;	       df (/ slavef masterf)
;	       eps (/ slavef *srate*)
	       )
	 ;update master 1, reset slave 1 if wrapped
	 (incf masterphase1 phaseinc)
	 (if (and (>= masterphase1 1.0) (bounded 0 (blit-phase blit1) hardness))
	     (progn
	       (decf masterphase1 1.0)
	       (loop until (blit-wrapped blit1) do
		 (one-pole integrator1 (blit blit1)) ;reset slave phase (kind of a hack...)
		 )
	       (setf out1 (clm::mus-y1 integrator1))
	       )
	   )
	 (setf out1 (one-pole integrator1 (blit blit1)))
	 
	 ;update master 2, reset slave 2 if wrapped
	 (incf masterphase2 phaseinc)
	 (if (and (>= masterphase2 1.0) (bounded 0 (blit-phase blit2) hardness))
	     (progn
	       (decf masterphase2 1.0)
	       (loop until (blit-wrapped blit2) do
		 (one-pole integrator2 (blit blit2))
		 )
	       (setf out2 (clm::mus-y1 integrator2))
	       )
	   )
	 (setf out2 (one-pole integrator2 (blit blit2)))	  

	 (if (blit-wrapped blit1)
	     (set-blit-frequency blit1 slavef)
	   )
	 
	 (if (blit-wrapped blit2)
	     (set-blit-frequency blit2 slavef)
	   )
	 
 	 (outa i (* (env amp) 1.6 ;;correction factor
		    (+ ;output windowed oscillators
		     (* window1 out1)
		     (* window2 out2)		     
		     ))
	       ))))
    )
  )

;(with-sound () (good-sync 0 10 120 0.3 :freq-env '(0 1 1 16)))
; (with-sound () (good-sync 0 5 100 0.3 :freq-env '(0 1 1 4) :glide 1 :master 25))
; (with-sound () (good-sync 0 10 120 1.0 :freq-env '(0 1 1 16) :master 25 :glide 1))