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 = sig v -> Int
forall sig. Read sig => sig -> Int
SigG.length sig v
wave
       cycleWave :: sig v
cycleWave = sig v -> sig v
forall sig. Monoid sig => sig -> sig
SigG.cycle sig 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)
RealRing.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)
           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 -> v) -> T v -> v
forall a b. (a -> b) -> a -> b
$
               sig v -> T v
forall y. Storage (sig y) => sig y -> T y
forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
SigG.toState (sig v -> T v) -> sig v -> T v
forall a b. (a -> b) -> a -> b
$
               Int -> sig v -> sig v
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 = (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 ->
--   uncurry (ToneMod.interpolateCell ipStep ipLeap . swap) $
   ((a, a) -> Cell sig v -> v) -> ((a, a), Cell sig v) -> v
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (T a v -> T a v -> (a, a) -> Cell sig v -> v
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) (((a, a), Cell sig v) -> v) -> ((a, a), Cell sig v) -> v
forall a b. (a -> b) -> a -> b
$
   Prototype sig a v -> a -> T a -> ((a, a), Cell sig v)
forall a (sig :: * -> *) v.
(C a, Transform sig v) =>
Prototype sig a v -> a -> T a -> ((a, a), Cell sig v)
ToneMod.sampledToneCell
      (Margin -> Margin -> a -> sig v -> Prototype sig a v
forall a (sig :: * -> *) v.
(C a, Read sig v) =>
Margin -> Margin -> a -> sig v -> Prototype sig a v
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
period sig v
tone)
      a
shape T a
phase