{-# 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) = Int -> sig -> (sig, sig)
forall sig. Transform sig => Int -> sig -> (sig, sig)
CutG.splitAt Int
start sig
xs
loopBody :: sig
loopBody = Int -> sig -> sig
forall sig. Transform sig => Int -> sig -> sig
CutG.take Int
len sig
suffix
in sig -> sig -> sig
forall sig. Monoid sig => sig -> sig -> sig
CutG.append sig
prefix (sig -> sig
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 = Int -> Int -> Int
forall a. C a => a -> a -> a
div Int
loopLen2 Int
2
(sig yv
prefix, sig yv
loopOut) = Int -> sig yv -> (sig yv, sig yv)
forall sig. Transform sig => Int -> sig -> (sig, sig)
CutG.splitAt (Int
startInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
loopLen) sig yv
xs
loopIn :: sig yv
loopIn = Int -> sig yv -> sig yv
forall sig. Transform sig => Int -> sig -> sig
CutG.drop Int
start sig yv
prefix
loopBody :: sig yv
loopBody =
(y -> yv -> yv -> yv) -> T y -> T yv -> sig yv -> sig yv
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.5y -> y -> y
forall a. C a => a -> a -> a
*y
s y -> y -> y
forall a. a -> a -> a
`asTypeOf` y
dummy
in (y
0.5y -> y -> y
forall a. C a => a -> a -> a
-y
s2)y -> yv -> yv
forall a v. C a v => a -> v -> v
*>yv
x yv -> yv -> yv
forall a. C a => a -> a -> a
+ (y
0.5y -> y -> y
forall a. C a => a -> a -> a
+y
s2)y -> yv -> yv
forall a v. C a v => a -> v -> v
*>yv
y)
(y -> y -> T y
forall a. C a => a -> a -> T a
CtrlS.cosine y
0 (Int -> y
forall a b. (C a, C b) => a -> b
fromIntegral Int
loopLen))
(sig yv -> T yv
forall y. Storage (sig y) => sig y -> T y
forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
SigG.toState sig yv
loopIn)
sig yv
loopOut
in sig yv -> sig yv -> sig yv
forall sig. Monoid sig => sig -> sig -> sig
CutG.append sig yv
prefix (sig yv -> sig yv
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) =
TimeControl q -> q -> q -> (q, T q)
forall a. C a => TimeControl a -> a -> a -> (a, T a)
timeControl TimeControl q
timeCtrlWave q
period0 (q
loopLenq -> q -> q
forall a. C a => a -> a -> a
/q
2)
wave :: q -> T q yv
wave = T q yv -> T q yv -> q -> sig yv -> q -> T q yv
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 = q -> Int
forall b. C b => q -> b
forall a b. (C a, C b) => a -> b
round (q -> Int) -> q -> Int
forall a b. (a -> b) -> a -> b
$ q
loopStart q -> q -> q
forall a. C a => a -> a -> a
+ q
loopLenq -> q -> q
forall a. C a => a -> a -> a
/q
2
loop :: sig yv
loop =
LazySize -> T yv -> sig yv
forall (sig :: * -> *) y. Write sig y => LazySize -> T y -> sig y
SigG.fromState LazySize
lazySize (T yv -> sig yv) -> T yv -> sig yv
forall a b. (a -> b) -> a -> b
$
(q -> T q yv) -> T q -> T q -> T q -> T yv
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
(q -> T q
forall a. C a => a -> T a
Phase.fromRepresentative (q -> T q) -> q -> T q
forall a b. (a -> b) -> a -> b
$ Int -> q
forall a b. (C a, C b) => a -> b
fromIntegral Int
loopCenter q -> q -> q
forall a. C a => a -> a -> a
/ q
period)
((q -> q) -> T q -> T q
forall a b. (a -> b) -> T a -> T b
SigS.map (Int -> q
forall a b. (C a, C b) => a -> b
fromIntegral Int
loopCenter q -> q -> q
forall a. C a => a -> a -> a
+) T q
timeCtrl)
(q -> T q
forall a. a -> T a
SigS.repeat (q -> q
forall a. C a => a -> a
recip q
period))
in (q
period,
sig yv -> sig yv -> sig yv
forall sig. Monoid sig => sig -> sig -> sig
CutG.append
(Int -> sig yv -> sig yv
forall sig. Transform sig => Int -> sig -> sig
CutG.take Int
loopCenter sig yv
sample)
(sig yv -> sig yv
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 =
Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$
(a -> Int
forall b. C b => a -> b
forall a b. (C a, C b) => a -> b
floor(a
slopea -> a -> a
forall a. C a => a -> a -> a
*a
loopDepth0a -> a -> a
forall a. C a => a -> a -> a
/a
period0) :: Int)
loopLenInt :: Int
loopLenInt = a -> Int
forall b. C b => a -> b
forall a b. (C a, C b) => a -> b
floor (a
numberOfWaves a -> a -> a
forall a. C a => a -> a -> a
* a
period0)
loopLen :: a
loopLen = Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
loopLenInt
period :: a
period = a
loopLen a -> a -> a
forall a. C a => a -> a -> a
/ a
numberOfWaves
loopDepth :: a
loopDepth = a
loopLen a -> a -> a
forall a. C a => a -> a -> a
/ a
slope
in (a
period,
Int -> T a -> T a
forall a. Int -> T a -> T a
SigS.take Int
loopLenInt (T a -> T a) -> T a -> T a
forall a b. (a -> b) -> a -> b
$
(a -> a) -> T a -> T a
forall a b. (a -> b) -> T a -> T b
SigS.map (a
loopDepth a -> a -> a
forall a. C a => a -> a -> a
*) (T a -> T a) -> T a -> T a
forall a b. (a -> b) -> a -> b
$
T a a -> T a -> a -> T a
forall a b. C a => T a b -> T a -> a -> T b
OsciS.static T a a
wave T a
forall a. C a => a
zero (a -> a
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 = a -> T a a -> TimeControl a
forall a. a -> T a a -> TimeControl a
TimeControl (a
2a -> a -> a
forall a. C a => a -> a -> a
*a
forall a. C a => a
pi) T a a
forall a. C a => T a a
Wave.sine
timeControlZigZag :: (RealRing.C a) => TimeControl a
timeControlZigZag :: forall a. C a => TimeControl a
timeControlZigZag = a -> T a a -> TimeControl a
forall a. a -> T a a -> TimeControl a
TimeControl a
4 T a a
forall a. (Ord a, C a) => T a a
Wave.triangle