{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Basic.ToneModulation (
   untangleShapePhase, untangleShapePhaseAnalytic,
   flattenShapePhase, flattenShapePhaseAnalytic,
   shapeLimits,
   interpolationOffset, interpolationNumber,
   Coords, Skip,
   ) where

import qualified Synthesizer.Basic.Phase as Phase

import Synthesizer.Interpolation (Margin, marginOffset, marginNumber, )

import qualified Algebra.RealField             as RealField
import qualified Algebra.Field                 as Field
import qualified Algebra.Ring                  as Ring

import NumericPrelude.Numeric
import NumericPrelude.Base


{- |
Convert from the (shape,phase) parameter pair
to the index within a wave (step) and the index of a wave (leap)
in the sampled prototype tone.

For this routine it would be simpler,
if @shape@ would measure in multiples of @period@
(we would only need a Ring instance),
but for 'shapeLimit' it is better the way it is.
-}
{-# INLINE untangleShapePhase #-}
untangleShapePhase :: (Field.C a) =>
   Int -> a -> (a, a) -> (a, a)
untangleShapePhase :: forall a. C a => Int -> a -> (a, a) -> (a, a)
untangleShapePhase Int
periodInt a
period (a
shape,a
phase) =
   let leap :: a
leap = a
shapea -> a -> a
forall a. C a => a -> a -> a
/a
period a -> a -> a
forall a. C a => a -> a -> a
- a
phase
       step :: a
step = a
shape a -> a -> a
forall a. C a => a -> a -> a
- a
leap a -> a -> a
forall a. C a => a -> a -> a
* Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
periodInt
   in  (a
leap, a
step)

untangleShapePhaseAnalytic :: (Field.C a) =>
   Int -> a -> (a, a) -> (a, a)
untangleShapePhaseAnalytic :: forall a. C a => Int -> a -> (a, a) -> (a, a)
untangleShapePhaseAnalytic Int
periodInt a
period (a
shape,a
phase) =
   let periodRound :: a
periodRound = Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
periodInt
       vLeap :: (a, a)
vLeap = (a
periodRound, a
periodRounda -> a -> a
forall a. C a => a -> a -> a
-a
period)
       vStep :: (a, a)
vStep = (a
1,a
1)
   in  ((a, a), (a, a)) -> (a, a) -> (a, a)
forall a. C a => ((a, a), (a, a)) -> (a, a) -> (a, a)
solveSLE2 ((a, a)
vLeap,(a, a)
vStep) (a
shape,a
perioda -> a -> a
forall a. C a => a -> a -> a
*a
phase)

{-
Cramer's rule

see HTam/Numerics/ZeroFinder/Root, however the matrix is transposed
-}
solveSLE2 :: Field.C a => ((a,a), (a,a)) -> (a,a) -> (a,a)
solveSLE2 :: forall a. C a => ((a, a), (a, a)) -> (a, a) -> (a, a)
solveSLE2 a :: ((a, a), (a, a))
a@((a, a)
a0,(a, a)
a1) (a, a)
b =
   let det :: a
det = ((a, a), (a, a)) -> a
forall a. C a => ((a, a), (a, a)) -> a
det2 ((a, a), (a, a))
a
   in  (((a, a), (a, a)) -> a
forall a. C a => ((a, a), (a, a)) -> a
det2 ((a, a)
b, (a, a)
a1) a -> a -> a
forall a. C a => a -> a -> a
/ a
det,
        ((a, a), (a, a)) -> a
forall a. C a => ((a, a), (a, a)) -> a
det2 ((a, a)
a0, (a, a)
b) a -> a -> a
forall a. C a => a -> a -> a
/ a
det)

det2 :: Ring.C a => ((a,a), (a,a)) -> a
det2 :: forall a. C a => ((a, a), (a, a)) -> a
det2 ((a
a00,a
a10),(a
a01,a
a11)) =
   a
a00a -> a -> a
forall a. C a => a -> a -> a
*a
a11 a -> a -> a
forall a. C a => a -> a -> a
- a
a10a -> a -> a
forall a. C a => a -> a -> a
*a
a01

{-
transpose :: ((a,a), (a,a)) -> ((a,a), (a,a))
transpose ((a00,a10),(a01,a11)) = ((a00,a01),(a10,a11))
-}


{-# INLINE flattenShapePhase #-}
flattenShapePhase, flattenShapePhaseAnalytic :: RealField.C a =>
      Int
   -> a
   -> (a, Phase.T a)
   -> (Int, (a, a))
flattenShapePhase :: forall a. C a => Int -> a -> (a, T a) -> (Int, (a, a))
flattenShapePhase Int
periodInt a
period (a
shape,T a
phase) =
   let xLeap :: a
xLeap = a
shapea -> a -> a
forall a. C a => a -> a -> a
/a
period a -> a -> a
forall a. C a => a -> a -> a
- T a -> a
forall a. T a -> a
Phase.toRepresentative T a
phase
       qLeap :: a
qLeap = a -> a
forall a. C a => a -> a
fraction a
xLeap
       xStep :: a
xStep = a
shape a -> a -> a
forall a. C a => a -> a -> a
- a
qLeap a -> a -> a
forall a. C a => a -> a -> a
* Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
periodInt
       (Int
n,a
qStep) = a -> (Int, a)
forall b. C b => a -> (b, a)
forall a b. (C a, C b) => a -> (b, a)
splitFraction a
xStep
   in  (Int
n,(a
qLeap,a
qStep))

flattenShapePhaseAnalytic :: forall a. C a => Int -> a -> (a, T a) -> (Int, (a, a))
flattenShapePhaseAnalytic Int
periodInt a
period (a
shape,T a
phase) =
   let (a
xLeap,a
xStep) =
          Int -> a -> (a, a) -> (a, a)
forall a. C a => Int -> a -> (a, a) -> (a, a)
untangleShapePhase Int
periodInt a
period (a
shape, T a -> a
forall a. T a -> a
Phase.toRepresentative T a
phase)
       (Int
nLeap,a
qLeap) = a -> (Int, a)
forall b. C b => a -> (b, a)
forall a b. (C a, C b) => a -> (b, a)
splitFraction a
xLeap
       (Int
nStep,a
qStep) = a -> (Int, a)
forall b. C b => a -> (b, a)
forall a b. (C a, C b) => a -> (b, a)
splitFraction a
xStep
       {- reverse solveSLE2 for the shape parameter
          with respect to the rounded (wave,shape) coordinates -}
       n :: Int
n = Int
nStep Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
nLeap Int -> Int -> Int
forall a. C a => a -> a -> a
* Int
periodInt
   in  (Int
n,(a
qLeap,a
qStep))


shapeLimits :: Ring.C t =>
   Margin ->
   Margin ->
   Int ->
   t ->
   (t, t)
shapeLimits :: forall t. C t => Margin -> Margin -> Int -> t -> (t, t)
shapeLimits Margin
marginLeap Margin
marginStep Int
periodInt t
len =
   let minShape :: t
minShape =
          Int -> t
forall a b. (C a, C b) => a -> b
fromIntegral (Int -> t) -> Int -> t
forall a b. (a -> b) -> a -> b
$
          Margin -> Margin -> Int -> Int
interpolationOffset Margin
marginLeap Margin
marginStep Int
periodInt Int -> Int -> Int
forall a. C a => a -> a -> a
+
          Int
periodInt
       maxShape :: t
maxShape =
          t
minShape t -> t -> t
forall a. C a => a -> a -> a
+ t
len t -> t -> t
forall a. C a => a -> a -> a
-
          Int -> t
forall a b. (C a, C b) => a -> b
fromIntegral (Margin -> Margin -> Int -> Int
interpolationNumber Margin
marginLeap Margin
marginStep Int
periodInt)
   in  (t
minShape, t
maxShape)

interpolationOffset ::
   Margin ->
   Margin ->
   Int ->
   Int
interpolationOffset :: Margin -> Margin -> Int -> Int
interpolationOffset Margin
marginLeap Margin
marginStep Int
periodInt =
   Margin -> Int
marginOffset Margin
marginStep Int -> Int -> Int
forall a. C a => a -> a -> a
+
   Margin -> Int
marginOffset Margin
marginLeap Int -> Int -> Int
forall a. C a => a -> a -> a
* Int
periodInt

interpolationNumber ::
   Margin ->
   Margin ->
   Int ->
   Int
interpolationNumber :: Margin -> Margin -> Int -> Int
interpolationNumber Margin
marginLeap Margin
marginStep Int
periodInt =
   Margin -> Int
marginNumber Margin
marginStep Int -> Int -> Int
forall a. C a => a -> a -> a
+
   Margin -> Int
marginNumber Margin
marginLeap Int -> Int -> Int
forall a. C a => a -> a -> a
* Int
periodInt



type Coords t = (Int,(Int,(t,t)))
type Skip   t = (Int, (t, Phase.T t))