{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Generic.Loop (
simple,
fade,
timeReverse,
TimeControl,
timeControlSine,
timeControlZigZag,
) where
import qualified Synthesizer.Generic.Signal as SigG
import qualified Synthesizer.Generic.Cut as CutG
import qualified Synthesizer.Generic.Wave as WaveG
import qualified Synthesizer.Basic.Wave as Wave
import qualified Synthesizer.Basic.Phase as Phase
import qualified Synthesizer.State.Signal as SigS
import qualified Synthesizer.State.Control as CtrlS
import qualified Synthesizer.State.Oscillator as OsciS
import qualified Synthesizer.Interpolation as Interpolation
import qualified Algebra.Transcendental as Trans
import qualified Algebra.Module as Module
import qualified Algebra.RealField as RealField
import qualified Algebra.RealRing as RealRing
import NumericPrelude.Numeric
import NumericPrelude.Base
simple :: (CutG.Transform sig) => Int -> Int -> sig -> sig
simple :: forall sig. Transform sig => Int -> Int -> sig -> sig
simple Int
len Int
start sig
xs =
let (sig
prefix, sig
suffix) = forall sig. Transform sig => Int -> sig -> (sig, sig)
CutG.splitAt Int
start sig
xs
loopBody :: sig
loopBody = forall sig. Transform sig => Int -> sig -> sig
CutG.take Int
len sig
suffix
in forall sig. Monoid sig => sig -> sig -> sig
CutG.append sig
prefix (forall sig. Monoid sig => sig -> sig
CutG.cycle sig
loopBody)
fade :: (SigG.Transform sig yv, Trans.C y, Module.C y yv) =>
y -> Int -> Int -> sig yv -> sig yv
fade :: forall (sig :: * -> *) yv y.
(Transform sig yv, C y, C y yv) =>
y -> Int -> Int -> sig yv -> sig yv
fade y
dummy Int
loopLen2 Int
start sig yv
xs =
let loopLen :: Int
loopLen = forall a. C a => a -> a -> a
div Int
loopLen2 Int
2
(sig yv
prefix, sig yv
loopOut) = forall sig. Transform sig => Int -> sig -> (sig, sig)
CutG.splitAt (Int
startforall a. C a => a -> a -> a
+Int
loopLen) sig yv
xs
loopIn :: sig yv
loopIn = forall sig. Transform sig => Int -> sig -> sig
CutG.drop Int
start sig yv
prefix
loopBody :: sig yv
loopBody =
forall (sig :: * -> *) c d a b.
(Transform sig c, Transform sig d) =>
(a -> b -> c -> d) -> T a -> T b -> sig c -> sig d
SigG.zipWithState3
(\y
s yv
x yv
y ->
let s2 :: y
s2 = y
0.5forall a. C a => a -> a -> a
*y
s forall a. a -> a -> a
`asTypeOf` y
dummy
in (y
0.5forall a. C a => a -> a -> a
-y
s2)forall a v. C a v => a -> v -> v
*>yv
x forall a. C a => a -> a -> a
+ (y
0.5forall a. C a => a -> a -> a
+y
s2)forall a v. C a v => a -> v -> v
*>yv
y)
(forall a. C a => a -> a -> T a
CtrlS.cosine y
0 (forall a b. (C a, C b) => a -> b
fromIntegral Int
loopLen))
(forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
SigG.toState sig yv
loopIn)
sig yv
loopOut
in forall sig. Monoid sig => sig -> sig -> sig
CutG.append sig yv
prefix (forall sig. Monoid sig => sig -> sig
CutG.cycle sig yv
loopBody)
{-# INLINE timeReverse #-}
timeReverse ::
(SigG.Write sig yv, RealField.C q, Module.C q yv) =>
SigG.LazySize ->
Interpolation.T q yv ->
Interpolation.T q yv ->
TimeControl q ->
q -> q -> (q, sig yv) -> (q, sig yv)
timeReverse :: forall (sig :: * -> *) yv q.
(Write sig yv, C q, C q yv) =>
LazySize
-> T q yv
-> T q yv
-> TimeControl q
-> q
-> q
-> (q, sig yv)
-> (q, sig yv)
timeReverse LazySize
lazySize T q yv
ipLeap T q yv
ipStep
TimeControl q
timeCtrlWave q
loopLen q
loopStart (q
period0, sig yv
sample) =
let (q
period, T q
timeCtrl) =
forall a. C a => TimeControl a -> a -> a -> (a, T a)
timeControl TimeControl q
timeCtrlWave q
period0 (q
loopLenforall a. C a => a -> a -> a
/q
2)
wave :: q -> T q yv
wave = forall a (sig :: * -> *) v.
(C a, Transform sig v) =>
T a v -> T a v -> a -> sig v -> a -> T a v
WaveG.sampledTone T q yv
ipLeap T q yv
ipStep q
period sig yv
sample
loopCenter :: Int
loopCenter = forall a b. (C a, C b) => a -> b
round forall a b. (a -> b) -> a -> b
$ q
loopStart forall a. C a => a -> a -> a
+ q
loopLenforall a. C a => a -> a -> a
/q
2
loop :: sig yv
loop =
forall (sig :: * -> *) y. Write sig y => LazySize -> T y -> sig y
SigG.fromState LazySize
lazySize forall a b. (a -> b) -> a -> b
$
forall a c b. C a => (c -> T a b) -> T a -> T c -> T a -> T b
OsciS.shapeFreqMod q -> T q yv
wave
(forall a. C a => a -> T a
Phase.fromRepresentative forall a b. (a -> b) -> a -> b
$ forall a b. (C a, C b) => a -> b
fromIntegral Int
loopCenter forall a. C a => a -> a -> a
/ q
period)
(forall a b. (a -> b) -> T a -> T b
SigS.map (forall a b. (C a, C b) => a -> b
fromIntegral Int
loopCenter forall a. C a => a -> a -> a
+) T q
timeCtrl)
(forall a. a -> T a
SigS.repeat (forall a. C a => a -> a
recip q
period))
in (q
period,
forall sig. Monoid sig => sig -> sig -> sig
CutG.append
(forall sig. Transform sig => Int -> sig -> sig
CutG.take Int
loopCenter sig yv
sample)
(forall sig. Monoid sig => sig -> sig
CutG.cycle sig yv
loop))
timeControl ::
(RealField.C a) =>
TimeControl a ->
a -> a -> (a, SigS.T a)
timeControl :: forall a. C a => TimeControl a -> a -> a -> (a, T a)
timeControl (TimeControl a
slope T a a
wave) a
period0 a
loopDepth0 =
let numberOfWaves :: a
numberOfWaves =
forall a b. (C a, C b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$
(forall a b. (C a, C b) => a -> b
floor(a
slopeforall a. C a => a -> a -> a
*a
loopDepth0forall a. C a => a -> a -> a
/a
period0) :: Int)
loopLenInt :: Int
loopLenInt = forall a b. (C a, C b) => a -> b
floor (a
numberOfWaves forall a. C a => a -> a -> a
* a
period0)
loopLen :: a
loopLen = forall a b. (C a, C b) => a -> b
fromIntegral Int
loopLenInt
period :: a
period = a
loopLen forall a. C a => a -> a -> a
/ a
numberOfWaves
loopDepth :: a
loopDepth = a
loopLen forall a. C a => a -> a -> a
/ a
slope
in (a
period,
forall a. Int -> T a -> T a
SigS.take Int
loopLenInt forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> T a -> T b
SigS.map (a
loopDepth forall a. C a => a -> a -> a
*) forall a b. (a -> b) -> a -> b
$
forall a b. C a => T a b -> T a -> a -> T b
OsciS.static T a a
wave forall a. C a => a
zero (forall a. C a => a -> a
recip a
loopLen))
data TimeControl a = TimeControl a (Wave.T a a)
timeControlSine :: (Trans.C a) => TimeControl a
timeControlSine :: forall a. C a => TimeControl a
timeControlSine = forall a. a -> T a a -> TimeControl a
TimeControl (a
2forall a. C a => a -> a -> a
*forall a. C a => a
pi) forall a. C a => T a a
Wave.sine
timeControlZigZag :: (RealRing.C a) => TimeControl a
timeControlZigZag :: forall a. C a => TimeControl a
timeControlZigZag = forall a. a -> T a a -> TimeControl a
TimeControl a
4 forall a. (Ord a, C a) => T a a
Wave.triangle