Cut.hs

{-# LANGUAGE NoImplicitPrelude #-}
{- |
Copyright   :  (c) Henning Thielemann 2006
License     :  GPL

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes
-}
module Synthesizer.Inference.Monad.Signal.Cut (
   {- * dissection -}
   splitAt,
   take,
   drop,
   takeUntilPause,
   unzip,
   unzip3,

   {- * glueing -}
   concat,
   append,
   zip,
   zip3,
   arrange,
  ) where

import qualified UniqueLogicNP.Explicit.Process    as Process
import qualified UniqueLogicNP.Explicit.Expression as Expr
import qualified Synthesizer.Inference.Monad.Signal     as SigI

import qualified Synthesizer.Physical.Signal      as SigP
import qualified Synthesizer.Physical.Cut         as CutP

import qualified Synthesizer.Plain.Cut as CutS

import Synthesizer.Inference.Monad.Signal
   (toTimeScalar, toAmplitudeScalar,
    amplitudeExpr)

import qualified Algebra.NormedSpace.Maximum as NormedMax
import qualified Algebra.OccasionallyScalar  as OccScalar
import qualified Algebra.Module              as Module
import qualified Algebra.RealField           as RealField
import qualified Algebra.Field               as Field
import qualified Algebra.Real                as Real
import qualified Algebra.Ring                as Ring

import qualified Data.EventList.Relative.TimeBody as EventList
import qualified Number.NonNegative as NonNeg

import qualified Data.List as List

import Control.Monad.Fix(mfix)
import PreludeBase (Ord, (<=), (.),
                    (>>), (>>=), fail, return, fmap, map, fst, snd, mapM)
import NumericPrelude
import Prelude (RealFrac)

{- * dissection -}

splitAt :: (RealField.C a, Field.C q, OccScalar.C a q) =>
   q -> SigI.T a q v -> Process.T q (SigI.T a q v, SigI.T a q v)
splitAt t0 x =
   do t <- SigI.toTimeScalar x (Expr.constant t0)
      let (ss0,ss1) = List.splitAt (round t) (SigP.samples x)
      return (SigP.replaceSamples ss0 x, SigP.replaceSamples ss1 x)

take :: (RealField.C a, Field.C q, OccScalar.C a q) =>
   q -> SigI.T a q v -> SigI.Process a q v
take t = fmap fst . splitAt t

drop :: (RealField.C a, Field.C q, OccScalar.C a q) =>
   q -> SigI.T a q v -> SigI.Process a q v
drop t = fmap snd . splitAt t

takeUntilPause :: (RealField.C a, Field.C q,
                   NormedMax.C a v, OccScalar.C a q) =>
   q -> q -> SigI.T a q v -> SigI.Process a q v
takeUntilPause y t x =
   do t' <- SigI.toTimeScalar      x (Expr.constant t)
      y' <- SigI.toAmplitudeScalar x (Expr.constant y)
      return (SigP.replaceSamples
         (CutS.takeUntilInterval
             ((<=y') . NormedMax.norm)
             (ceiling t')
             (SigP.samples x)) x)


unzip ::
   SigI.T a q (v0, v1) -> Process.T q (SigI.T a q v0, SigI.T a q v1)
unzip = return . CutP.unzip

unzip3 ::
      SigI.T a q (v0, v1, v2)
   -> Process.T q (SigI.T a q v0, SigI.T a q v1, SigI.T a q v2)
unzip3 = return . CutP.unzip3



{- * glueing -}

{- |
  Similar to @foldr1 append@ but more efficient and accurate,
  because it reduces the number of amplifications.
  Does not work for infinite lists,
  because no maximum amplitude can be computed.
-}
concat :: (RealField.C q, Ord q, Ring.C q, OccScalar.C a q,
           Module.C a v) =>
   [SigI.T a q v] -> SigI.Process a q v
concat xs =
   mfix (\z ->
      do sampleRate <- Process.equalValues (map SigP.sampleRate xs)
         let ampExprs = List.map amplitudeExpr xs
         amplitude <- Process.fromExpr (Expr.maximum ampExprs)
         samps <- mapM (SigI.vectorSamples (toAmplitudeScalar z)) xs
         SigI.returnCons sampleRate amplitude
            (List.concat samps))

{-
This is the first one of several possible methods:

* Compute the maximum amplitude of the operands
  and amplify the other signal accordingly.
* Let the user specify an output volume.
* Expect a fixed output amplitude
  and amplify the inputs accordingly.
* Force input and output amplitudes to be equal.
  If this cannot be achieved,
  the user must insert amplifier processes.
-}
merge :: (Real.C q, Field.C q, Ord q, OccScalar.C a q,
         Module.C a v0, Module.C a v1) =>
   ([v0] -> [v1] -> [v2]) ->
   SigI.T a q v0 -> SigI.T a q v1 -> SigI.Process a q v2
merge f x y =
   mfix (\z ->
      do sampleRate <- Process.equalValues [SigP.sampleRate x, SigP.sampleRate y]
         amplitude  <- Process.fromExpr
                          (Expr.max (amplitudeExpr x) (amplitudeExpr  y))
         sampX <- SigI.vectorSamples (toAmplitudeScalar z) x
         sampY <- SigI.vectorSamples (toAmplitudeScalar z) y
         SigI.returnCons sampleRate amplitude
            (f sampX sampY))


append :: (Real.C q, Field.C q, Ord q, OccScalar.C a q,
         Module.C a v) =>
   SigI.T a q v -> SigI.T a q v -> SigI.Process a q v
append = merge (List.++)


zip :: (Real.C q, Field.C q, Ord q, OccScalar.C a q,
        Module.C a v0, Module.C a v1)
   => SigI.T a q v0
   -> SigI.T a q v1
   -> SigI.Process a q (v0, v1)
zip = merge List.zip

zip3 :: (Real.C q, Field.C q, Ord q, OccScalar.C a q,
         Module.C a v0, Module.C a v1, Module.C a v2)
   => SigI.T a q v0
   -> SigI.T a q v1
   -> SigI.T a q v2
   -> SigI.Process a q (v0, v1, v2)
zip3 x0 x1 x2 =
   mfix (\z ->
      do sampleRate <- Process.equalValues
            [SigP.sampleRate x0, SigP.sampleRate x1, SigP.sampleRate x2]
         amplitude  <- Process.fromExpr
            (Expr.maximum [amplitudeExpr x0, amplitudeExpr x1, amplitudeExpr x2])
         samp0 <- SigI.vectorSamples (toAmplitudeScalar z) x0
         samp1 <- SigI.vectorSamples (toAmplitudeScalar z) x1
         samp2 <- SigI.vectorSamples (toAmplitudeScalar z) x2
         SigI.returnCons sampleRate amplitude
            (List.zip3 samp0 samp1 samp2))


{- |
  Given a list of signals with time stamps,
  mix them into one signal as they occur in time.
  Ideally for composing music.
  Infinite schedules are not supported.
  Does not work for infinite lists,
  because no maximum amplitude can be computed.
-}
arrange :: (Field.C q, Ord q, OccScalar.C a q,
            RealFrac a, Module.C a v) =>
      q   {-^ Unit of the time values in the time ordered list. -}
   -> EventList.T a (SigI.T a q v)
          {-^ A list of pairs: (relative start time, signal part),
              The start time is relative
              to the start time of the previous event. -}
   -> SigI.Process a q v
          {-^ The mixed signal. -}
arrange unit sched =
   mfix (\z ->
      do let xs = EventList.getBodies sched
         sampleRate <- Process.equalValues
            (map SigP.sampleRate xs)
         unitRes <- SigI.toTimeScalar z (Expr.constant unit)
         let ampExprs = List.map amplitudeExpr xs
         amplitude <- Process.fromExpr (Expr.maximum ampExprs)
         schedRes <-
            EventList.mapBodyM
               (SigI.vectorSamples (toAmplitudeScalar z))
               (EventList.mapTime
                  (NonNeg.fromNumberMsg "Inference.Signal.Cut.arrange") sched)
         SigI.returnCons sampleRate amplitude
            (CutS.arrange
                (EventList.resample (NonNeg.fromNumber unitRes) schedRes)))