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

import qualified Synthesizer.Generic.Cut as Cut

import qualified Synthesizer.Dimensional.RatePhantom as RP
import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA
import qualified Synthesizer.Dimensional.Straight.Signal  as SigS
import qualified Synthesizer.Dimensional.Process as Proc

import qualified Data.Monoid as Mn

-- 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 (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.
-}
newtype T s sig = Cons {decons :: sig Bool}

instance Mn.Monoid (sig Bool) => Mn.Monoid (T s sig) where
   mempty = Cons Mn.mempty
   mappend (Cons x) (Cons y) = Cons (Mn.mappend x y)

instance Cut.Read (sig Bool) => Cut.Read (T s sig) where
   {-# INLINE null #-}
   null = Cut.null . decons
   {-# INLINE length #-}
   length = Cut.length . decons

instance Cut.Transform (sig Bool) => Cut.Transform (T s sig) where
   {-# INLINE take #-}
   take n = Cons . Cut.take n . decons
   {-# INLINE drop #-}
   drop n = Cons . Cut.drop n . decons
   {-# INLINE splitAt #-}
   splitAt n = mapPair (Cons, Cons) . Cut.splitAt n . decons
   {-# INLINE dropMarginRem #-}
   dropMarginRem n m = mapSnd Cons . Cut.dropMarginRem n m . decons
   {-# INLINE reverse #-}
   reverse = Cons . Cut.reverse . 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 -> RP.T s (SigA.D (Dim.Recip u) q (SigS.T sig)) q)
toAmplitudeSignal =
   fmap
      (\rate ->
         RP.fromSignal . SigA.Cons rate . SigS.Cons .
         fmap (\c -> if c then one else zero) .
         decons)
      Proc.getSampleRate