module Sound.SC3.Example.Effect where

import Sound.SC3.UGen.UGen
import Sound.SC3.UGen.Rate
import Sound.SC3.UGen.Math
import Sound.SC3.UGen.Envelope (envGen, xLine, pauseSelf, )
import Sound.SC3.UGen.Filter
import Sound.SC3.UGen.IO
import Sound.SC3.UGen.Noise.Base
import Sound.SC3.UGen.Panner
import Sound.SC3.UGen.Oscillator
import Sound.SC3.UGen.Enum (Warp(Linear), DoneAction(RemoveSynth), EnvCurve(EnvNum), )
import Sound.SC3.Server.Command
import Sound.SC3.Server.PlayEasy as Play
import Sound.SC3.Server.NRT (writeNRT, )
import qualified Sound.SC3.UGen.Envelope.Construct as EnvCons

import Sound.OpenSoundControl.OSC (OSC(Bundle), )
import Sound.OpenSoundControl.Transport.Monad (send, )
import qualified Sound.OpenSoundControl.Time as Time
import qualified Sound.OpenSoundControl.Transport.Monad as Trans
import qualified Sound.OpenSoundControl.Transport.Monad.IO as MIO

import System.Random(randomRs, mkStdGen, )
import Control.Concurrent(threadDelay, )
import Control.Monad.Trans (lift, )

import System.Cmd (rawSystem)


{- * example sounds -}

analogBubbles :: UGen
analogBubbles = combN s 0.2 0.2 4
  where s = sinOsc AR (midiCPS f) 0 * 0.1
        f = lfSaw KR 0.4 1 * 24 + o
        o = lfSaw KR (MCE [8, 7.23]) 0 * 3 + 80


pgmouse :: UGen -> UGen
pgmouse f = pan2 i l 1
    where i = sinOsc AR f 0 * envGen KR 1 1 0 1 RemoveSynth envPerc' * 0.1
          l = mouseX KR (-1) 1 Linear 0.1

pg :: UGen -> UGen
pg f = sinOsc AR f 0 * envGen KR 1 1 0 1 RemoveSynth envPerc' * 0.25


pt :: UGen
pt = pan2 i l 0.1
    where i = sinOsc AR 440 0
          l = mouseX KR (-1) 1 Linear 0.1

sawPerc :: UGen -> UGen -> UGen
sawPerc v f = out 0 (w * 0.5)
  where e = envGen KR 1 2 0 1 RemoveSynth envPerc'
        s = v * e * saw AR f
        w = rlpf s (exp e * (f * 1.2)) 0.05

wind :: UGen -> UGen
wind f =
   let lfo = f
          + sinOsc KR (sqrt 0.2) (-pi/2) * 100
          + sinOsc KR 0.2 (-pi/3) * 200
       noise = whiteNoise (UGenId 0) AR * 0.1
   in  rlpf noise lfo 0.005

windMouse :: UGen -> UGen
windMouse f =
   let lfo = mouseY KR (f*0.5) (f*1.5) Linear 0.1
       noise = whiteNoise (UGenId 0) AR * 0.1
   in  rlpf noise lfo 0.005

ps :: UGen
ps = MRG a b
    where a = pauseSelf (mouseX KR (-1) 1 Linear 0.1)
          b = out 0 (sinOsc AR 440 0 * 0.1)

envPerc' :: [UGen]
envPerc' = EnvCons.envPerc' 0.01 1.0 1.0 (dbl (EnvNum (-4.0)))

dbl :: a -> [a]
dbl x = [x,x]

{- * complex configurations -}

{-
ts = Score [OscB 0.0 [d_recv_synthdef "test" analogBubbles],
            OscB 1.0 [s_new "test" autoId AddToTail homeId []],
            OscB 3.0 [g_freeAll homeId]]
-}

bassFilter :: UGen
bassFilter = w
  where control = Control KR "cutoff" 1000
        tone  = saw AR (MCE [55, 55.1]) * 0.1
        w     = rlpf tone control 0.05

bassFilterRun :: IO ()
bassFilterRun =
  withSC3 $
   do play bassFilter
      mapM (\p -> set "cutoff" p >> lift (threadDelay 150000))
           (randomRs (400,2000) (mkStdGen 34))
      stop


bassFilterGlissando :: UGen
bassFilterGlissando =
   let control = 600 * exp (lag (lfNoise0 (UGenId 0) KR 6) 0.1)
       tone    = saw AR (MCE [55, 55.1]) * 0.1
       w       = rlpf tone control 0.05
   in  w


loadTone :: Trans.C m =>
            String
            -> (UGen -> UGen -> UGen)
            -> m OSC
loadTone name tone =
   Play.sync (Play.d_recv_synthdef name
       (tone (Control KR "velocity" 0)
             (Control KR "pitch" 0)))

loadEffect :: Trans.C m =>
              String
              -> UGen
              -> m OSC
loadEffect name effect =
   Play.sync (Play.d_recv_synthdef name effect)

playTone :: Trans.C m =>
            String
            -> Double
            -> Double
            -> m ()
playTone name v f =
   send (s_new name autoId AddToHead homeId
             [("pitch", f),
              ("velocity", v)])

-- makes the same, but more complicated
playToneSep :: (Trans.C m) =>
   String
   -> Double
   -> Double
   -> m ()
playToneSep name v f =
   mapM_ send
         [s_new name autoId AddToHead homeId [],
          n_set lastId $ ("pitch", f) :
                       ("velocity", v) : []]

playToneInGroup :: Trans.C m =>
                   Int
                   -> String
                   -> Double
                   -> Double
                   -> m ()
playToneInGroup gid name v f =
   send (s_new name autoId AddToHead gid
             [("pitch", f),
              ("velocity", v)])

newGroup :: Trans.C m =>
            Int -> Int -> m ()
newGroup superGid gid =
   send (g_new [(gid, AddToTail, superGid)])

playEffect :: Trans.C m =>
              Int -> String -> m ()
playEffect gid name =
   send (s_new name autoId AddToTail gid [])


playScale :: IO ()
playScale =
   withSC3 $
   do loadTone "perc" sawPerc
      mapM_
         (\f -> playTone "perc" 0.2 f >> lift (threadDelay 100000))
         [500,550..1000]


filterPerc :: UGen -> UGen -> UGen
filterPerc v f = out 0 (w * 0.5)
  where e = envGen KR 1 2 0 1 RemoveSynth envPerc'
        s = v * e * saw AR (MCE [f*1.001, f*0.999])
        w = rlpf s (exp (e*filterDepth) * filterBase) 0.05
        filterBase  = Control KR "filter-base"  1000
        filterDepth = Control KR "filter-depth"    1

randomPerc :: IO ()
randomPerc =
   withSC3 $
   do loadTone "perc" filterPerc
      let wave = [0,pi/20 ..]
      mapM_
         (\(f,fb,fd) ->
            playTone "perc" 0.2 f >>
            set "filter-base" fb >>
            set "filter-depth" fd >>
            lift (threadDelay 160000)) $
         zip3
            (map (toneToFreq . subtract 31 . ([0,4,7,10,12,16,19,22,24]!!)) $ randomRs (0,8) (mkStdGen 34))
   --         (map (toneToFreq . subtract 19 . ([0,2,4,5,7,9,11,12]!!)) $ randomRs (0,7) (mkStdGen 34))
            (map (\x -> 1000 * exp (sin x*0.5)) wave)
            (map (\x -> (cos x + 0.5)*0.7) wave)


filterSweep :: UGen -> UGen -> UGen
filterSweep f input = w
  where lfo   = exp (sinOsc KR 0.2 (-pi/2) * 0.5) * f
        w     = rlpf input lfo 0.1


playSimpleSweep :: IO ()
playSimpleSweep =
   withSC3 $
   do loadTone "string"
         (\vel freq -> out 0 $
             filterSweep 2000 (saw AR (MCE [freq, freq*1.002]) * vel))
      playTone "string" 0.3 55

playSuccSweep :: IO ()
playSuccSweep =
   withSC3 $
   do loadTone "string"
         (\vel freq -> out 0 $ saw AR freq * vel)
      loadEffect "filter"
--         (replaceOut 0 $ filterSweep 2000 (saw AR 440 * 0.1))
         (replaceOut 0 $ filterSweep 2000 (in' 1 AR 0))
      playTone "string" 0.1 440
      playTone "string" 0.1 660
      playEffect 1 "filter"

playFilterSweep :: IO ()
playFilterSweep =
   withSC3 $
   do loadTone "perc" sawPerc
      loadEffect "filter" (replaceOut 0 $ filterSweep 2000 (in' 1 AR 0))
      newGroup 1 2
      playEffect 2 "filter"
      mapM_
         (\f -> playToneInGroup 2 "perc" 0.1 f >> lift (threadDelay 200000))
         (cycle (map toneToFreq [0,2,4,5,7,5,4,2]))

toneToFreq :: Int -> Double
toneToFreq n = 440*2**(fromIntegral n / 12)


{- * speech synthesis -}

formant0, formant1, formant2 :: UGen

formant0 = formant AR (xLine KR 400 1000 8 RemoveSynth) 2000 800
formant1 = formant AR 200 (xLine KR 400 4000 8 RemoveSynth) 200
formant2 = formant AR 400 2000 (xLine KR 800 8000 8 RemoveSynth)

{-
Formant.help.rtf

// modulate fundamental frequency, formant freq stays constant
{ Formant.ar(XLine.kr(400,1000, 8), 2000, 800, 0.125) }.play

// modulate formant frequency, fundamental freq stays constant
{ Formant.ar(200, XLine.kr(400, 4000, 8), 200, 0.125) }.play

// modulate width frequency, other freqs stay constant
{ Formant.ar(400, 2000, XLine.kr(800, 8000, 8), 0.125) }.play
-}



render :: FilePath -> Double -> UGen -> IO ()
render name time ugen =
   let oscFileName   = name++".osc"
       audioFileName = name++".aiff"
       numChannels = Play.mceDegree ugen
   in  do writeNRT oscFileName
             [Bundle (Time.NTPr 0) $
                 g_new [(homeId, AddToTail, rootId)] :
                 Play.d_recv_synthdef name (out 0 ugen) :
                 s_new name autoId AddToTail homeId [] :
                 [],
              Bundle (Time.NTPr time) [g_freeAll [homeId]]]
          rawSystem "scsynth"
             ["-o", show numChannels, "-N", oscFileName, "_", audioFileName,
              "44100", "AIFF", "int16"]
          return ()

renderAnalogBubbles :: IO ()
renderAnalogBubbles =
   render "AnalogBubbles" 10.5 analogBubbles

renderWind :: IO ()
renderWind =
   render "Wind" 11 (wind 440)

renderBassFilter :: IO ()
renderBassFilter =
   render "BassFilter" 10 bassFilterGlissando