------------------------------------------------------------------------------

-- Synths.hs
-- created: Sat Oct  2 00:49:51 JST 2010

------------------------------------------------------------------------------

module Sound.Conductive.Synths where

import Control.Concurrent
import Control.Monad
import Data.List
import Data.Map
import Data.Maybe
import Sound.Conductive.ConductiveBaseData
import Sound.Conductive.Generator
import Sound.Conductive.MusicalEnvironment
import Sound.Conductive.Pitch
import Sound.Conductive.Scale
import Sound.OpenSoundControl
import Sound.SC3
import Sound.SC3.Monadic
import System.Random hiding (next)

pingDef :: IO OSC
pingDef = 
    let f = control IR "f" 440
        d = control IR "d" 1
        p = envPerc 0.01 d
        e = envGen KR 1 0.1 0 1 RemoveSynth p
        o = out 0 (sinOsc AR (mce [f,f*1.005]) 0 * e)
        i fd = do async fd (d_recv (synthdef "ping2" o))
    in withSC3 i

ping :: Double -> Double -> IO ()
ping freq dur = 
    let ps = [("f",freq)
             ,("d",dur)
             ]
    in withSC3 (\fd -> send fd (s_new "ping2" (-1) AddToTail 1 ps))

drone1Def :: IO OSC
drone1Def = 
    let fi = control IR "f" 440
        d = control IR "d" 1
        p = envPerc 0.03 d
        e = envGen KR 1 0.1 0 1 RemoveSynth p
        fb = fi
        f = mce [fb*0.5,fb,fb*1.005,fb*1.010,fb*2,fb*2.5,fb*4]
        ff = xLine KR 400 4000 d RemoveSynth
        o = out 0 (formant AR f ff 200 * e)
        i fd = do async fd (d_recv (synthdef "drone1" o))
    in withSC3 i

drone1 :: Double -> Double -> IO ()
drone1 freq dur =
    let ps = [("f",freq)
             ,("d",dur)
             ]
    in withSC3 (\fd -> send fd (s_new "drone1" (-1) AddToTail 1 ps))

drone2Def :: IO OSC
drone2Def = 
    let cf = control IR "f" 440
        d = control IR "d" 1
        mf = control IR "mf" 100 -- between 0 and 800
        pm'= control IR "pm" 2 -- between 0 12
        pm = line KR 0 pm' 9 DoNothing 
        p = envPerc 0.03 d
        e = envGen KR 1 0.1 0 1 RemoveSynth p
        f = mce [cf,cf*1.005]
        o = out 0 (pmOsc AR f mf pm 0 * e)
        i fd = do async fd (d_recv (synthdef "drone2" o))
    in withSC3 i

drone2 :: Double -> Double -> Double -> Double -> IO ()
drone2 freq modFreq modAmp dur =
    let ps = [("f",freq)
             ,("mf",modFreq)
             ,("pm",modAmp)
             ,("d",dur)
             ]
    in withSC3 (\fd -> send fd (s_new "drone2" (-1) AddToTail 1 ps))

tamburaDef :: IO OSC
tamburaDef = 
    let cf = control IR "f" 440
        d = control IR "d" 1
        t = (impulse KR 0.001 0)
        --x = mouseX KR (-0.999) 0.999 Linear 0.1
        x = control IR "t" 0.2
        y = 1
        dl = mce[1/f,1/(f*1.02)]
        p = envPerc 0.01 d
        e = envGen KR 1 0.1 0 1 RemoveSynth p
        f = mce [cf,cf*1.005]
        i fd = do n <- brownNoise AR
                  let o = out 0 (pluck (n * 0.5) t (dl) (dl * y) 5 x * e)
                  async fd (d_recv (synthdef "tambura" o))
    in withSC3 i

tambura :: Double -> Double -> Double -> IO ()
tambura freq timbre dur = 
    let ps = [("f",freq)
             ,("d",dur)
             ,("t",timbre)
             ]
    in withSC3 (\fd -> send fd (s_new "tambura" (-1) AddToTail 1 ps))

compositeDroneDef :: IO ()
compositeDroneDef = sequence_ [drone1Def,drone2Def,tamburaDef]

compositeDrone :: Integer -> Double -> Double -> Double -> IO ()
compositeDrone s m1 m2 d = 
    let a f d = drone1 f d
        b f m1 m2 d = drone2 f m1 m2 d
        tamb f t d = tambura f t d
        f = fromJust $ semitoneToFreq s
    in sequence_ [a f d,b f m1 m2 d,tamb f (0.3 + (m2/10)) d]

solo1Def :: IO OSC
solo1Def = 
    let cf = control IR "f" 440
        attack = control IR "attack" 0.01
        d = control IR "d" 1
        mf = control IR "mf" 100 -- between 0 and 800
        pm'= control IR "pm" 2 -- between 0 12
        pm = line KR 0 pm' 9 DoNothing 
        p = envPerc attack d
        e = envGen KR 1 0.1 0 1 RemoveSynth p
        f = mce [cf,cf*1.005]
        o1 = (pmOsc AR f mf pm 0 * e)
        o2 = (pmOsc AR f (mf/2) pm 0 * e)
        o3 = (pmOsc AR f (mf*2) pm 0 * e)
        o = out 0 (o1+o2+o3)
        i fd = do async fd (d_recv (synthdef "solo1" o))
    in withSC3 i

solo1 :: Integer -> Double -> Double -> Double -> Double -> IO ()
solo1 freq modFreq modAmp attack dur =
    let f = fromJust $ semitoneToFreq freq
        ps = [("f",f)
             ,("mf",modFreq)
             ,("pm",modAmp)
             ,("attack",attack)
             ,("d",dur)
             ]
    in withSC3 (\fd -> send fd (s_new "solo1" (-1) AddToTail 1 ps))

playSolo1 :: MVar MusicalEnvironment -> t -> IO ()
playSolo1 e p = do 
    let pg param = getDoubleGenerator e param
    fG   <- pg "soloFreq"
    fmG  <- pg "soloFMod"
    amG  <- pg "soloAMod"
    attG <- pg "soloAttack"
    durG <- pg "soloDur"
    f   <- next fG
    fm  <- next fmG
    am  <- next amG
    att <- next attG
    dur <- next durG
    solo1 (floor f) fm am att dur

subKickDef :: Int -> IO ()
subKickDef n = let
    b1 = control IR "b1" 0
    b2 = control IR "b2" 1
    f1 = control KR "f1" 450
    f2 = control KR "f2" 900
    d1 = control KR "d1" 1
    amp = control KR "amp" 0.5
    a1 = tr_control "a1" 0
    a2 = tr_control "a2" 0
    m = impulse KR 1 0 * 0.1
    d x = decay2 (x) 0.01 d1 
    o1 = sinOsc AR (mce [f1,f1+0.01]) 0 * d a1 * amp
    o2 = saw AR (mce [f2,f2+0.001]) * d a2
    g = mrg2 (out b1 o1) (out b2 o2)
    i fd = do async fd (d_recv (synthdef "g" g))
              send fd (s_new "g" n AddToTail 1 [])
    in withSC3 i

subKick :: Int -> Double -> Double -> IO ()
subKick n freq dur = withSC3 (\fd -> send fd (n_set n [("a1",1)
                                                       ,("f1",freq)
                                                       ,("d1",dur)
                                                       ,("amp",0.5)]))