module Synthesizer.LLVM.Server.CausalPacked.Common where

import Synthesizer.LLVM.Server.Common (SampleRate(SampleRate), Real)

import qualified Synthesizer.LLVM.MIDI.BendModulation as BM

import qualified Data.EventList.Relative.TimeTime as EventListTT

import qualified Numeric.NonNegative.Class as NonNeg

import Prelude hiding (Real)


-- ToDo: might be moved to event-list package
chopEvents ::
   (NonNeg.C time, Num time) =>
   time ->
   EventListTT.T time body ->
   [EventListTT.T time body]
chopEvents :: forall time body.
(C time, Num time) =>
time -> T time body -> [T time body]
chopEvents time
chunkSize =
   let go :: T time body -> [T time body]
go T time body
evs =
          -- splitBeforeTime?
          let (T time body
chunk,T time body
rest) = time -> T time body -> (T time body, T time body)
forall time body.
C time =>
time -> T time body -> (T time body, T time body)
EventListTT.splitAtTime time
chunkSize T time body
evs
          in  if T time body -> time
forall time body. C time => T time body -> time
EventListTT.duration T time body
chunk time -> time -> Bool
forall a. Eq a => a -> a -> Bool
== time
0
                then []
                else T time body
chunk T time body -> [T time body] -> [T time body]
forall a. a -> [a] -> [a]
: T time body -> [T time body]
go T time body
rest
   in  T time body -> [T time body]
forall {body}. T time body -> [T time body]
go


transposeModulation ::
   (Functor stream) =>
   SampleRate Real ->
   Real ->
   stream (BM.T Real) ->
   stream (BM.T Real)
transposeModulation :: forall (stream :: * -> *).
Functor stream =>
SampleRate Real -> Real -> stream (T Real) -> stream (T Real)
transposeModulation (SampleRate Real
sampleRate) Real
freq =
   (T Real -> T Real) -> stream (T Real) -> stream (T Real)
forall a b. (a -> b) -> stream a -> stream b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Real -> T Real -> T Real
forall a. C a => a -> T a -> T a
BM.shift (Real
freqReal -> Real -> Real
forall a. Fractional a => a -> a -> a
/Real
sampleRate))