{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Synthesizer.Plain.Wave where
import qualified Synthesizer.Basic.Wave as Wave
import qualified Synthesizer.Plain.ToneModulation as ToneMod
import qualified Synthesizer.Plain.Interpolation as Interpolation
import qualified Synthesizer.Plain.Signal as Sig
import Data.Array ((!), listArray)
import qualified Algebra.RealField as RealField
import NumericPrelude.Numeric
import NumericPrelude.Base
sample :: (RealField.C a) =>
Interpolation.T a v -> Sig.T v -> Wave.T a v
sample :: forall a v. C a => T a v -> T v -> T a v
sample T a v
ip T v
wave =
let len :: Int
len = T v -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length T v
wave
arr :: Array Int v
arr = (Int, Int) -> T v -> Array Int v
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, Int -> Int
forall a. Enum a => a -> a
pred Int
len) T v
wave
in (a -> v) -> T a v
forall t y. (t -> y) -> T t y
Wave.fromFunction ((a -> v) -> T a v) -> (a -> v) -> T a v
forall a b. (a -> b) -> a -> b
$ \ a
phase ->
let (Int
n,a
q) = a -> (Int, a)
forall b. C b => a -> (b, a)
forall a b. (C a, C b) => a -> (b, a)
splitFraction (a
phase a -> a -> a
forall a. C a => a -> a -> a
* Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
len)
xs :: T v
xs = (Int -> v) -> [Int] -> T v
forall a b. (a -> b) -> [a] -> [b]
map (Array Int v
arrArray Int v -> Int -> v
forall i e. Ix i => Array i e -> i -> e
!) ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Int
forall a. C a => a -> a -> a
mod Int
len)
(Int -> [Int]
forall a. Enum a => a -> [a]
enumFrom (Int
n Int -> Int -> Int
forall a. C a => a -> a -> a
- T a v -> Int
forall t y. T t y -> Int
Interpolation.offset T a v
ip)))
in T a v -> a -> T v -> v
forall t y. T t y -> t -> T y -> y
Interpolation.func T a v
ip a
q T v
xs
sampledTone :: (RealField.C a) =>
Interpolation.T a v ->
Interpolation.T a v ->
a -> Sig.T v -> a -> Wave.T a v
sampledTone :: forall a v. C a => T a v -> T a v -> a -> T v -> a -> T a v
sampledTone T a v
ipLeap T a v
ipStep a
period T v
tone a
shape = (T a -> v) -> T a v
forall t y. (T t -> y) -> T t y
Wave.Cons ((T a -> v) -> T a v) -> (T a -> v) -> T a v
forall a b. (a -> b) -> a -> b
$ \T a
phase ->
((a, a) -> Cell v -> v) -> ((a, a), Cell v) -> v
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (T a v -> T a v -> (a, a) -> Cell v -> v
forall a y b. T a y -> T b y -> (a, b) -> Cell y -> y
ToneMod.interpolateCell T a v
ipLeap T a v
ipStep) (((a, a), Cell v) -> v) -> ((a, a), Cell v) -> v
forall a b. (a -> b) -> a -> b
$
Prototype a v -> a -> T a -> ((a, a), Cell v)
forall t y. C t => Prototype t y -> t -> T t -> ((t, t), Cell y)
ToneMod.sampledToneCell
(Margin -> Margin -> Int -> a -> T v -> Prototype a v
forall t y.
C t =>
Margin -> Margin -> Int -> t -> T y -> Prototype t y
ToneMod.makePrototype
(T a v -> Margin
forall t y. T t y -> Margin
Interpolation.margin T a v
ipLeap) (T a v -> Margin
forall t y. T t y -> Margin
Interpolation.margin T a v
ipStep)
(a -> Int
forall b. C b => a -> b
forall a b. (C a, C b) => a -> b
round a
period) a
period T v
tone)
a
shape T a
phase