{-# 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length T v
wave
       arr :: Array Int v
arr = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, forall a. Enum a => a -> a
pred Int
len) T 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)
splitFraction (a
phase forall a. C a => a -> a -> a
* forall a b. (C a, C b) => a -> b
fromIntegral Int
len)
               xs :: T v
xs = forall a b. (a -> b) -> [a] -> [b]
map (Array Int v
arrforall i e. Ix i => Array i e -> i -> e
!) (forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. C a => a -> a -> a
mod Int
len)
                      (forall a. Enum a => a -> [a]
enumFrom (Int
n forall a. C a => a -> a -> a
- forall t y. T t y -> Int
Interpolation.offset T a v
ip)))
--                map (arr!) (enumFromTo (n - Interpolation.offset ip)) ++ cycle wave
           in  forall t y. T t y -> t -> T y -> y
Interpolation.func T a v
ip a
q T v
xs

{- |
We assume that a tone was generated by a shape modulated oscillator.
We try to reconstruct the wave function
(with parameters shape control and phase)
from a tone by interpolation.

The unit for the shape control parameter is the sampling period.
That is the shape parameter is a time parameter
pointing to a momentary shape of the prototype signal.
Of course this momentary shape does not exist
and we can only guess it using interpolation.

At the boundaries we repeat the outermost shapes
that can be reconstructed entirely from interpolated data
(that is, no extrapolation is needed).
This way we cannot reproduce the shape at the boundaries
because we have no data for cyclically extending it.
On the other hand this method guarantees a nice wave shape
with the required fractional period.

It must be
   @length tone >=
       Interpolation.number ipStep +
       Interpolation.number ipLeap * ceiling period@.
-}
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 = forall t y. (T t -> y) -> T t y
Wave.Cons forall a b. (a -> b) -> a -> b
$ \T a
phase ->
   forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (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) forall a b. (a -> b) -> a -> b
$
   forall t y. C t => Prototype t y -> t -> T t -> ((t, t), Cell y)
ToneMod.sampledToneCell
      (forall t y.
C t =>
Margin -> Margin -> Int -> t -> T y -> Prototype t y
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)
          (forall a b. (C a, C b) => a -> b
round a
period) a
period T v
tone)
      a
shape T a
phase
{-
*Synthesizer.Basic.Wave>
GNUPlot.plotFunc [] (GNUPlot.linearScale 1000 (0,12)) (\t -> sampledTone Interpolation.linear Interpolation.linear (6::Double) ([-5,-3,-1,1,3,5,-4,-4,-4,4,4,4]++replicate 20 0) t (t/6))

*Synthesizer.Plain.Oscillator>
let period = 6.3::Double in GNUPlot.plotFunc [] (GNUPlot.linearScale 1000 (-10,20)) (\t -> Wave.sampledTone Interpolation.linear Interpolation.cubic period (take 20 $ staticSine 0 (1/period)) t (t/period))
-}