module Synthesizer.PiecewiseConstant.Storable (
   toSignal,
   toSignalInit,
   toSignalInitWith,
   ) where

import qualified Synthesizer.PiecewiseConstant.Private as PC
import Synthesizer.PiecewiseConstant.Private (StrictTime)

import qualified Synthesizer.Storable.Signal     as SigSt
import qualified Data.StorableVector.Lazy.Pattern as SigStV
import qualified Data.StorableVector.Lazy        as SVL

import qualified Data.EventList.Relative.BodyTime  as EventListBT
import qualified Data.EventList.Relative.TimeBody  as EventList

import Foreign.Storable (Storable, )

import qualified Numeric.NonNegative.Wrapper as NonNegW
import qualified Numeric.NonNegative.Chunky as NonNegChunky



chunkSizesFromStrictTime :: StrictTime -> NonNegChunky.T SigSt.ChunkSize
chunkSizesFromStrictTime :: StrictTime -> T ChunkSize
chunkSizesFromStrictTime =
   forall a. C a => [a] -> T a
NonNegChunky.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a b. (a -> b) -> [a] -> [b]
map (Int -> ChunkSize
SVL.ChunkSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. T a -> a
NonNegW.toNumber) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   StrictTime -> [T Int]
PC.chopLongTime


replicateLong :: (Storable y) => StrictTime -> y -> SigSt.T y
replicateLong :: forall y. Storable y => StrictTime -> y -> T y
replicateLong StrictTime
t y
y =
   forall a. Storable a => T ChunkSize -> a -> Vector a
SigStV.replicate (StrictTime -> T ChunkSize
chunkSizesFromStrictTime StrictTime
t) y
y

{-# INLINE toSignal #-}
toSignal :: (Storable y) => EventListBT.T StrictTime y -> SigSt.T y
toSignal :: forall y. Storable y => T StrictTime y -> T y
toSignal = forall (sig :: * -> *) y.
Transform sig y =>
(StrictTime -> y -> sig y) -> T StrictTime y -> sig y
PC.toSignal forall y. Storable y => StrictTime -> y -> T y
replicateLong

{-# INLINE toSignalInit #-}
toSignalInit :: (Storable y) => y -> EventList.T StrictTime y -> SigSt.T y
toSignalInit :: forall y. Storable y => y -> T StrictTime y -> T y
toSignalInit = forall (sig :: * -> *) y.
Transform sig y =>
(StrictTime -> y -> sig y) -> y -> T StrictTime y -> sig y
PC.toSignalInit forall y. Storable y => StrictTime -> y -> T y
replicateLong

{-# INLINE toSignalInitWith #-}
toSignalInitWith ::
   (Storable c) =>
   (y -> c) -> c -> EventList.T StrictTime [y] -> SigSt.T c
toSignalInitWith :: forall c y. Storable c => (y -> c) -> c -> T StrictTime [y] -> T c
toSignalInitWith = forall (sig :: * -> *) c y.
Transform sig c =>
(StrictTime -> c -> sig c)
-> (y -> c) -> c -> T StrictTime [y] -> sig c
PC.toSignalInitWith forall y. Storable y => StrictTime -> y -> T y
replicateLong