-- | A gallery of instruments (found in Csound catalog).
module Color where

import Csound.Base

bass (amp, cps) = sig amp * once env * osc (sig cps)
    where env = eexps [1, 0.00001]

pluckSynth (amp, cps1, cps2) = 0.5 * sig amp * once env * pluck 1 (sig cps1) cps2 def 3
    where env = eexps [1, 0.004]

marimbaSynth :: (D, D) -> Sig
marimbaSynth (amp, cps) = a6
    where
        bias = 0.11
        i2  = log cps / 10 - bias
        k1 = (0.1 * ) $ once $ lins [0.00001, 30, 1, 50, 0.5, 100, 0.00001]
--        k1  = expseg [0.0001, 0.03, amp * 0.7, idur - 0.03, 0.001]
--            * linseg [1, 0.03, 1, idur - 0.03, 3]
        k10 = linseg [2.25, 0.03, 3, idur - 0.03, 2] 
        a1  = gbuzz k1 (sig cps) k10 0 35 (sines3 [(1, 1, 90)])
        a2  = reson' a1 500 50 
        a3  = reson' a2 150 100 
        a4  = reson' a3 3500 150 
        a5  = reson' a4 3500 150 
        a6  = balance a5 a1
        reson' a b c = reson a b c `withD` 1

phasing (amp, cps) = aout
    where
        rise = 1
        dec = 0.5

        env = linen (sig amp) rise idur dec
        osc' tab k ph = oscBy tab (sig $ cps * k) `withD` ph
        osc1 = osc' sine
        osc2 = osc' $ sines [1, 0, 0.9, 0, 0.8, 0, 0.7, 0, 0.6, 0, 0.5, 0, 0.4, 0, 0.3, 0, 0.2, 0, 0.1] 
        asum = env * mean 
                [ osc1 1 0
                , osc2 1.008 0.02
                , osc1 0.992 0.04
                , osc2 2     0.06
                , osc2 1     0.08
                , osc1 1     0.01 ]
        kosc1 = 0.5 * once sine 
        kosc2 = 0.5 * once sine `withD` 0.4
        kosc3 = 1.0 * once sine `withD` 0.8

        afilt  = sum 
                [ butbp asum kosc1 1000
                , butbp asum kosc2 300
                , butbp asum kosc3 20 ]

        aout  = mean [afilt, asum]

blurp amp = do
    cps <- acps
    return $ 0.1 * sig amp * osc cps 
    where
        dec = linseg [11, idur * 0.75, 11, idur * 0.25, 0]
        kgate = kr $ oscil 1 dec (elins [1, 0, 0])
        anoise = noise 11000 0.99
        acps = fmap (flip samphold kgate) anoise
 

wind (amp, bandRise, bandDec, freqRise, freqDec, pan, winds) = 
    fmap fromRnd $ rand (sig $ amp / 400)
    where
        valu1 = 100
        valu2 = 50
        winde = 1 - winds
        ramp a b = linseg [a, idur, b]
        fromRnd a = (sig pan * aout, (1 - sig pan) * aout )
            where
                a2 = butbp a  (ramp freqRise freqDec) (ramp bandRise bandDec) 
                a3 = butbp a2 (ramp (freqRise - valu1) (freqDec + valu2))
                              (ramp (bandRise + valu1) (bandDec - valu2))
                
                aout = (a2 + a3) * linseg [0, idur * winds, 1, idur * winde, 0]

noiz (amp, cps) = fmap a2 k2
    where 
        k1 = linseg [1, 0.05, 100, 0.2, 100, 2, 1, idur, 1]
        k2 = fmap ( `withD` 1) $ rand 500   

        buzz' kamp kcps = buzz kamp (sig $ kcps * cps)  k1 sine
        
        a1 = mean $ zipWith buzz' [0.3, 1, 1] [1, 0.5, 0.501]
        a2 k = 0.5 * a1 * sig amp * osc k

noiseGliss (amp, cps) = fmap ares anoise
    where
        ramp = linseg [0, idur * 0.8, amp, idur * 0.2, 0]
        env1 = linen (sig amp) 0 idur 10
        anoise = randi ramp env1

        ares a =  reson (a * osc (sig cps)) 100 100 `withD` 2


ivory (amp, cps, vibRate, glisDur, cpsCoeff) = sig amp * mean 
    --    vibrato env                amplitude env               freq bias   phase   vibrato coeff   wave
    [ alg (linseg [0, idur, 5])      (lincone 0 0.7 1 0.3 0)     0           0       1               sine
    , alg (lincone 0 0.6 6 0.4 0)    (lincone 0 0.9 1 0.1 0)     0.009       0.2     0.9             (sines [10, 9 .. 1])
    , alg (lincone 9 0.7 1 0.3 1)    (linenIdur 0.5 0.333)       0.007       0.3     1.2             (sines [10, 0, 9, 0, 8, 0, 7, 0, 6, 0, 5])
    , alg (expcone 1 0.4 3 0.6 0.02) 
          (expcone 0.0001 0.8 1 0.2 0.0001)                      0.005       0.5     0.97            (sines [10, 10, 9, 0, 0, 0, 3, 2, 0, 0, 1])  
    , alg (expcone 1 0.4 3 0.6 0.02) 
          (expdur [0.001, 0.5, 1, 0.1, 0.6, 0.2, 0.97, 0.2, 0.001])
                                                                 0.003       0.8     0.99            (sines [10, 0, 0, 0, 5, 0, 0, 0, 0, 0, 3])
    , alg (expcone 4 0.91 1 0.09 1)  
          (expdur [0.001, 0.6, 1, 0.2, 0.8, 0.1, 0.98, 0.1, 0.001])
                                                                 0.001       1.3     1.4             (sines [10, 0, 0, 0, 0, 3, 1])
    ]
    where
        alg :: Sig -> Sig -> D -> D -> D -> Tab -> Sig    
        alg vibrEnv ampEnv cpsBias phsBias vibrCoeff wave = 
            ampEnv * (oscBy wave ((sig (cps + cpsBias) + vibr) * glis) `withD` phsBias)
            where glis = expseg [1, glisDur, 1, idur - glisDur, cpsCoeff]
                  vibr = vibrEnv * osc (sig $ vibRate * vibrCoeff)
                
        cone a x1 b x2 c = [a, x1 * idur, b, x2 * idur, c]
        lincone a x1 b x2 c = linseg $ cone a x1 b x2 c
        expcone a x1 b x2 c = expseg $ cone a x1 b x2 c
        linenIdur a b = linen 1 (a * idur) idur (b * idur)


-- snow flakes
blue (amp, cps, lfoCps, harmNum, sweepRate) = fmap aout k1
    where 
        k1 = randi 1 50
        k2 = lindur [0, 0.5, 1, 0.5, 0]
        k3 = lindur [0.005, 0.71, 0.015, 0.29, 0.01]
        k4 = k2 * (kr $ osc (sig lfoCps) `withD` 0.2)
        k5 = k4 + 2

        ksweep = lindur [harmNum, sweepRate, 1, 1 - sweepRate, 1]
        kenv = expdur [0.001, 0.01, amp, 0.99, 0.001]
        aout k = gbuzz kenv (sig cps + k3) k5 ksweep k (sines3 [(1, 1, 90)])

i2 t0 dt amp cps lfoCps harmNum sweepRate = 
    t0 +| (dt *| temp (amp, cps, lfoCps, harmNum, sweepRate))

blueSco = sco blue $ har 
    [ i2 0 4 0.5 440 23 10 0.72
    , i2 0 4 0.5 330 20 6  0.66
    ]

-- 4pok
black (amp, cps, filterSweepStart, filterSweepEnd, bandWidth) = 
    fmap aout $ rand 1
    where 
        k1 = expdur [filterSweepStart, 1, filterSweepEnd]
        a1 noise = reson noise k1 (k1 / sig bandWidth) `withD` 1
        k3 = expdur [0.001, 0.001, amp, 0.999, 0.001]
        a2 = k3 * osc (sig cps + 0.6 * (osc 11.3 `withD` 0.1))
        aout noise = 0.5 * (a1 noise + a2)

i4 t0 dt amp cps filt0 filt1 bw =
    t0 +| (dt *| temp (amp, cps, filt0, filt1, bw))

blackSco = str 1.5 $ sco black $ har 
    [ i4 0 1 0.7 220 6000 30 10
    , i4 0 1 0.7 330 8000 20 6
    ]