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

-- Synths.hs
-- created: Sun Sep  2 00:39:11 JST 2012

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

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.MusicalEnvironment
import Sound.Conductive.Pitch
import Sound.Conductive.Scale
import Sound.OpenSoundControl
import Sound.SC3
import Sound.SC3.ID hiding (brownNoise)
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)]))
------------------------------------------------------------------------------
-- trying a method for defining synths

defineSynth :: UGen -> String -> IO OSC
defineSynth func synthName = withSC3 i where
    o = out 0 func
    i fd = do async fd (d_recv (synthdef synthName o))

playSynth :: [(String, Double)] -> String -> IO ()
playSynth ps synthName = withSC3 (\fd -> send fd (s_new synthName (-1) AddToTail 1 ps))

pingDef2 :: IO OSC
pingDef2 = defineSynth (sinOsc AR (mce [(midiCPS f),(midiCPS $ f*1.005)]) 0 * e) "ping2" where
    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

ping2 :: Double -> Double -> IO ()
ping2 freq dur = playSynth ps "ping2" where
    ps = [("f",freq)
         ,("d",dur)
         ]

pmTestDef :: IO OSC
pmTestDef = defineSynth (pmOsc AR f (mf * 10000) (pm * 10000) 0 * a * e) "pmTest" where
    att = control IR "att" 0.05
    cf = control IR "f" 60
    a = control IR "a" 0.5
    d = control IR "d" 1
    mf = control IR "mf" 0 
    pm'= control IR "pm" 0
    pm = line KR 0 pm' 9 DoNothing 
    p = envPerc att d
    e = envGen KR 1 (1*a) 0 1 RemoveSynth p
    f = mce [(midiCPS cf),(midiCPS cf)*1.005]

pmTest :: Double -> Double -> Double -> Double -> Double -> Double -> IO ()
pmTest attack freq amp modFreq modAmp dur = playSynth ps "pmTest" where
    ps = [("att",attack)
          ,("f",freq)
          ,("a",amp)
          ,("mf",modFreq)
          ,("pm",modAmp)
          ,("d",dur)
          ]

rudeBassDef :: IO OSC
rudeBassDef = defineSynth sumSynths "rudeBass" where
    att = control IR "att" 0.05
    cf = midiCPS $ control IR "f" 60
    a = control IR "a" 0.5
    d = control IR "d" 1
    mf = control IR "mfscalar" 0 
    m = line KR cf (cf * mf) d DoNothing
    p = envPerc att d
    e = envGen KR 1 (1 * a) 0 1 RemoveSynth p
    flavorBass = syncSaw AR (mce [cf,cf*1.01] ) m * 0.1 * e
    sinSubBass = (sinOsc AR (mce [(cf * 0.5),(cf * 1.005 * 0.5)]) 0 * e)
    ff = mouseX KR 2 (cf*50) Exponential 0.1
    sumSynths = lpf (flavorBass + sinSubBass) ff

rudeBass :: Double -> Double -> Double -> Double -> Double -> IO ()
rudeBass attack freq amp modS dur = playSynth ps "rudeBass" where
    ps = [("att",attack)
          ,("f",freq)
          ,("a",amp)
          ,("mfscalar",modS)
          ,("d",dur)
          ]