{-# OPTIONS_GHC -O #-}
module Main (main) where

import qualified Synthesizer.Storable.Signal as SigSt
import qualified Synthesizer.Storable.Cut    as CutSt
import qualified Data.StorableVector.ST.Strict as SVST
import qualified Data.StorableVector.Lazy as SVL

import qualified Data.EventList.Relative.TimeBody  as EventList

import qualified Synthesizer.State.Signal as SigS
import qualified Synthesizer.State.Oscillator as OsciS
import qualified Synthesizer.State.Filter.NonRecursive as FiltNRS

import qualified Synthesizer.Causal.Process as Causal
import qualified Synthesizer.Causal.Cut as CutC
import qualified Synthesizer.Causal.Displacement as DispC
import qualified Synthesizer.Causal.Filter.NonRecursive as FiltNRC

import qualified Synthesizer.Basic.Wave  as Wave
import qualified Synthesizer.Basic.Phase as Phase

import qualified Algebra.RealField      as RealField
import qualified Algebra.Ring           as Ring
import qualified Algebra.Additive       as Additive

import qualified Sound.Frame.Stereo as Stereo
import Sound.Frame.NumericPrelude.Stereo ()

import Control.Arrow ((<<<), (<<^), second, )
import Control.Monad.Trans.State (StateT(StateT), )
import Control.Monad.ST (runST, )

import Foreign.Storable (Storable, )

import NumericPrelude.Numeric
import NumericPrelude.Base
import Prelude ()


phase :: RealField.C a => a -> Phase.T a
phase = Phase.fromRepresentative

{-# INLINE osci0 #-}
osci0 :: Float -> SigSt.T Float
osci0 freq =
   SigS.toStorableSignal SigSt.defaultChunkSize $
   SigS.take 10000000 $
   OsciS.staticSaw zero freq

{-# INLINE osci1 #-}
osci1 :: Float -> SigSt.T Float
osci1 freq =
   SigS.toStorableSignal SigSt.defaultChunkSize $
   SigS.take 10000000 $
   FiltNRS.amplify 0.3 $
   foldl1 SigS.mix $
   zipWith
      (\ p f -> OsciS.staticSaw (phase p) (freq*f))
      [0.0, 0.7, 0.1]
      [1.008, 1.003, 0.990]

{-# INLINE osci1Flat #-}
osci1Flat :: Float -> SigSt.T Float
osci1Flat freq =
   let {-# INLINE osc #-}
       osc p f =
          OsciS.staticSaw (phase p) (freq*f)
       (p0,p1,p2) = (0.0, 0.7, 0.1)
       (f0,f1,f2) = (1.008, 1.003, 0.990)
   in  SigS.toStorableSignal SigSt.defaultChunkSize $
       SigS.take 10000000 $
       FiltNRS.amplify 0.3 $
       osc p0 f0 `SigS.mix`
       osc p1 f1 `SigS.mix`
       osc p2 f2

{-# INLINE osci1Causal #-}
osci1Causal :: Float -> SigSt.T Float
osci1Causal freq =
   let {-# INLINE osc #-}
       osc p f =
          OsciS.staticSaw (phase p) (freq*f)
       (p0,p1,p2) = (0.0, 0.7, 0.1)
       (f0,f1,f2) = (1.008, 1.003, 0.990)
   in  SigS.toStorableSignal SigSt.defaultChunkSize $
       (CutC.take 10000000 <<<
        FiltNRC.amplify 0.3 <<<
        DispC.mix <<< second DispC.mix)
       `Causal.applyFst` osc p0 f0
       `Causal.applyFst` osc p1 f1
       `Causal.apply` osc p2 f2

{-# INLINE osci1Join #-}
osci1Join :: Float -> SigSt.T Float
osci1Join freq =
   let {-# INLINE joinOsci #-}
       joinOsci p f =
          SigS.runViewL
             (OsciS.staticSaw (phase p) (freq*f))
             (\next ->
                Causal.fromStateMaybe (\x ->
                   fmap (x+) (StateT next)))
       (p0,p1,p2) = (0.0, 0.7, 0.1)
       (f0,f1,f2) = (1.008, 1.003, 0.990)
   in  SigS.toStorableSignal SigSt.defaultChunkSize $
       (CutC.take 10000000 <<<
        FiltNRC.amplify 0.3 <<<
        joinOsci p0 f0 <<<
        joinOsci p1 f1 <<<
        joinOsci p2 f2)
       `Causal.apply` SigS.repeat zero

{-# INLINE osci1Simultaneous #-}
osci1Simultaneous :: Float -> SigSt.T Float
osci1Simultaneous freq =
   let {-# INLINE osc #-}
       osc p f =
          OsciS.staticSaw (phase p) (freq*f)
       (p0,p1,p2) = (0.0, 0.7, 0.1)
       (f0,f1,f2) = (1.008, 1.003, 0.990)
       {-# INLINE multOsc #-}
       multOsc =
          SigS.runViewL (osc p0 f0) (\next0 s0 ->
          SigS.runViewL (osc p1 f1) (\next1 s1 ->
          SigS.runViewL (osc p2 f2) (\next2 s2 ->
             SigS.generate (\(t0,t1,t2) ->
                do (x0,r0) <- next0 t0
                   (x1,r1) <- next1 t1
                   (x2,r2) <- next2 t2
                   return ((x0,x1,x2),(r0,r1,r2)))
             (s0,s1,s2))))
   in  SigS.toStorableSignal SigSt.defaultChunkSize $
       (CutC.take 10000000 <<<
        FiltNRC.amplify 0.3 <<^
        (\(y0,y1,y2) -> y0+y1+y2))
       `Causal.apply` multOsc

{-# INLINE osci2 #-}
osci2 :: Float -> SigSt.T (Stereo.T Float)
osci2 freq =
   let {-# INLINE channel #-}
       channel ps fs =
          FiltNRS.amplify 0.3 $
--          foldl1 (SigS.zipWith (+)) $
          foldl1 SigS.mix $
          zipWith
             (\ p f -> OsciS.staticSaw (phase p) (freq*f))
             ps fs
   in  SigS.toStorableSignal SigSt.defaultChunkSize $
       SigS.take 10000000 $
       SigS.zipWith Stereo.cons
          (channel
             [0.0, 0.7, 0.1]
             [1.008, 1.003, 0.990])
          (channel
             [0.3, 0.4, 0.6]
             [0.992, 0.997, 1.010])

{-# INLINE osci2Flat #-}
osci2Flat :: Float -> SigSt.T (Stereo.T Float)
osci2Flat freq =
   let {-# INLINE osc #-}
       osc p f =
--          OsciS.static Wave.saw (phase p) (freq*f)
          OsciS.staticSaw (phase p) (freq*f)
       {-# INLINE channel #-}
       channel (p0,p1,p2) (f0,f1,f2) =
          FiltNRS.amplify 0.3 $
          osc p0 f0 `SigS.mix`
          osc p1 f1 `SigS.mix`
          osc p2 f2
   in  SigS.toStorableSignal SigSt.defaultChunkSize $
       SigS.take 10000000 $
       SigS.zipWith Stereo.cons
          (channel
             (0.0, 0.7, 0.1)
             (1.008, 1.003, 0.990))
          (channel
             (0.3, 0.4, 0.6)
             (0.992, 0.997, 1.010))

{-
{-# INLINE osci2Storable #-}
osci2Storable :: Float -> SigSt.T (Stereo.T Float)
osci2Storable freq =
   let osc p f =
          SigS.toStorableSignal SigSt.defaultChunkSize $
          OsciS.staticSaw (phase p) (freq*f)
       channel (p0,p1,p2) (f0,f1,f2) =
          osc p0 f0 `SigSt.mix`
          osc p1 f1 `SigSt.mix`
          osc p2 f2
   in  SigSt.take 10000000 $
       SigSt.zipWith (\l r -> (0.3::Float) *> Stereo.cons l r)
          (channel
             (0.0, 0.7, 0.1)
             (1.008, 1.003, 0.990))
          (channel
             (0.3, 0.4, 0.6)
             (0.992, 0.997, 1.010))
-}

{-# INLINE osci2Storable #-}
osci2Storable :: Float -> SigSt.T (Stereo.T Float)
osci2Storable freq =
   let channel ps fs =
          {-# SCC "channel" #-}
          foldl1 SigSt.mix $
          zipWith
             (\ p f ->
                 {-# SCC "Osci.staticSaw" #-}
                 SigS.toStorableSignal SigSt.defaultChunkSize $
                 OsciS.staticSaw (phase p) (freq*f))
             ps fs
   in  {-# SCC "take" #-}
       SigSt.take 10000000 $
       {-# SCC "zipWith" #-}
       SigSt.zipWith
          (\l r -> (0.3::Float) *> Stereo.cons l r)
          (channel
             [0.0, 0.7, 0.1]
             [1.008, 1.003, 0.990])
{-
       SigSt.map (\l -> Stereo.cons l l)
-}
          (channel
             [0.3, 0.4, 0.6]
             [0.992, 0.997, 1.010])
{-
With map:

real    0m1.656s
user    0m1.440s
sys     0m0.208s


With zip:

real    0m3.073s
user    0m2.792s
sys     0m0.212s
-}

{-
Mixing implemented by the basic mixing routine of 'CutSt.arrange'.
-}
{-# INLINE multiMixInf #-}
multiMixInf ::
   (Additive.C y, Storable y) =>
   SigSt.ChunkSize -> [SigSt.T y] -> SigSt.T y
multiMixInf (SVL.ChunkSize sz) =
   let {-# INLINE go #-}
       go xs =
         let (prefixes, suffixes) =
                unzip $ map (SigSt.splitAt sz) xs
         in  SVST.runSTVector
                (do v <- SVST.new sz zero
                    mapM_ (CutSt.addToBuffer v 0) prefixes
                    return v)
                      : go suffixes
   in  SigSt.fromChunks . go

{-# INLINE multiMixInf2 #-}
multiMixInf2 ::
   (Additive.C y, Storable y) =>
   SigSt.ChunkSize -> [SigSt.T y] -> SigSt.T y
multiMixInf2 (SVL.ChunkSize sz) =
   let {-# INLINE go #-}
       go xs =
         let (prefix, suffixes) =
                runST
                (do v <- SVST.new sz zero
                    remainders <- mapM (CutSt.addToBuffer v 0) xs
--                    chunk <- SVST.freeze v
                    chunk <- SVST.unsafeFreeze v
                    return (chunk, map snd remainders))
         in  prefix : go suffixes
   in  SigSt.fromChunks . go

{-# INLINE osci2MultiMix #-}
osci2MultiMix :: Float -> SigSt.T (Stereo.T Float)
osci2MultiMix freq =
   let channel ps fs =
          multiMixInf SigSt.defaultChunkSize $
          zipWith
             (\ p f ->
                 {-# SCC "Osci.staticSaw" #-}
                 SigS.toStorableSignal SigSt.defaultChunkSize $
                 OsciS.staticSaw (phase p) (freq*f))
             ps fs
   in  SigSt.take 10000000 $
       SigSt.zipWith
          (\l r -> (0.3::Float) *> Stereo.cons l r)
          (channel
             [0.0, 0.7, 0.1]
             [1.008, 1.003, 0.990])
          (channel
             [0.3, 0.4, 0.6]
             [0.992, 0.997, 1.010])
{-
real    0m3.609s
user    0m3.396s
sys     0m0.208s
-}


{-# INLINE osci2Arrange #-}
osci2Arrange :: Float -> SigSt.T (Stereo.T Float)
osci2Arrange freq =
   let channel ps fs =
          CutSt.arrange SigSt.defaultChunkSize $
          EventList.fromPairList $
          map ((,) 0) $
          zipWith
             (\ p f ->
                 {-# SCC "Osci.staticSaw" #-}
                 SigS.toStorableSignal SigSt.defaultChunkSize $
                 OsciS.staticSaw (phase p) (freq*f))
             ps fs
   in  SigSt.take 10000000 $
       SigSt.zipWith
          (\l r -> (0.3::Float) *> Stereo.cons l r)
          (channel
             [0.0, 0.7, 0.1]
             [1.008, 1.003, 0.990])
          (channel
             [0.3, 0.4, 0.6]
             [0.992, 0.997, 1.010])



main :: IO ()
main =
   do SigSt.writeFile "chorus.f32" (osci2Arrange 0.01)

{-
ghc -o dist/build/chorustest -odir dist/build -hidir dist/build -package synthesizer-core -O -fexcess-precision -fvia-C -optc-ffast-math -optc-O3 -ddump-simpl -ddump-simpl-stats speedtest/ChorusTest.hs >dist/build/ChorusTest.core

With SigS.mix (after rewriting zipAppend using runViewL)

$ time dist/build/chorustest

real    0m5.797s
user    0m5.544s
sys     0m0.252s


With SigS.zipWith (+)

$ time dist/build/chorustest

real    0m5.969s
user    0m5.688s
sys     0m0.260s


osci1Causal needs about three times
as the manually written function in storablevector:SpeedTestChorus.
This is certainly due to staticSaw, that is not inlined.

real    0m2.368s
user    0m2.252s
sys     0m0.116s


After adding SPECIALISE INLINE pragma to staticSaw,
the function osci1Flat reaches the speed of the manual implementation
in storablevector, that uses one unfoldrN.
It needs about 0.8s.
-}

{-
ghc -o dist/build/chorustest -odir dist/build -hidir dist/build -package synthesizer-core -O -fexcess-precision -fvia-C -optc-ffast-math -optc-O3 -prof -auto-all speedtest/ChorusTest.hs

$ time dist/build/chorustest +RTS -p
-}