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.Envelope.Construct (envPerc')
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))
import Sound.SC3.Server.Command
import Sound.SC3.Server.PlayEasy as Play
import Sound.SC3.Server.NRT (writeNRT)
import Sound.OpenSoundControl.OSC (OSC(Bundle))
import Sound.OpenSoundControl.Transport.Monad (Transport, send)
import qualified Sound.OpenSoundControl.Transport.Monad as Trans

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)


{- * complex configurations -}

{-
ts = Score [OscB 0.0 [d_recv' "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 :: Transport t =>
            String
            -> (UGen -> UGen -> UGen)
            -> Trans.IO t OSC
loadTone name tone =
   Play.sync (Play.d_recv' name
       (tone (Control KR "velocity" 0)
             (Control KR "pitch" 0)))

loadEffect :: Transport t =>
              String
              -> UGen
              -> Trans.IO t OSC
loadEffect name effect =
   Play.sync (Play.d_recv' name effect)

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

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

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

newGroup :: Transport t =>
            Int -> Int -> Trans.IO t ()
newGroup superGid gid =
   send (g_new [(gid, AddToTail, superGid)])

playEffect :: Transport t =>
              Int -> String -> Trans.IO t ()
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 0 $
                 g_new [(homeId, AddToTail, rootId)] :
                 Play.d_recv' name (out 0 ugen) :
                 s_new name autoId AddToTail homeId [] :
                 [],
              Bundle 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