{-# 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.Plain.Filter.NonRecursive as Filt import qualified Synthesizer.State.Signal as SigS 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 PreludeBase import NumericPrelude as NP -- import qualified Prelude as P {-# INLINE amplify #-} amplify :: (Ring.C a) => a -> Causal.T a a amplify v = Causal.map (v*) {-# INLINE amplifyVector #-} amplifyVector :: (Module.C a v) => a -> Causal.T v v amplifyVector v = Causal.map (v*>) {-# INLINE envelope #-} envelope :: (Ring.C a) => Causal.T (a,a) a envelope = Causal.map (uncurry (*)) {-# INLINE envelopeVector #-} envelopeVector :: (Module.C a v) => Causal.T (a,v) v envelopeVector = Causal.map (uncurry (*>)) {-# INLINE accumulatePosModulatedFromPyramid #-} accumulatePosModulatedFromPyramid :: (SigG.Transform sig v) => ([sig v] -> (Int,Int) -> v) -> [sig v] -> Causal.T (Int,Int) v accumulatePosModulatedFromPyramid summer pyr0 = let sizes = Filt.unitSizesFromPyramid pyr0 pyrStarts = SigS.iterate (zipWith SigG.drop sizes) pyr0 offsets = SigS.take (head sizes) (SigS.iterate (1+) 0) in Causal.feedFst (SigS.liftA2 (,) pyrStarts offsets) >>> Causal.map (\((pyr,offset), (lo,hi)) -> summer pyr (offset+lo, offset+hi)) {-# INLINE sumsPosModulatedFromPyramid #-} sumsPosModulatedFromPyramid :: (Additive.C v, SigG.Transform sig v) => [sig v] -> Causal.T (Int,Int) v sumsPosModulatedFromPyramid = accumulatePosModulatedFromPyramid FiltG.sumRangeFromPyramid