module Synthesizer.Physical.Signal where
import qualified Synthesizer.SampleRateContext.Signal as SigC
import qualified Synthesizer.SampleRateContext.Rate as Rate
import qualified Algebra.OccasionallyScalar as OccScalar
import qualified Algebra.VectorSpace as VectorSpace
import qualified Algebra.Module as Module
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import Algebra.OccasionallyScalar(toScalar)
import Algebra.Module((*>))
import Data.Tuple.HT (mapSnd, )
import Synthesizer.Utility (common, )
import PreludeBase
import NumericPrelude
data T t t' y y' yv =
Cons {
fullSampleRate :: Rate.T t t'
, content :: SigC.T y y' yv
}
deriving (Eq, Show)
cons ::
t'
-> y'
-> [yv]
-> T t t' y y' yv
cons sr amp ss =
Cons (Rate.fromNumber sr) (SigC.Cons amp ss)
sampleRate :: T t t' y y' yv -> t'
sampleRate = Rate.toNumber . fullSampleRate
amplitude :: T t t' y y' yv -> y'
amplitude = SigC.amplitude . content
samples :: T t t' y y' yv -> [yv]
samples = SigC.samples . content
replaceParameters :: t1' -> y1' -> T t t0' y y0' yv -> T t t1' y y1' yv
replaceParameters sr amp (Cons _ (SigC.Cons _ ss)) = cons sr amp ss
replaceSampleRate :: t1' -> T t t0' y y' yv -> T t t1' y y' yv
replaceSampleRate sr (Cons _ sig) = Cons (Rate.fromNumber sr) sig
replaceAmplitude :: y1' -> T t t' y y0' yv -> T t t' y y1' yv
replaceAmplitude amp (Cons sr sig) =
Cons sr (SigC.replaceAmplitude amp sig)
replaceSamples :: [yv1] -> T t t' y y' yv0 -> T t t' y y' yv1
replaceSamples ss (Cons sr sig) =
Cons sr (SigC.replaceSamples ss sig)
assert :: String -> Bool -> T t t' y y' yv -> T t t' y y' yv
assert msg cond x =
replaceSamples (if cond then samples x else error msg) x
assertAmplitude :: Eq y' => y' -> T t t' y y' yv -> T t t' y y' yv
assertAmplitude amp x =
replaceSamples
(if amp == amplitude x
then samples x
else error "assertAmplitude: amplitudes differ") x
assertSampleRate :: Eq t' => t' -> T t t' y y' yv -> T t t' y y' yv
assertSampleRate sr0 (Cons sr sig) =
Cons sr $
if sr0 == Rate.toNumber sr
then sig
else error "assertSampleRate: sample rates differ"
asTypeOfTime ::
t
-> T t t' y y' yv
-> t
asTypeOfTime = const
asTypeOfAmplitude :: y -> T t t' y y' yv -> y
asTypeOfAmplitude = const
toTimeScalar :: (Ring.C t', OccScalar.C t t') =>
T t t' y y' yv -> t' -> t
toTimeScalar x t =
toScalar (t * sampleRate x) `asTypeOfTime` x
toFrequencyScalar :: (Field.C t', OccScalar.C t t') =>
T t t' y y' yv -> t' -> t
toFrequencyScalar x f =
toScalar (f / sampleRate x) `asTypeOfTime` x
toAmplitudeScalar :: (Field.C y', OccScalar.C y y') =>
T t t' y y' yv -> y' -> y
toAmplitudeScalar x y =
toScalar (y / amplitude x) `asTypeOfAmplitude` x
commonSampleRate :: (Eq t') =>
T t t' y0 y'0 yv0 -> T t t' y1 y'1 yv1 -> t'
commonSampleRate x y =
commonSampleRate' (sampleRate x) (sampleRate y)
commonSampleRate' :: (Eq a) => a -> a -> a
commonSampleRate' x y =
common "The sample rates differ." x y
pureData :: (Field.C t', OccScalar.C t t',
Field.C y', OccScalar.C y y',
VectorSpace.C y yv) =>
t'
-> y'
-> T t t' y y' yv
-> (t, [yv])
pureData freqUnit amp sig =
(toTimeScalar sig (recip freqUnit),
recip (toAmplitudeScalar sig amp) *> samples sig)
instance Functor (T t t' y y') where
fmap f (Cons sr sig) = Cons sr (fmap f sig)
runPlain ::
t' -> (Rate.T t t' -> SigC.T y y' yv) -> T t t' y y' yv
runPlain sr f =
addPlainSampleRate sr (f (Rate.fromNumber sr))
addPlainSampleRate ::
t' -> SigC.T y y' yv -> T t t' y y' yv
addPlainSampleRate sr = Cons (Rate.fromNumber sr)
run ::
Rate.T t t' -> (Rate.T t t' -> SigC.T y y' yv) -> T t t' y y' yv
run sr f =
addSampleRate sr (f sr)
addSampleRate ::
Rate.T t t' -> SigC.T y y' yv -> T t t' y y' yv
addSampleRate = Cons
splitSampleRate ::
T t t' y y' yv -> (Rate.T t t', SigC.T y y' yv)
splitSampleRate (Cons sr sig) = (sr, sig)
checkSampleRate :: (Eq t') =>
String ->
Rate.T t t' ->
T t t' y y' yv -> SigC.T y y' yv
checkSampleRate funcName sr0 (Cons sr sig) =
if sr0 == sr
then sig
else error ("checkSampleRate for " ++ funcName ++ ": sample rates differ")
splitSampleRateList :: (Eq t') =>
[T t t' y y' yv] -> (Rate.T t t', [SigC.T y y' yv])
splitSampleRateList [] = error "splitSampleRateList: empty list"
splitSampleRateList xt@(x:_) =
let sr = fst (splitSampleRate x)
in (sr, map (checkSampleRate "splitSampleRateList" sr) xt)
apply ::
(Rate.T t t' -> SigC.T y0 y'0 y0v -> SigC.T y1 y'1 y1v)
-> T t t' y0 y'0 y0v
-> T t t' y1 y'1 y1v
apply f (Cons sr sig) =
run sr (flip f sig)
lift0 ::
(Rate.T t t' -> SigC.T y y' yv)
-> t' -> T t t' y y' yv
lift0 = flip runPlain
lift1 ::
(Rate.T t t' -> SigC.T y0 y0' yv0 -> SigC.T y1 y1' yv1)
-> (T t t' y0 y0' yv0 -> T t t' y1 y1' yv1)
lift1 = apply
lift2 :: (Eq t') =>
(Rate.T t t' -> SigC.T y0 y'0 yv0 -> SigC.T y1 y'1 yv1 -> SigC.T y2 y'2 yv2)
-> (T t t' y0 y'0 yv0 -> T t t' y1 y'1 yv1 -> T t t' y2 y'2 yv2)
lift2 f x0 x1 =
let (_, y0) = splitSampleRate x0
(_, y1) = splitSampleRate x1
in runPlain (commonSampleRate x0 x1) (\sr -> f sr y0 y1)
lift3 :: (Eq t') =>
(Rate.T t t' -> SigC.T y0 y'0 yv0 -> SigC.T y1 y'1 yv1 -> SigC.T y2 y'2 yv2 -> SigC.T y3 y'3 yv3)
-> (T t t' y0 y'0 yv0 -> T t t' y1 y'1 yv1 -> T t t' y2 y'2 yv2 -> T t t' y3 y'3 yv3)
lift3 f x0 x1 x2 =
let (sr0, y0) = splitSampleRate x0
(sr1, y1) = splitSampleRate x1
(sr2, y2) = splitSampleRate x2
in run
(sr0 `commonSampleRate'` sr1 `commonSampleRate'` sr2)
(\sr -> f sr y0 y1 y2)
liftList :: Eq t' =>
(Rate.T t t' -> [SigC.T y1 y'1 yv1] -> SigC.T y y' yv)
-> ([T t t' y1 y'1 yv1] -> T t t' y y' yv)
liftList f =
uncurry run .
mapSnd (flip f) .
splitSampleRateList
liftR2 ::
(Rate.T t t' -> SigC.T y y' yv -> (SigC.T y0 y'0 yv0, SigC.T y1 y'1 yv1))
-> T t t' y y' yv
-> (T t t' y0 y'0 yv0, T t t' y1 y'1 yv1)
liftR2 f x0 =
let (sr,x1) = splitSampleRate x0
(y0,y1) = f sr x1
in (addSampleRate sr y0, addSampleRate sr y1)
liftR3 ::
(Rate.T t t' -> SigC.T y y' yv -> (SigC.T y0 y'0 yv0, SigC.T y1 y'1 yv1, SigC.T y2 y'2 yv2))
-> T t t' y y' yv
-> (T t t' y0 y'0 yv0, T t t' y1 y'1 yv1, T t t' y2 y'2 yv2)
liftR3 f x0 =
let (sr,x1) = splitSampleRate x0
(y0,y1,y2) = f sr x1
in (addSampleRate sr y0, addSampleRate sr y1, addSampleRate sr y2)