(provide 'snd-v.scm)

(if (provided? 'snd)
    (require snd-ws.scm)
    (require sndlib-ws.scm))

(define default-index-env (float-vector 0 1  25 .4  75 .6  100 0))
(define default-amp-env (float-vector 0 0  25 1  75 1  100 0))
(define default-gliss-env (float-vector 0 0 100 0))

(definstrument (fm-violin startime dur frequency amplitude
	    (fm-index 1.0)
	    amp-env 
	    (periodic-vibrato-rate 5.0) 
	    (random-vibrato-rate 16.0)
	    (periodic-vibrato-amplitude 0.0025) 
	    (random-vibrato-amplitude 0.005)
	    (noise-amount 0.0) 
	    (noise-freq 1000.0)
	    (ind-noise-freq 10.0) 
	    (ind-noise-amount 0.0)
	    (amp-noise-freq 20.0) 
	    (amp-noise-amount 0.0)
	    (gliss-env default-gliss-env)
	    (glissando-amount 0.0) 
	    fm1-env 
	    fm2-env
	    fm3-env
	    (fm1-rat 1.0) 
	    (fm2-rat 3.0)	 
	    (fm3-rat 4.0)                    
	    fm1-index
	    fm2-index
	    fm3-index
	    degree
	    (distance 1.0)
	    (reverb-amount 0.01)
	    (base 1.0))

    "(fm-violin startime dur frequency amplitude
   (fm-index 1.0) (amp-env '(0 0  25 1  75 1  100 0)) 
   (periodic-vibrato-rate 5.0) (random-vibrato-rate 16.0) 
   (periodic-vibrato-amplitude 0.0025) (random-vibrato-amplitude 0.005) 
   (noise-amount 0.0) (noise-freq 1000.0) (ind-noise-freq 10.0) 
   (ind-noise-amount 0.0) (amp-noise-freq 20.0) 
   (amp-noise-amount 0.0) (gliss-env '(0 0  100 0)) 
   (glissando-amount 0.0) (fm1-env '(0 1  25 .4  75 .6  100 0)) 
   (fm2-env '(0 1  25 .4  75 .6  100 0)) (fm3-rat 4.0) 
   (fm3-env '(0 1  25 .4  75 .6  100 0)) (fm1-rat 1.0) 
   (fm2-rat 3.0) (fm1-index #f) (fm2-index #f) 
   (fm3-index #f) (degree #f) (distance 1.0) 
   (reverb-amount 0.01) (base 1.0)) 

  (with-sound () (fm-violin 0 1 440 .1))"

    (let ((beg (seconds->samples startime))
	  (end (seconds->samples (+ startime dur)))
	  (frq-scl (hz->radians frequency))
	  (logfreq (log frequency))
	  (sqrtfreq (sqrt frequency))
	  (maxdev (* (hz->radians frequency) fm-index)))

      (if (>= (* 2 fm1-rat frequency) *clm-srate*) (set! fm1-rat 1.0))
      (if (>= (* 2 fm2-rat frequency) *clm-srate*) (set! fm2-rat 1.0))
      (if (>= (* 2 fm3-rat frequency) *clm-srate*) (set! fm3-rat 1.0))

      (let* ((index1 (or fm1-index (min pi (* maxdev (/ 5.0 logfreq)))))
	     (index2 (or fm2-index (min pi (/ (* maxdev 3.0 (- 8.5 logfreq)) (+ 3.0 (* frequency 0.001))))))
	     (index3 (or fm3-index (min pi (* maxdev (/ 4.0 sqrtfreq)))))
	     (easy-case (and (zero? noise-amount)
			     (equal? fm1-env fm2-env)
			     (equal? fm1-env fm3-env)
			     (= fm1-rat (floor fm1-rat))
			     (= fm2-rat (floor fm2-rat))
			     (= fm3-rat (floor fm3-rat))
			     (integer? (rationalize (/ fm2-rat fm1-rat))) ; might be 2=2 but 1=3 or whatever
			     (integer? (rationalize (/ fm3-rat fm1-rat)))))
	     (norm (if easy-case 1.0 index1))
	     (fmosc1  (if easy-case 
			  (make-polywave (* fm1-rat frequency) 
					 (list (floor fm1-rat) index1
					       (floor (/ fm2-rat fm1-rat)) index2
					       (floor (/ fm3-rat fm1-rat)) index3)
					 mus-chebyshev-second-kind)
			  (make-oscil (* fm1-rat frequency))))
	     (indf1 (make-env (or fm1-env default-index-env) norm :duration dur))
	     (indf2 (or easy-case (make-env (or fm2-env default-index-env) index2 :duration dur)))
	     (indf3 (or easy-case (make-env (or fm3-env default-index-env) index3 :duration dur)))
	     (frqf (make-env gliss-env (* glissando-amount frq-scl) :duration dur))
	     (pervib (make-triangle-wave periodic-vibrato-rate (* periodic-vibrato-amplitude frq-scl)))
	     (ranvib (make-rand-interp random-vibrato-rate (* random-vibrato-amplitude frq-scl)))
	     (fm-noi (and (not (zero? noise-amount))
			  (make-rand noise-freq (* pi noise-amount))))
	     (ind-noi (and (not (zero? ind-noise-amount))
			   (not (zero? ind-noise-freq))
			   (make-rand-interp ind-noise-freq ind-noise-amount)))
	     (amp-noi (and (not (zero? amp-noise-amount))
			   (not (zero? amp-noise-freq))
			   (make-rand-interp amp-noise-freq amp-noise-amount)))
	     (carrier (make-oscil frequency))
	     (fmosc2 (if (not easy-case) (make-oscil (* fm2-rat frequency))))
	     (fmosc3 (if (not easy-case) (make-oscil (* fm3-rat frequency))))
	     (ampf (make-env (or amp-env default-amp-env) :scaler amplitude :base base :duration dur))
	     (locs (make-locsig (or degree (random 90.0)) distance reverb-amount)))
	
	(if (or (not easy-case) 
		ind-noi 
		amp-noi
		fm-noi)
	    (let ((fuzz 0.0)
		  (vib 0.0)
		  (anoi 1.0)
		  (inoi 1.0))
	      (if easy-case ; no fm-noi here
		  (do ((i beg (+ i 1)))
		      ((= i end))
		    (if amp-noi 
			(set! anoi (* (env ampf) (+ 1.0 (rand-interp amp-noi))))
			(set! anoi (env ampf)))
		    (if ind-noi 
			(set! inoi (+ 1.0 (rand-interp ind-noi))))
		    (set! vib (+ (env frqf) (triangle-wave pervib) (rand-interp ranvib)))
		    (locsig locs i (* anoi (oscil carrier (+ vib (* inoi (env indf1) (polywave fmosc1 vib)))))))
		  
		  (if (or ind-noi amp-noi fm-noi)
		      (if (not (or ind-noi amp-noi))
			  (do ((i beg (+ i 1)))
			      ((= i end))
			    (let ((fuzz (rand fm-noi))
				  (vib (+ (env frqf) (triangle-wave pervib) (rand-interp ranvib))))
			      (locsig locs i (* (env ampf) 
						(oscil carrier 
						       (+ vib
							  (+ (* (env indf1) (oscil fmosc1 (+ (* fm1-rat vib) fuzz)))
							     (* (env indf2) (oscil fmosc2 (+ (* fm2-rat vib) fuzz)))
							     (* (env indf3) (oscil fmosc3 (+ (* fm3-rat vib) fuzz))))))))))
			  
			  (do ((i beg (+ i 1)))
			      ((= i end))
			    (if fm-noi (set! fuzz (rand fm-noi)))
			    (if amp-noi 
				(set! anoi (* (env ampf) (+ 1.0 (rand-interp amp-noi))))
				(set! anoi (env ampf)))
			    (if ind-noi (set! inoi (+ 1.0 (rand-interp ind-noi))))
			    (set! vib (+ (env frqf) (triangle-wave pervib) (rand-interp ranvib)))
			    (locsig locs i (* anoi (oscil carrier 
							  (+ vib
							     (* inoi
								(+ (* (env indf1) (oscil fmosc1 (+ (* fm1-rat vib) fuzz)))
								   (* (env indf2) (oscil fmosc2 (+ (* fm2-rat vib) fuzz)))
								   (* (env indf3) (oscil fmosc3 (+ (* fm3-rat vib) fuzz)))))))))))
		      
		      (do ((i beg (+ i 1)))
			  ((= i end))
			(let ((vib (+ (env frqf) (triangle-wave pervib) (rand-interp ranvib))))
			  (locsig locs i (* (env ampf)
					    (oscil carrier (+ vib
							      (+ (* (env indf1) (oscil fmosc1 (* fm1-rat vib)))
								 (* (env indf2) (oscil fmosc2 (* fm2-rat vib)))
								 (* (env indf3) (oscil fmosc3 (* fm3-rat vib)))))))))))))
	    (if (= (mus-scaler frqf) 0.0)
		(do ((i beg (+ i 1)))
		    ((= i end))
		  (let ((vib (+ (triangle-wave pervib) (rand-interp ranvib))))
		    (locsig locs i (* (env ampf) 
				      (oscil carrier (+ vib (* (env indf1) 
							       (polywave fmosc1 vib))))))))
		(do ((i beg (+ i 1)))
		    ((= i end))
		  (let ((vib (+ (env frqf) (triangle-wave pervib) (rand-interp ranvib))))
		    (locsig locs i (* (env ampf) 
				      (oscil carrier (+ vib (* (env indf1) 
							       (polywave fmosc1 vib)))))))))))))


;; (with-sound (:statistics #t) (fm-violin 0 10 440 .1 :fm-index 2.0))
;; (with-sound (:statistics #t) (fm-violin 0 10 440 .1 :noise-amount .01))
;; (with-sound (:statistics #t) (fm-violin 0 10 440 .1 :ind-noise-amount .01))
;; (with-sound (:statistics #t) (fm-violin 0 10 440 .1 :fm1-rat 1.002))

