{- |
Copyright   :  (c) Henning Thielemann 2006, 2008
License     :  GPL

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes

Cut signals

-}
module Synthesizer.Physical.Cut where

import qualified Synthesizer.SampleRateContext.Cut as CutC
import qualified Synthesizer.SampleRateContext.Signal as SigC
import qualified Synthesizer.SampleRateContext.Rate   as Rate

import qualified Synthesizer.Physical.Signal as SigP

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 Data.Tuple.HT (mapSnd, )

import PreludeBase (Eq, Ord, Bool, uncurry, (.), (==), flip, fst, error)
-- import NumericPrelude

import Prelude (RealFrac)


{- * Dissection -}

splitAt :: (RealField.C t, Ring.C t', OccScalar.C t t') =>
   t' -> SigP.T t t' y y' yv -> (SigP.T t t' y y' yv, SigP.T t t' y y' yv)
splitAt t = SigP.liftR2 (CutC.splitAt t)

take :: (RealField.C t, Ring.C t', OccScalar.C t t') =>
   t' -> SigP.T t t' y y' yv -> SigP.T t t' y y' yv
take t = SigP.lift1 (CutC.take t)

drop :: (RealField.C t, Ring.C t', OccScalar.C t t') =>
   t' -> SigP.T t t' y y' yv -> SigP.T t t' y y' yv
drop t = SigP.lift1 (CutC.drop t)


propSplit :: (Eq t', Eq y', Eq yv,
              OccScalar.C t t', Ring.C t', RealField.C t) =>
   t' -> SigP.T t t' y y' yv -> Bool
propSplit t x =  splitAt t x == (take t x, drop t x)


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


unzip ::
   SigP.T t t' y y' (yv0, yv1) -> (SigP.T t t' y y' yv0, SigP.T t t' y y' yv1)
unzip = SigP.liftR2 CutC.unzip

unzip3 ::
      SigP.T t t' y y' (yv0, yv1, yv2)
   -> (SigP.T t t' y y' yv0, SigP.T t t' y y' yv1, SigP.T t t' y y' yv2)
unzip3 = SigP.liftR3 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 in this case a maximum amplitude cannot be computed.
-}
concat :: (Real.C y', Field.C y', Eq t', OccScalar.C y y',
           Module.C y yv) =>
      [SigP.T t t' y y' yv]
   ->  SigP.T t t' y y' yv
concat = SigP.liftList CutC.concat

{- |
  Like 'concat', but you have to specify the amplitude of the resulting signal.
  This way we can process infinite lists, too.
  The list must contain at least one element for getting a sample rate.
-}
concatVolume :: (Field.C y', Eq t', OccScalar.C y y',
              Module.C y yv) =>
       y'
   -> [SigP.T t t' y y' yv]
   ->  SigP.T t t' y y' yv
concatVolume amp = SigP.liftList (CutC.concatVolume amp)

append :: (Eq t', Real.C y', Field.C y', OccScalar.C y y',
         Module.C y yv) =>
   SigP.T t t' y y' yv -> SigP.T t t' y y' yv -> SigP.T t t' y y' yv
append = SigP.lift2 CutC.append


propConcatAppend :: (Eq t', Eq y', Eq yv,
                   Module.C y yv, OccScalar.C y y',
                   Ring.C t', RealField.C y') =>
      SigP.T t t' y y' yv
   -> SigP.T t t' y y' yv
   -> Bool
propConcatAppend x y =  append x y == concat [x,y]


propAppendSplit :: (Eq t', Eq y', Eq yv,
                    Module.C y yv, OccScalar.C y y',
                    RealField.C y', OccScalar.C t t',
                    Ring.C t', RealField.C t) =>
   t' -> SigP.T t t' y y' yv -> Bool
propAppendSplit t x =  uncurry append (splitAt t x) == x




zip :: (Eq t', Real.C y', Field.C y', OccScalar.C y y',
        Module.C y yv0, Module.C y yv1)
   => SigP.T t t' y y' yv0
   -> SigP.T t t' y y' yv1
   -> SigP.T t t' y y' (yv0, yv1)
zip = SigP.lift2 CutC.zip


zip3 :: (Eq t', Real.C y', Field.C y', OccScalar.C y y',
         Module.C y yv0, Module.C y yv1, Module.C y yv2)
   => SigP.T t t' y y' yv0
   -> SigP.T t t' y y' yv1
   -> SigP.T t t' y y' yv2
   -> SigP.T t t' y y' (yv0, yv1, yv2)
zip3 = SigP.lift3 CutC.zip3


propZip :: (Eq t', Eq y', Field.C y', Real.C y',
            Eq yv0, Eq yv1,
            Module.C y yv1, Module.C y yv0,
            OccScalar.C y y') =>
   SigP.T t t' y y' (yv0, yv1) -> Bool
propZip x =  uncurry zip (unzip x) == x

propZip3 :: (Eq t', Eq y', Field.C y', Real.C y',
             Eq yv0, Eq yv1, Eq yv2,
             Module.C y yv2, Module.C y yv1, Module.C y yv0,
             OccScalar.C y y') =>
   SigP.T t t' y y' (yv0, yv1, yv2) -> Bool
propZip3 x =  (\(a,b,c) -> zip3 a b c) (unzip3 x) == x


splitSampleRateEventList :: (Eq t') =>
      EventList.T time (SigP.T t t' y y' yv)
   -> (Rate.T t t', EventList.T time (SigC.T y y' yv))
splitSampleRateEventList xs =
   case EventList.getBodies xs of
      [] -> error "splitSampleRateEventList: empty list"
      (x:_) ->
         let sr = fst (SigP.splitSampleRate x)
         in  (sr, EventList.mapBody (SigP.checkSampleRate "splitSampleRateEventList" sr) xs)


{- |
  Given a list of signals with time stamps,
  mix them into one signal as they occur in time.
  Ideally for composing music.
  The amplitude of the output is designed for the worst case
  (all signals coincide).
  This is usually too pessimistic.
  Maybe you prefer 'arrangeVolume'.

  Infinite schedules are not supported,
  because no maximum amplitude can be computed.
  If you want infinite schedules,
  then 'arrangeVolume' is your friend, again.
-}
arrange ::
   (RealFrac t, NonNeg.C t, Eq t', Ring.C t, Ring.C t', OccScalar.C t 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. -}
   -> EventList.T t (SigP.T t 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. -}
   -> SigP.T t t' y y' yv
          {-^ The mixed signal. -}
arrange unit =
   uncurry SigP.run .
   mapSnd (flip (CutC.arrange unit)) .
   splitSampleRateEventList


{- |
  Similar to 'arrange' but allows for infinite schedules.
  To this end it needs the amplitude of the resulting signal.
-}
arrangeVolume ::
   (RealFrac t, NonNeg.C t, Eq t', Ring.C t, Ring.C t', OccScalar.C t t',
    Field.C y', OccScalar.C y y',
    Module.C y yv) =>
      y'  {-^ Amplitude of output. -}
   -> t'  {-^ Unit of the time values in the time ordered list. -}
   -> EventList.T t (SigP.T t 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. -}
   -> SigP.T t t' y y' yv
          {-^ The mixed signal. -}
arrangeVolume amp unit =
   uncurry SigP.run .
   mapSnd (flip (CutC.arrangeVolume amp unit)) .
   splitSampleRateEventList