{-# LANGUAGE FlexibleContexts #-}
module Synthesizer.Dimensional.Rate.Dirac where

import qualified Synthesizer.Generic.Cut as Cut

import qualified Synthesizer.Dimensional.Signal.Private as SigA
import qualified Synthesizer.Dimensional.Process as Proc

import qualified Synthesizer.Dimensional.Amplitude as Amp
import qualified Synthesizer.Dimensional.Rate as Rate

import qualified Data.Monoid as Mn
import qualified Data.Semigroup as Sg

import qualified Number.DimensionTerm        as DN
import qualified Algebra.DimensionTerm       as Dim

-- import qualified Algebra.Field              as Field
import qualified Algebra.Ring               as Ring

import Data.Tuple.HT (mapPair, mapSnd, )

import NumericPrelude.Numeric (zero, one, )


{- |
We want to represent streams of discrete events
in a manner that is more safe than plain @[Bool]@.
Each peak can be imagined as a Dirac impulse.

A @[Bool]@ could be used accidentally for 'Synthesizer.Dimensional.Amplitude.Cut.selectBool',
where @selectBool@ is intended for piecewise constant control curves.

You may think that a type like @Peak = Peak Bool@ as sample type
in @T s Peak@ would also do the job.
Actually, this wouldn't be a good idea
since you can apply constant interpolation on it,
which obviously fools the idea of a peak.

This type is so level that it could be moved to Synthesizer.Generic.Dirac.
-}
newtype T s sig = Cons {forall s (sig :: * -> *). T s sig -> sig Bool
decons :: sig Bool}

instance Sg.Semigroup (sig Bool) => Sg.Semigroup (T s sig) where
   Cons sig Bool
x <> :: T s sig -> T s sig -> T s sig
<> Cons sig Bool
y = forall s (sig :: * -> *). sig Bool -> T s sig
Cons (sig Bool
x forall a. Semigroup a => a -> a -> a
Sg.<> sig Bool
y)

instance Mn.Monoid (sig Bool) => Mn.Monoid (T s sig) where
   mempty :: T s sig
mempty = forall s (sig :: * -> *). sig Bool -> T s sig
Cons forall a. Monoid a => a
Mn.mempty
   mappend :: T s sig -> T s sig -> T s sig
mappend (Cons sig Bool
x) (Cons sig Bool
y) = forall s (sig :: * -> *). sig Bool -> T s sig
Cons (forall a. Monoid a => a -> a -> a
Mn.mappend sig Bool
x sig Bool
y)

instance Cut.Read (sig Bool) => Cut.Read (T s sig) where
   {-# INLINE null #-}
   null :: T s sig -> Bool
null = forall sig. Read sig => sig -> Bool
Cut.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (sig :: * -> *). T s sig -> sig Bool
decons
   {-# INLINE length #-}
   length :: T s sig -> Int
length = forall sig. Read sig => sig -> Int
Cut.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (sig :: * -> *). T s sig -> sig Bool
decons

instance Cut.Transform (sig Bool) => Cut.Transform (T s sig) where
   {-# INLINE take #-}
   take :: Int -> T s sig -> T s sig
take Int
n = forall s (sig :: * -> *). sig Bool -> T s sig
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sig. Transform sig => Int -> sig -> sig
Cut.take Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (sig :: * -> *). T s sig -> sig Bool
decons
   {-# INLINE drop #-}
   drop :: Int -> T s sig -> T s sig
drop Int
n = forall s (sig :: * -> *). sig Bool -> T s sig
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sig. Transform sig => Int -> sig -> sig
Cut.drop Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (sig :: * -> *). T s sig -> sig Bool
decons
   {-# INLINE splitAt #-}
   splitAt :: Int -> T s sig -> (T s sig, T s sig)
splitAt Int
n = forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (forall s (sig :: * -> *). sig Bool -> T s sig
Cons, forall s (sig :: * -> *). sig Bool -> T s sig
Cons) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sig. Transform sig => Int -> sig -> (sig, sig)
Cut.splitAt Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (sig :: * -> *). T s sig -> sig Bool
decons
   {-# INLINE dropMarginRem #-}
   dropMarginRem :: Int -> Int -> T s sig -> (Int, T s sig)
dropMarginRem Int
n Int
m = forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd forall s (sig :: * -> *). sig Bool -> T s sig
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sig. Transform sig => Int -> Int -> sig -> (Int, sig)
Cut.dropMarginRem Int
n Int
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (sig :: * -> *). T s sig -> sig Bool
decons
   {-# INLINE reverse #-}
   reverse :: T s sig -> T s sig
reverse = forall s (sig :: * -> *). sig Bool -> T s sig
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sig. Transform sig => sig -> sig
Cut.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (sig :: * -> *). T s sig -> sig Bool
decons

{- |
This is the most frequently needed transformation
of a stream of peaks, if not the only one.
It converts to a signal of peaks with area 1.
This convention is especially useful for smoothing filters
that produce frequency progress curves from zero crossings.
-}
{-# INLINE toAmplitudeSignal #-}
toAmplitudeSignal ::
   (Ring.C q, Dim.C u, Functor sig) =>
   Proc.T s u q
      (T s sig ->
       SigA.T (Rate.Phantom s) (Amp.Numeric (DN.T (Dim.Recip u) q)) (sig q))
toAmplitudeSignal :: forall q u (sig :: * -> *) s.
(C q, C u, Functor sig) =>
T s
  u
  q
  (T s sig -> T (Phantom s) (Numeric (T (Recip u) q)) (sig q))
toAmplitudeSignal =
   forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall u s t. C u => T s u t (T (Recip u) t)
Proc.getSampleRate forall a b. (a -> b) -> a -> b
$ \T (Recip u) q
rate ->
      forall rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
SigA.Cons forall s. Phantom s
Rate.Phantom (forall amp. amp -> Numeric amp
Amp.Numeric T (Recip u) q
rate) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
c -> if Bool
c then forall a. C a => a
one else forall a. C a => a
zero) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall s (sig :: * -> *). T s sig -> sig Bool
decons