Cut.hs

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

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes
-}
module Synthesizer.Dimensional.Amplitude.Cut (
   {- * dissection -}
   unzip,
   unzip3,
   leftFromStereo, rightFromStereo,

   {- * glueing -}
   concat,      concatVolume,
   append,      appendVolume,
   zip,         zipVolume,
   zip3,        zip3Volume,
   mergeStereo, mergeStereoVolume,
   selectBool,
  ) where

import qualified Synthesizer.Dimensional.Straight.Signal as SigS
import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA
import Synthesizer.Dimensional.Amplitude.Signal (toAmplitudeScalar)

import qualified Synthesizer.State.Signal  as Sig

import qualified Synthesizer.Frame.Stereo as Stereo

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

-- import Number.DimensionTerm ((&*&))

-- import qualified Algebra.NormedSpace.Maximum as NormedMax
import qualified Algebra.Module              as Module
import qualified Algebra.Field               as Field
-- import qualified Algebra.Ring                as Ring

import qualified Data.List as List

import PreludeBase (Ord, max, )
-- import NumericPrelude
import Prelude ()


{- * dissection -}

{-# INLINE unzip #-}
unzip :: (Dim.C u) =>
   SigA.R s u y (yv0, yv1) ->
   (SigA.R s u y yv0, SigA.R s u y yv1)
unzip x =
   let (ss0,ss1) = Sig.unzip (SigA.samples x)
   in  (SigA.replaceSamples ss0 x, SigA.replaceSamples ss1 x)

{-# INLINE unzip3 #-}
unzip3 :: (Dim.C u) =>
   SigA.R s u y (yv0, yv1, yv2) ->
   (SigA.R s u y yv0, SigA.R s u y yv1, SigA.R s u y yv2)
unzip3 x =
   let (ss0,ss1,ss2) = Sig.unzip3 (SigA.samples x)
   in  (SigA.replaceSamples ss0 x, SigA.replaceSamples ss1 x, SigA.replaceSamples ss2 x)


{-# INLINE leftFromStereo #-}
leftFromStereo :: (Dim.C u) =>
   SigA.R s u y (Stereo.T yv) -> SigA.R s u y yv
leftFromStereo = SigA.processSamples (Sig.map Stereo.left)

{-# INLINE rightFromStereo #-}
rightFromStereo :: (Dim.C u) =>
   SigA.R s u y (Stereo.T yv) -> SigA.R s u y yv
rightFromStereo = SigA.processSamples (Sig.map Stereo.right)



{- * 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.
-}
{-# INLINE concat #-}
concat ::
   (Ord y, Field.C y, Dim.C u,
    Module.C y yv) =>
   [SigA.R s u y yv] -> SigA.R s u y yv
concat xs =
   concatVolume (List.maximum (List.map SigA.amplitude xs)) xs

{- |
Give the output volume explicitly.
Does also work for infinite lists.
-}
{-# INLINE concatVolume #-}
concatVolume ::
   (Field.C y, Dim.C u,
    Module.C y yv) =>
   DN.T u y -> [SigA.R s u y yv] -> SigA.R s u y yv
concatVolume amp xs =
   let smps = List.map (SigA.vectorSamples (toAmplitudeScalar z)) xs
       z = SigA.fromSamples amp (Sig.concat smps)
   in  z


{-# INLINE merge #-}
merge ::
   (Ord y, Field.C y, Dim.C u,
    Module.C y yv0, Module.C y yv1) =>
   (Sig.T yv0 -> Sig.T yv1 -> Sig.T yv2) ->
   SigA.R s u y yv0 -> SigA.R s u y yv1 -> SigA.R s u y yv2
merge f x0 x1 =
   mergeVolume f (max (SigA.amplitude x0) (SigA.amplitude x1)) x0 x1

{-# INLINE mergeVolume #-}
mergeVolume ::
   (Field.C y, Dim.C u,
    Module.C y yv0, Module.C y yv1) =>
   (Sig.T yv0 -> Sig.T yv1 -> Sig.T yv2) ->
   DN.T u y ->
   SigA.R s u y yv0 -> SigA.R s u y yv1 -> SigA.R s u y yv2
mergeVolume f amp x y =
   let sampX = SigA.vectorSamples (toAmplitudeScalar z) x
       sampY = SigA.vectorSamples (toAmplitudeScalar z) y
       z = SigA.fromSamples amp (f sampX sampY)
   in  z


{-# INLINE append #-}
append ::
   (Ord y, Field.C y, Dim.C u,
    Module.C y yv) =>
   SigA.R s u y yv -> SigA.R s u y yv -> SigA.R s u y yv
append = merge Sig.append

{-# INLINE appendVolume #-}
appendVolume ::
   (Field.C y, Dim.C u,
    Module.C y yv) =>
   DN.T u y ->
   SigA.R s u y yv -> SigA.R s u y yv -> SigA.R s u y yv
appendVolume = mergeVolume Sig.append


{-# INLINE zip #-}
zip ::
   (Ord y, Field.C y, Dim.C u,
    Module.C y yv0, Module.C y yv1) =>
   SigA.R s u y yv0 -> SigA.R s u y yv1 -> SigA.R s u y (yv0,yv1)
zip = merge Sig.zip

{-# INLINE zipVolume #-}
zipVolume ::
   (Field.C y, Dim.C u,
    Module.C y yv0, Module.C y yv1) =>
   DN.T u y ->
   SigA.R s u y yv0 -> SigA.R s u y yv1 -> SigA.R s u y (yv0,yv1)
zipVolume = mergeVolume Sig.zip



{-# INLINE mergeStereo #-}
mergeStereo ::
   (Ord y, Field.C y, Dim.C u,
    Module.C y yv) =>
   SigA.R s u y yv -> SigA.R s u y yv -> SigA.R s u y (Stereo.T yv)
mergeStereo = merge (Sig.zipWith Stereo.cons)

{-# INLINE mergeStereoVolume #-}
mergeStereoVolume ::
   (Field.C y, Dim.C u,
    Module.C y yv) =>
   DN.T u y ->
   SigA.R s u y yv -> SigA.R s u y yv -> SigA.R s u y (Stereo.T yv)
mergeStereoVolume = mergeVolume (Sig.zipWith Stereo.cons)



{-# INLINE zip3 #-}
zip3 ::
   (Ord y, Field.C y, Dim.C u,
    Module.C y yv0, Module.C y yv1, Module.C y yv2) =>
   SigA.R s u y yv0 -> SigA.R s u y yv1 -> SigA.R s u y yv2 ->
   SigA.R s u y (yv0,yv1,yv2)
zip3 x0 x1 x2 =
   zip3Volume
      (SigA.amplitude x0 `max` SigA.amplitude x1 `max` SigA.amplitude x2)
      x0 x1 x2

{-# INLINE zip3Volume #-}
zip3Volume ::
   (Field.C y, Dim.C u,
    Module.C y yv0, Module.C y yv1, Module.C y yv2) =>
   DN.T u y ->
   SigA.R s u y yv0 -> SigA.R s u y yv1 -> SigA.R s u y yv2 ->
   SigA.R s u y (yv0,yv1,yv2)
zip3Volume amp x0 x1 x2 =
   let sampX0 = SigA.vectorSamples (toAmplitudeScalar z) x0
       sampX1 = SigA.vectorSamples (toAmplitudeScalar z) x1
       sampX2 = SigA.vectorSamples (toAmplitudeScalar z) x2
       z = SigA.fromSamples amp (Sig.zip3 sampX0 sampX1 sampX2)
   in  z


{-# INLINE selectBool #-}
selectBool ::
   (Ord y, Field.C y, Dim.C u,
    Module.C y yv) =>
   SigA.R s u y yv {- ^ False -} ->
   SigA.R s u y yv {- ^ True -} ->
   SigS.Binary s ->
   SigA.R s u y yv
selectBool xf xt cs =
   SigA.processSamples
      (Sig.zipWith (\c (xfi,xti) -> if c then xti else xfi) (SigS.toSamples cs))
      (zip xf xt)