(in-package #:cl-collider)

;;; keys

(defsynth FMRhodes1 ((out 0) (freq 440) (gate 1) (pan 0) (amp 0.1) (att 0.001) (rel 1) (lfoSpeed 4.8) (inputLevel 0.2)
                     (modIndex 0.2) (mix 0.2) (lfoDepth 0.1)) ;; all of these range from 0 to 1
  (let* ((env1 (env-gen.kr (perc att (* rel 1.25) inputLevel :lin)))
         (env2 (env-gen.kr (perc att rel inputLevel :lin)))
         (env3 (env-gen.kr (perc att (* rel 1.25) inputLevel :lin)))
         (env4 (env-gen.kr (perc att (* rel 1.25) inputLevel :lin)))
         (osc4 (* (sin-osc.ar freq) 6.7341546494171 modIndex env4))
         (osc3 (* (sin-osc.ar (* freq 2) osc4) env3))
         (osc2 (* (sin-osc.ar (* freq 30)) 0.683729941 env2))
         (osc1 (* (sin-osc.ar (* freq 2)) env1))
         (snd-step-1 (+ (mix (* osc3 (- 1 mix))) (* osc1 mix)))
         (snd-step-2 (* snd-step-1 (range (sin-osc.ar lfoSpeed) (- 1 lfoDepth) 1)))
         (snd-step-3 (* snd-step-2 (env-gen.kr (asr 0 1 0.1) :gate gate :act :free)))
         (snd-step-4 (pan2.ar snd-step-3 pan amp)))
    (out.ar out snd-step-4)))

;;; strings

(defsynth tone-pluck ((freq 440) (amp 0.2))
  (out.ar 0 (* (saw.ar (let ((detune (* freq 0.01)))
                         (list (- freq detune) (+ freq detune))))
               (env-gen.kr (perc 0.1 1.8)
                           :level-scale amp
                           :act :free))))

(defsynth prophet5pwmStrings ((out 0) (pan 0.0) (freq 440) (amp 1.0) (gate 1) (att 0.01)
                              (rel 0) (sus 1) (dec 0.5) (lforate 10) (lfowidth 0.5) (cutoff 12000) (rq 0.5))
  (let* ((lfo (lf-tri.kr (mapcar (lambda (x) (* lforate x)) (list 1 1.01)) (make-list 2 :initial-element (rand.ir 0 2.0))))
         (pulse (pulse.ar (mapcar (lambda (x) (* freq x)) (list 1 1.01)) (+ (* lfo lfowidth) 0.5)))
         (filter (rlpf.ar pulse cutoff rq))
         (env (env-gen.ar (adsr att dec sus rel amp) :gate gate :act :free)))
    (out.ar out (pan2.ar (* (mix filter) env 0.5) pan))))

(defsynth strings ((out 0) (freq 440) (amp 1) (gate 1) (pan 0) (freqLag 0.2) (att 0.001) (dec 0.1) (sus 0.75) (rel 0.3)
                   (rq 0.001) (combHarmonic 4) (sawHarmonic 1.5) (mix 0.33))
  (let* ((combFreq (/ 1 (* (lag.kr freq (/ freqLag 2)) combHarmonic)))
         (envelope (env-gen.kr (adsr att dec sus rel amp) :gate gate :act :free))
         (snd-step-1 (sync-saw.ar (* freq (range (white-noise.kr) (/ 1 1.025) 1.025)) (* freq sawHarmonic) 8))
         (snd-step-2 (+ (* snd-step-1 (- 1 mix)) (pink-noise.ar (* 180 mix))))
         (snd-step-3 (comb-l.ar snd-step-2 combFreq combFreq -1)) ; try 1 for decay as well
         (snd-step-4 (abs (resonz.ar snd-step-3 (lag.kr freq freqLag) rq)))
         (snd-step-5 (* snd-step-4 envelope))
         (snd-step-6 (limiter.ar snd-step-5 amp)))
    (out.ar out (pan2.ar snd-step-6 pan))))

(defsynth violin ((freq 440) (gate 1) (amp 1) (pan 0) (out 0) (att 0.1) (dec 0.1) (sus 0.5) (rel 0.1)
                  (vRate 4.6) (vDepth 0.02) (vAtt 0.15) (vRateVar 0.25) (vDepthVar 0.05)
                  (pwmVarRate 2) (pwmMin 0.7) (pwmMax 0.8) (pwmRate 5)
                  (bridgeFreq 2500) (scratchDepth 0.15))
          (let* ((scratch (+ 1.025 (env-gen.kr (perc att (* 1.25 dec) scratchDepth))))
                 (envelope (env-gen.kr (adsr att dec sus rel) :gate gate :act :free))
                 (freq (vibrato.kr freq vRate vDepth (+ att dec) vAtt vRateVar vDepthVar))
                 (pwm-step-1 (range (sin-osc.kr pwmRate (rand.ir 0.0 1.0)) pwmMin pwmMax))
                 (pwm-step-2 (* pwm-step-1 (range (lf-noise2.kr pwmVarRate) 0.2 0.8)))
                 (snd-step-1 (var-saw.ar (*
                                          (lag.kr freq)
                                          (range (lf-pulse.ar (* freq 1.5)) (/ 1 scratch) scratch))))
                 (snd-step-2 (+ (* snd-step-1 0.7)
                                (bpf.ar snd-step-1 bridgeFreq 2 2)))
                 (snd-step-3 (* snd-step-2 amp envelope)))
            (out.ar out (pan2.ar snd-step-3 pan))))

;;; percussion

(defsynth kik ((freq 440) (out 0))
  (let* ((env (env-gen.kr (env (list 0 1 0) (list 0.001 1)) :act :free))
         (fenv (env-gen.kr (env (list 1 0) (list 0.25)) :level-scale freq))
         (sig (sin-osc.ar fenv 0 0.2)))
    (out.ar out (pan2.ar sig 0 env))))

(defsynth bdrum ((amp 0.5) (out 0)   )
  (out.ar out (* amp (sin-osc.ar (line.ar 120 60 1) 0 (env-gen.ar (env (list 0 1 0) (list 0.005 0.5)) :act :free)))))

(defsynth snare ((amp 0.5) (out 0))
  (out.ar out (* amp (white-noise.ar (env-gen.ar (env (list 0 1 0.3 0) (list 0.005 0.01 0.5)) :act :free)))))

(defsynth hihat ((amp 0.5) (out 0))
  (out.ar out (* amp (hpf.ar (white-noise.ar 1) 10000) (env-gen.ar (env (list 0 1 0) (list 0.005 0.5)) :act :free))))

;;; bass

(defsynth acid0to3091 ((amp 0.5) (out 0) (gate 1) (freq 440) (pan 0) (att 0.001) (dec 0.5) (sus 0.1) (rel 0.5) (curve -4) (lagTime 0.12) (filterRange 6) (width 0.51) (rq 0.3))
  (let* ((freq (lag.kr freq lagTime))
         (ampEnv (env-gen.kr (adsr att dec sus rel amp 0) :gate gate))
         (filterEnv (env-gen.kr (adsr att (* 2 dec) (/ sus 2) (* 2 rel) (expt 2 filterRange) (list (* -1 curve) curve curve) 1) :gate gate :act :free))
         (sndStep1 (range (lf-pulse.ar freq 0.0 width) -1 1))
         (sndStep2 (rlpf.ar sndStep1 (* freq filterEnv) rq))
         (sndStep3 (* sndStep2 ampEnv)))
    (out.ar out (pan2.ar sndStep3 pan))))

(defsynth fmBass ((out 0) (freq 440) (gate 1) (amp 0.5) (pan 0) (att 0.01) (dec 0.3) (sus 0.4) (rel 0.1) (slideTime 0.17) (cutoff 1100) (width 0.15) (detune 1.005) (preamp 4))
  (let* ((env  (env-gen.kr (adsr att dec sus rel) :gate gate :act :free))
         (freq (lag.kr freq slideTime))
         (sndStep1 (var-saw.ar (list freq (* freq detune)) 0 width preamp))
         (sndStep2 (distort (mix sndStep1)))
         (sndStep3 (* sndStep2 env))
         (sndStep4 (lpf.ar sndStep3 cutoff amp)))
    (out.ar out (pan2.ar sndStep4 pan))))

;;; air

;; doesn't seem to work, right?
(defsynth waveguideFlute ((scl 0.2) (freq 440) (ipress 0.9) (ibreath 0.09) (ifeedbk1 0.4) (ifeedbk2 0.4)
                          (dur 1) (gate 1) (amp 2))
  (let* ((sr (sample-rate.ir))
         (cr (control-rate.ir))
         (a-block (reciprocal cr))
         (ifqc freq)
         (kenv1 (env-gen.kr (env
                             (list 0.0 (* 1.1 ipress) ipress ipress 0.0)
                             (list 0.06 0.2 (- dur 0.46) 0.2)
                             :linear))) ; noise envelope
         (kenv2 (env-gen.kr (env
                             (list 0.0 amp amp 0.0)
                             (list 0.1 (- dur 0.2) 0.1)
                             :linear))) ; overall envelope
         (kenvibr (env-gen.kr (env
                               (list 0.0 0.0 1 1 0.0)
                               (list 0.5 0.5 (- dur 1.5) 0.5)
                               :linear)))     ; vibrato envelope
         (aflow1 (lf-clip-noise.ar sr kenv1)) ; create air flow and vibrato
         (kvibr (sin-osc.ar 5 0 (* 0.1 kenvibr)))

         (asum1 (+ (* ibreath aflow1) kenv1 kvibr))
         (afqc (+ (reciprocal ifqc) (/ ifqc 12000000) (- (/ asum1 20000)) (- (/ 9 sr)) (- a-block)))
         (fdbckArray (local-in.ar 1))
         (aflute1 fdbckArray)
         (asum2 (+ asum1 (* aflute1 ifeedbk1)))
         (ax (delay-c.ar asum2
                         (- (reciprocal ifqc) (* a-block 0.5)) ; original has strange asum1/ifqc/cr thing, is that consequtive division, or third is on top?
                         (* afqc 0.5)))
         (apoly (- ax (cubed ax)))
         (asum3 (+ apoly (* aflute1 ifeedbk2)))
         (avalue (lpf.ar asum3 2000))
         (aflute2 (delay-c.ar avalue (- (reciprocal ifqc) a-block) afqc))
         (fdbckArray (list aflute2))
         ;; (no-name (local-out.ar fdbckArray)) ; does that work at all? are there side effects?
         (signalOut avalue))
    (local-out.ar fdbckArray)
    (offset-out.ar 0 (list (* signalOut kenv2) (* signalOut kenv2)))))

;;; simplistic

(defsynth default ((gate 1) (freq 440) (out 0))
  (let* ((env (env-gen.kr (asr 0.01 1 0.1) :gate gate :act :free))
         (sig (sin-osc.ar freq 0 0.2)))
    (out.ar out (pan2.ar sig 0 env))))

(defsynth tone-buzz ((freq 440) (amp 0.2))
  (out.ar 0 (saw.ar (let ((detune (* freq 0.01)))
                      (list (- freq detune) (+ freq detune)))
                    (/ amp 2))))

(defsynth tone-pluck ((freq 440) (amp 0.2))
  (out.ar 0 (* (saw.ar (let ((detune (* freq 0.01)))
                         (list (- freq detune) (+ freq detune))))
               (env-gen.kr (perc 0.1 1.8)
                           :level-scale amp
                           :act :free))))

(defsynth sine-wave ((note 60) (freq 400))
  (let* ((freq (midicps note))
         (sig (sin-osc.ar freq 0 .2)))
     (out.ar 0 sig)))