Cut.hs

{-# OPTIONS -fno-implicit-prelude #-}
{- |
Copyright   :  (c) Henning Thielemann 2006
License     :  GPL

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

   {- * glueing -}
   concat,   concatVolume,
   append,   appendVolume,
   zip,      zipVolume,
   zip3,     zip3Volume,
   arrange,  arrangeVolume,
  ) where

import qualified Synthesizer.SampleRateContext.Cut as CutC

import qualified Synthesizer.Inference.Reader.Signal as SigR
import qualified Synthesizer.Inference.Reader.Process as Proc

import qualified Data.EventList.Relative.TimeBody as EventList
import qualified Numeric.NonNegative.Class as NonNeg

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.List as List

import PreludeBase ((.), Ord)
-- import NumericPrelude
import Prelude (RealFrac)


{- * dissection -}

splitAt :: (RealField.C t, Field.C t', OccScalar.C t t') =>
   t' -> Proc.T t t' (SigR.T y y' yv -> (SigR.T y y' yv, SigR.T y y' yv))
splitAt t = SigR.lift (CutC.splitAt t)

take :: (RealField.C t, Field.C t', OccScalar.C t t') =>
   t' -> Proc.T t t' (SigR.T y y' yv -> SigR.T y y' yv)
take t = SigR.lift (CutC.take t)

drop :: (RealField.C t, Field.C t', OccScalar.C t t') =>
   t' -> Proc.T t t' (SigR.T y y' yv -> SigR.T y y' yv)
drop t = SigR.lift (CutC.drop t)

takeUntilPause ::
  (RealField.C t, Ring.C t', OccScalar.C t t',
   Field.C y', NormedMax.C y yv, OccScalar.C y y') =>
   y' -> t' -> Proc.T t t' (SigR.T y y' yv -> SigR.T y y' yv)
takeUntilPause y' t' = SigR.lift (CutC.takeUntilPause y' t')


unzip ::
   Proc.T t t'
      (SigR.T y y' (yv0, yv1) ->
         (SigR.T y y' yv0, SigR.T y y' yv1))
unzip = SigR.lift CutC.unzip

unzip3 ::
   Proc.T t t'
      (SigR.T y y' (yv0, yv1, yv2) ->
         (SigR.T y y' yv0, SigR.T y y' yv1, SigR.T y y' yv2))
unzip3 = SigR.lift CutC.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 ::
   (Real.C y, Ord y', Field.C y', OccScalar.C y y',
    Module.C y yv) =>
   Proc.T t t' ([SigR.T y y' yv] -> SigR.T y y' yv)
concat = SigR.lift CutC.concat

{- |
Give the output volume explicitly.
Does also work for infinite lists.
-}
concatVolume ::
   (Field.C y', OccScalar.C y y',
    Module.C y yv) =>
   y' -> Proc.T t t' ([SigR.T y y' yv] -> SigR.T y y' yv)
concatVolume = SigR.lift . CutC.concatVolume


append ::
   (Real.C y, Ord y', Field.C y', OccScalar.C y y',
    Module.C y yv) =>
   Proc.T t t' (SigR.T y y' yv -> SigR.T y y' yv -> SigR.T y y' yv)
append = SigR.lift CutC.append

appendVolume ::
   (Field.C y', OccScalar.C y y',
    Module.C y yv) =>
   y' ->
   Proc.T t t' (SigR.T y y' yv -> SigR.T y y' yv -> SigR.T y y' yv)
appendVolume = SigR.lift . CutC.appendVolume


zip ::
   (Real.C y, Ord y', Field.C y', OccScalar.C y y',
    Module.C y yv0, Module.C y yv1) =>
   Proc.T t t' (SigR.T y y' yv0 -> SigR.T y y' yv1 -> SigR.T y y' (yv0,yv1))
zip = SigR.lift CutC.zip

zipVolume ::
   (Field.C y', OccScalar.C y y',
    Module.C y yv0, Module.C y yv1) =>
   y' ->
   Proc.T t t' (SigR.T y y' yv0 -> SigR.T y y' yv1 -> SigR.T y y' (yv0,yv1))
zipVolume = SigR.lift . CutC.zipVolume


zip3 ::
   (Real.C y, Ord y', Field.C y', OccScalar.C y y',
    Module.C y yv0, Module.C y yv1, Module.C y yv2) =>
   Proc.T t t' (SigR.T y y' yv0 -> SigR.T y y' yv1 -> SigR.T y y' yv2 ->
                 SigR.T y y' (yv0,yv1,yv2))
zip3 = SigR.lift CutC.zip3

zip3Volume ::
   (Field.C y', OccScalar.C y y',
    Module.C y yv0, Module.C y yv1, Module.C y yv2) =>
   y' ->
   Proc.T t t' (SigR.T y y' yv0 -> SigR.T y y' yv1 -> SigR.T y y' yv2 ->
                 SigR.T y y' (yv0,yv1,yv2))
zip3Volume = SigR.lift . CutC.zip3Volume


{- |
Uses maximum input volume as output volume.
-}
arrange ::
   (Ring.C t', OccScalar.C t t',
    RealFrac t, NonNeg.C t,
    Ord y', Field.C y', OccScalar.C y y',
    Module.C y yv) =>
      t'  {-^ Unit of the time values in the time ordered list. -}
   -> Proc.T t t'
        (EventList.T t (SigR.T y y' yv)
             {-  A list of pairs: (relative start time, signal part),
                 The start time is relative
                 to the start time of the previous event. -}
         -> SigR.T y y' yv
             {-  The mixed signal. -} )
arrange = SigR.lift . CutC.arrange


{- |
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.
-}
arrangeVolume ::
   (Ring.C t', OccScalar.C t t',
    RealFrac t, NonNeg.C t,
    Field.C y', OccScalar.C y y',
    Module.C y yv) =>
      y'  {-^ Output volume. -}
   -> t'  {-^ Unit of the time values in the time ordered list. -}
   -> Proc.T t t'
        (EventList.T t (SigR.T y y' yv)
             {-  A list of pairs: (relative start time, signal part),
                 The start time is relative
                 to the start time of the previous event. -}
         -> SigR.T y y' yv
             {-  The mixed signal. -} )
arrangeVolume amp = SigR.lift . CutC.arrangeVolume amp