{-# 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