{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Causal.Filter.NonRecursive where

import qualified Synthesizer.Causal.Process as Causal
import Control.Arrow ((>>>), )

import qualified Synthesizer.Generic.Filter.NonRecursive as FiltG
import qualified Synthesizer.Generic.Signal as SigG
import qualified Synthesizer.Basic.Filter.NonRecursive as Filt
import qualified Synthesizer.State.Control as CtrlS
import qualified Synthesizer.State.Signal as SigS
import Synthesizer.Utility (affineComb, )

import qualified Algebra.Module         as Module
import qualified Algebra.Field          as Field
import qualified Algebra.Ring           as Ring
import qualified Algebra.Additive       as Additive

import NumericPrelude.Numeric
import NumericPrelude.Base as NP


{-# INLINE amplify #-}
amplify :: (Ring.C a) => a -> Causal.T a a
amplify :: forall a. C a => a -> T a a
amplify a
v = forall a b. (a -> b) -> T a b
Causal.map (a
vforall a. C a => a -> a -> a
*)

{-# INLINE amplifyVector #-}
amplifyVector :: (Module.C a v) => a -> Causal.T v v
amplifyVector :: forall a v. C a v => a -> T v v
amplifyVector a
v = forall a b. (a -> b) -> T a b
Causal.map (a
vforall a v. C a v => a -> v -> v
*>)


{-# INLINE envelope #-}
envelope :: (Ring.C a) =>
   Causal.T (a,a) a
envelope :: forall a. C a => T (a, a) a
envelope = forall a b. (a -> b) -> T a b
Causal.map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. C a => a -> a -> a
(*))

{-# INLINE envelopeVector #-}
envelopeVector :: (Module.C a v) =>
   Causal.T (a,v) v
envelopeVector :: forall a v. C a v => T (a, v) v
envelopeVector = forall a b. (a -> b) -> T a b
Causal.map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a v. C a v => a -> v -> v
(*>))


{-# INLINE crossfade #-}
crossfade :: (Field.C a, Module.C a a) => Int -> Causal.T (a,a) a
crossfade :: forall a. (C a, C a a) => Int -> T (a, a) a
crossfade Int
len =
   let affineCombMono :: (Module.C a a) => a -> (a,a) -> a
       affineCombMono :: forall a. C a a => a -> (a, a) -> a
affineCombMono = forall t y. C t y => t -> (y, y) -> y
affineComb
   in  forall (sig :: * -> *) a b c.
Read sig a =>
T (a, b) c -> sig a -> T b c
Causal.applyFst
          (forall a b. (a -> b) -> T a b
Causal.map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. C a a => a -> (a, a) -> a
affineCombMono))
          (forall y. C y => Int -> (y, y) -> T y
CtrlS.line Int
len (a
0, a
1))


{-# INLINE accumulatePosModulatedFromPyramid #-}
accumulatePosModulatedFromPyramid ::
   (SigG.Transform sig v) =>
   ([sig v] -> (Int,Int) -> v) ->
   [sig v] -> Causal.T (Int,Int) v
accumulatePosModulatedFromPyramid :: forall (sig :: * -> *) v.
Transform sig v =>
([sig v] -> (Int, Int) -> v) -> [sig v] -> T (Int, Int) v
accumulatePosModulatedFromPyramid [sig v] -> (Int, Int) -> v
summer [sig v]
pyr0 =
   let sizes :: [Int]
sizes = forall signal. [signal] -> [Int]
Filt.unitSizesFromPyramid [sig v]
pyr0
       pyrStarts :: T [sig v]
pyrStarts =
          forall a. (a -> a) -> a -> T a
SigS.iterate (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall sig. Transform sig => Int -> sig -> sig
SigG.drop [Int]
sizes) [sig v]
pyr0
       offsets :: T Int
offsets =
          forall a. Int -> T a -> T a
SigS.take (forall a. [a] -> a
head [Int]
sizes) (forall a. (a -> a) -> a -> T a
SigS.iterate (Int
1forall a. C a => a -> a -> a
+) Int
0)
   in  forall (sig :: * -> *) a b. Read sig a => sig a -> T b (a, b)
Causal.feedFst (forall a b c. (a -> b -> c) -> T a -> T b -> T c
SigS.liftA2 (,) T [sig v]
pyrStarts T Int
offsets) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
       forall a b. (a -> b) -> T a b
Causal.map (\(([sig v]
pyr,Int
offset), (Int
lo,Int
hi)) ->
          [sig v] -> (Int, Int) -> v
summer [sig v]
pyr (Int
offsetforall a. C a => a -> a -> a
+Int
lo, Int
offsetforall a. C a => a -> a -> a
+Int
hi))

{-# INLINE sumsPosModulatedFromPyramid #-}
sumsPosModulatedFromPyramid ::
   (Additive.C v, SigG.Transform sig v) =>
   [sig v] -> Causal.T (Int,Int) v
sumsPosModulatedFromPyramid :: forall v (sig :: * -> *).
(C v, Transform sig v) =>
[sig v] -> T (Int, Int) v
sumsPosModulatedFromPyramid =
   forall (sig :: * -> *) v.
Transform sig v =>
([sig v] -> (Int, Int) -> v) -> [sig v] -> T (Int, Int) v
accumulatePosModulatedFromPyramid forall v (sig :: * -> *).
(C v, Transform sig v) =>
[sig v] -> (Int, Int) -> v
FiltG.sumRangeFromPyramid