module Synthesizer.Generic.Wave where

import qualified Synthesizer.State.ToneModulation as ToneMod
import qualified Synthesizer.Basic.Wave as Wave

import qualified Synthesizer.Generic.Signal as SigG

import qualified Synthesizer.Interpolation as Interpolation

import qualified Algebra.RealField            as RealField
import qualified Algebra.RealRing             as RealRing

import NumericPrelude.Numeric
import NumericPrelude.Base
import Prelude ()


sample ::
   (RealRing.C a, SigG.Transform sig v) =>
   Interpolation.T a v -> sig v -> Wave.T a v
sample :: forall a (sig :: * -> *) v.
(C a, Transform sig v) =>
T a v -> sig v -> T a v
sample T a v
ip sig v
wave =
   let len :: Int
len = forall sig. Read sig => sig -> Int
SigG.length sig v
wave
       cycleWave :: sig v
cycleWave = forall sig. Monoid sig => sig -> sig
SigG.cycle sig v
wave
   in  forall t y. (t -> y) -> T t y
Wave.fromFunction forall a b. (a -> b) -> a -> b
$ \ a
phase ->
           let (Int
n,a
q) = forall a b. (C a, C b) => a -> (b, a)
RealRing.splitFraction (a
phase forall a. C a => a -> a -> a
* forall a b. (C a, C b) => a -> b
fromIntegral Int
len)
           in  forall t y. T t y -> t -> T y -> y
Interpolation.func T a v
ip a
q forall a b. (a -> b) -> a -> b
$
               forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
SigG.toState forall a b. (a -> b) -> a -> b
$
               forall sig. Transform sig => Int -> sig -> sig
SigG.drop Int
n sig v
cycleWave


{- |
Interpolate first within waves and then across waves,
which is simpler but maybe less efficient for lists.
However for types with fast indexing/drop like StorableVector this is optimal.
-}
sampledTone ::
   (RealField.C a, SigG.Transform sig v) =>
   Interpolation.T a v ->
   Interpolation.T a v ->
   a -> sig v -> a -> Wave.T a v
sampledTone :: forall a (sig :: * -> *) v.
(C a, Transform sig v) =>
T a v -> T a v -> a -> sig v -> a -> T a v
sampledTone T a v
ipLeap T a v
ipStep a
period sig v
tone a
shape = forall t y. (T t -> y) -> T t y
Wave.Cons forall a b. (a -> b) -> a -> b
$ \T a
phase ->
--   uncurry (ToneMod.interpolateCell ipStep ipLeap . swap) $
   forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (sig :: * -> *) y a b.
Read sig y =>
T a y -> T b y -> (a, b) -> Cell sig y -> y
ToneMod.interpolateCell T a v
ipLeap T a v
ipStep) forall a b. (a -> b) -> a -> b
$
   forall a (sig :: * -> *) v.
(C a, Transform sig v) =>
Prototype sig a v -> a -> T a -> ((a, a), Cell sig v)
ToneMod.sampledToneCell
      (forall a (sig :: * -> *) v.
(C a, Read sig v) =>
Margin -> Margin -> a -> sig v -> Prototype sig a v
ToneMod.makePrototype
          (forall t y. T t y -> Margin
Interpolation.margin T a v
ipLeap) (forall t y. T t y -> Margin
Interpolation.margin T a v
ipStep)
          a
period sig v
tone)
      a
shape T a
phase