module Synthesizer.LLVM.Storable.Process (
makeArranger,
continuePacked,
) where
import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
import qualified Synthesizer.LLVM.Storable.Signal as SigStL
import qualified Synthesizer.CausalIO.Process as PIO
import qualified Synthesizer.Generic.Cut as CutG
import qualified Data.StorableVector as SV
import qualified Data.StorableVector.Base as SVB
import qualified Data.EventList.Relative.TimeBody as EventList
import qualified Data.EventList.Relative.TimeTime as EventListTT
import qualified Data.EventList.Relative.TimeMixed as EventListTM
import qualified Data.EventList.Absolute.TimeBody as AbsEventList
import qualified Number.NonNegative as NonNeg
import qualified LLVM.Extra.Arithmetic as A
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Core as LLVM
import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )
import qualified Type.Data.Num.Decimal as TypeNum
import qualified Control.Arrow as Arr
import qualified Data.Foldable as Fold
import Foreign.Storable (Storable, )
import Foreign.Marshal.Array (advancePtr, )
import qualified System.Unsafe as Unsafe
import NumericPrelude.Numeric
import NumericPrelude.Base
makeArranger ::
(Storable a, A.Additive value,
MakeValueTuple a, ValueTuple a ~ value, Memory.C value,
Arr.Arrow arrow) =>
IO (arrow
(EventListTT.T NonNeg.Int (SV.Vector a))
(SV.Vector a))
makeArranger = do
mixer <- SigStL.makeMixer A.add
fill <- SigStL.fillBuffer A.zero
return $ Arr.arr $ \ now ->
let
sznn = EventListTT.duration now
sz = NonNeg.toNumber sznn
xs =
AbsEventList.toPairList $
AbsEventList.mapTime NonNeg.toNumber $
EventList.toAbsoluteEventList 0 $
EventListTM.switchTimeR const now
in Unsafe.performIO $
SVB.createAndTrim sz $ \dstPtr -> do
fill (fromIntegral sz) dstPtr
Fold.forM_ xs $ \(i,s) ->
SVB.withStartPtr s $ \srcPtr len ->
let llen =
if len <= szi
then fromIntegral len
else error "Process.arrange: chunk larger that event list"
in mixer llen srcPtr (advancePtr dstPtr i)
return sz
continuePacked ::
(CutG.Transform a, Storable b, LLVM.IsPrimitive b, TypeNum.Positive n) =>
PIO.T a (SV.Vector (Serial.Plain n b)) ->
(b -> PIO.T a (SV.Vector (Serial.Plain n b))) ->
PIO.T a (SV.Vector (Serial.Plain n b))
continuePacked proc0 proc1 =
PIO.continueChunk proc0
(proc1 Arr.<<^ SV.last . SigStL.unpackStrict)