module Synthesizer.Storable.Cut where

import qualified Synthesizer.Storable.Signal as Sig

import qualified Data.StorableVector.Lazy      as SVL
import qualified Data.StorableVector.ST.Strict as SVST

import Control.Monad.ST.Strict (ST, runST, )

import qualified Data.EventList.Relative.TimeBody  as EventList
import qualified Data.EventList.Relative.TimeMixed as EventListTM
import qualified Data.EventList.Absolute.TimeBody  as AbsEventList
import Control.Monad.Trans.State (runState, modify, gets, put, )
-- import Control.Monad (mapM, )
import Data.Tuple.HT (mapSnd, )

-- import qualified Algebra.Real     as Real
import qualified Algebra.Additive as Additive
import qualified Number.NonNegative as NonNeg

import Foreign.Storable (Storable)

import PreludeBase
import NumericPrelude


{- |
ChunkSize is only required for zero padding.
-}
{-# INLINE arrange #-}
arrange :: (Storable v, Additive.C v) =>
       Sig.ChunkSize
    -> EventList.T NonNeg.Int (Sig.T v)
            {-^ A list of pairs: (relative start time, signal part),
                The start time is relative to the start time
                of the previous event. -}
    -> Sig.T v
            {-^ The mixed signal. -}
arrange size =
   uncurry Sig.append .
   flip runState Sig.empty .
   fmap (Sig.concat . EventList.getTimes) .
   EventList.mapM
      (\timeNN ->
           let time = NonNeg.toNumber timeNN
           in  do (prefix,suffix) <- gets (Sig.splitAtPad size time)
                  put suffix
                  return prefix)
      (\body ->
           modify (Sig.mix body))


arrangeList :: (Storable v, Additive.C v) =>
       Sig.ChunkSize
    -> EventList.T NonNeg.Int (Sig.T v)
            {-^ A list of pairs: (relative start time, signal part),
                The start time is relative to the start time
                of the previous event. -}
    -> Sig.T v
            {-^ The mixed signal. -}
arrangeList size evs =
   let xs = EventList.getBodies evs
   in  case EventList.getTimes evs of
          t:ts -> Sig.replicate size (NonNeg.toNumber t) zero `Sig.append`
                  addShiftedMany size ts xs
          []   -> Sig.empty


addShiftedMany :: (Storable a, Additive.C a) =>
   Sig.ChunkSize -> [NonNeg.Int] -> [Sig.T a] -> Sig.T a
addShiftedMany size ds xss =
   foldr (uncurry (addShifted size)) Sig.empty (zip (ds++[0]) xss)


{-
It is crucial that 'mix' uses the chunk size structure of the second operand.
This way we avoid unnecessary and even infinite look-ahead.
-}
addShifted :: (Storable a, Additive.C a) =>
   Sig.ChunkSize -> NonNeg.Int -> Sig.T a -> Sig.T a -> Sig.T a
addShifted size delNN px py =
   let del = NonNeg.toNumber delNN
   in  uncurry Sig.append $
       mapSnd (flip Sig.mix py) $
       Sig.splitAtPad size del px


{- |
The result is a Lazy StorableVector with chunks of the given size.
-}
{-# INLINE arrangeEquidist #-}
arrangeEquidist :: (Storable v, Additive.C v) =>
       Sig.ChunkSize
    -> EventList.T NonNeg.Int (Sig.T v)
            {-^ A list of pairs: (relative start time, signal part),
                The start time is relative to the start time
                of the previous event. -}
    -> Sig.T v
            {-^ The mixed signal. -}
arrangeEquidist (SVL.ChunkSize sz) =
   let sznn = NonNeg.fromNumberMsg "arrangeEquidist" sz
       go acc evs =
          let (now,future) = EventListTM.splitAtTime sznn evs
              xs =
                 AbsEventList.toPairList $
                 EventList.toAbsoluteEventList 0 $
                 EventListTM.switchTimeR (const) now
              (chunk,newAcc) =
                 runST
                    (do v <- SVST.new sz zero
                        newAcc0 <- mapM (addToBuffer v 0) acc
--                        newAcc1 <- AbsEventList.mapM (addToBuffer v) xs
                        newAcc1 <-
                           mapM (\(i,s) -> addToBuffer v (NonNeg.toNumber i) s) xs
                        vf <- SVST.freeze v
                        return
                           (vf, filter (not . Sig.null) (newAcc0++newAcc1)))
          in  chunk : go newAcc future
   in  Sig.fromChunks . go []



addToBuffer :: (Storable a, Additive.C a) =>
   SVST.Vector s a -> Int -> Sig.T a -> ST s (Sig.T a)
addToBuffer v start =
   let n = SVST.length v
       {-# INLINE go #-}
       go i =
          if i>=n
            then return
            else
              Sig.switchL
                 (return Sig.empty)
                 (\x xs ->
                     SVST.modify v i (x Additive.+) >>
                     go (succ i) xs)
   in  go start