synthesizer-dimensional-0.2: src/Synthesizer/Dimensional/RateAmplitude/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.RateAmplitude.Cut (
{- * dissection -}
splitAt,
take,
drop,
takeUntilPause,
unzip,
unzip3,
leftFromStereo, rightFromStereo,
{- * glueing -}
concat, concatVolume,
append, appendVolume,
zip, zipVolume,
zip3, zip3Volume,
mergeStereo, mergeStereoVolume,
arrange, arrangeVolume,
) where
import qualified Synthesizer.Dimensional.Amplitude.Cut as CutV
import qualified Synthesizer.Dimensional.Rate.Cut as CutR
import qualified Synthesizer.State.Cut as CutS
import qualified Synthesizer.State.Signal as Sig
import qualified Synthesizer.Frame.Stereo as Stereo
import Foreign.Storable (Storable, )
import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA
import qualified Synthesizer.Dimensional.Process as Proc
import Synthesizer.Dimensional.Process (($#))
import Synthesizer.Dimensional.RateAmplitude.Signal
(toTimeScalar, toAmplitudeScalar)
import qualified Number.DimensionTerm as DN
import qualified Algebra.DimensionTerm as Dim
-- import Number.DimensionTerm ((&*&))
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.Module as Module
import qualified Algebra.RealField as RealField
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import qualified Data.List as List
import PreludeBase ((.), ($), Ord, (<=), map, return, )
-- import NumericPrelude
import Prelude (RealFrac)
{- * dissection -}
{-# INLINE splitAt #-}
splitAt :: (RealField.C t, Dim.C u, Dim.C v, Storable yv) =>
DN.T u t -> Proc.T s u t (SigA.R s v y yv -> (SigA.R s v y yv, SigA.R s v y yv))
splitAt t' =
do t <- toTimeScalar t'
return $ \x ->
let (ss0,ss1) = Sig.splitAt (RealField.round t) (SigA.samples x)
in (SigA.replaceSamples ss0 x,
SigA.replaceSamples ss1 x)
{-# INLINE take #-}
take :: (RealField.C t, Dim.C u, Dim.C v) =>
DN.T u t -> Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv)
take t' =
CutR.take t'
-- fmap (fst.) $ splitAt t
{-
do t <- toTimeScalar t'
return $ SigA.processSamples (Sig.take (RealField.round t))
-}
{-# INLINE drop #-}
drop :: (RealField.C t, Dim.C u, Dim.C v) =>
DN.T u t -> Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv)
drop t' =
CutR.drop t'
-- fmap (snd.) $ splitAt t
{-
do t <- toTimeScalar t'
return $ SigA.processSamples (Sig.drop (RealField.round t))
-}
{-# INLINE takeUntilPause #-}
takeUntilPause ::
(RealField.C t, Dim.C u,
Field.C y, NormedMax.C y yv, Dim.C v) =>
DN.T v y -> DN.T u t -> Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv)
takeUntilPause y' t' =
do t <- toTimeScalar t'
return $ \x ->
let y = toAmplitudeScalar x y'
in SigA.processSamples
(CutS.takeUntilInterval ((<=y) . NormedMax.norm)
(RealField.ceiling t)) x
{-# INLINE unzip #-}
unzip :: (Dim.C u, Dim.C v) =>
Proc.T s u t
(SigA.R s v y (yv0, yv1) ->
(SigA.R s v y yv0, SigA.R s v y yv1))
unzip = Proc.pure CutV.unzip
{-# INLINE unzip3 #-}
unzip3 :: (Dim.C u, Dim.C v) =>
Proc.T s u t
(SigA.R s v y (yv0, yv1, yv2) ->
(SigA.R s v y yv0, SigA.R s v y yv1, SigA.R s v y yv2))
unzip3 = Proc.pure CutV.unzip3
{-# INLINE leftFromStereo #-}
leftFromStereo :: (Dim.C u) =>
Proc.T s u t
(SigA.R s u y (Stereo.T yv) -> SigA.R s u y yv)
leftFromStereo = Proc.pure CutV.leftFromStereo
{-# INLINE rightFromStereo #-}
rightFromStereo :: (Dim.C u) =>
Proc.T s u t
(SigA.R s u y (Stereo.T yv) -> SigA.R s u y yv)
rightFromStereo = Proc.pure CutV.rightFromStereo
{- * 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 v,
Module.C y yv) =>
Proc.T s u t ([SigA.R s v y yv] -> SigA.R s v y yv)
concat = Proc.pure $ CutV.concat
{- |
Give the output volume explicitly.
Does also work for infinite lists.
-}
{-# INLINE concatVolume #-}
concatVolume ::
(Field.C y, Dim.C v,
Module.C y yv) =>
DN.T v y -> Proc.T s u t ([SigA.R s v y yv] -> SigA.R s v y yv)
concatVolume amp = Proc.pure $ CutV.concatVolume amp
{-# INLINE append #-}
append ::
(Ord y, Field.C y, Dim.C v,
Module.C y yv) =>
Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv -> SigA.R s v y yv)
append = Proc.pure $ CutV.append
{-# INLINE appendVolume #-}
appendVolume ::
(Field.C y, Dim.C v,
Module.C y yv) =>
DN.T v y ->
Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv -> SigA.R s v y yv)
appendVolume amp = Proc.pure $ CutV.appendVolume amp
{-# INLINE zip #-}
zip ::
(Ord y, Field.C y, Dim.C v,
Module.C y yv0, Module.C y yv1) =>
Proc.T s u t (SigA.R s v y yv0 -> SigA.R s v y yv1 -> SigA.R s v y (yv0,yv1))
zip = Proc.pure $ CutV.zip
{-# INLINE zipVolume #-}
zipVolume ::
(Field.C y, Dim.C v,
Module.C y yv0, Module.C y yv1) =>
DN.T v y ->
Proc.T s u t (SigA.R s v y yv0 -> SigA.R s v y yv1 -> SigA.R s v y (yv0,yv1))
zipVolume amp = Proc.pure $ CutV.zipVolume amp
{-# INLINE mergeStereo #-}
mergeStereo ::
(Ord y, Field.C y, Dim.C v,
Module.C y yv) =>
Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv -> SigA.R s v y (Stereo.T yv))
mergeStereo = Proc.pure $ CutV.mergeStereo
{-# INLINE mergeStereoVolume #-}
mergeStereoVolume ::
(Field.C y, Dim.C v,
Module.C y yv) =>
DN.T v y ->
Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv -> SigA.R s v y (Stereo.T yv))
mergeStereoVolume amp = Proc.pure $ CutV.mergeStereoVolume amp
{-# INLINE zip3 #-}
zip3 ::
(Ord y, Field.C y, Dim.C v,
Module.C y yv0, Module.C y yv1, Module.C y yv2) =>
Proc.T s u t (
SigA.R s v y yv0 -> SigA.R s v y yv1 -> SigA.R s v y yv2 ->
SigA.R s v y (yv0,yv1,yv2))
zip3 = Proc.pure $ CutV.zip3
{-# INLINE zip3Volume #-}
zip3Volume ::
(Field.C y, Dim.C v,
Module.C y yv0, Module.C y yv1, Module.C y yv2) =>
DN.T v y ->
Proc.T s u t (
SigA.R s v y yv0 -> SigA.R s v y yv1 -> SigA.R s v y yv2 ->
SigA.R s v y (yv0,yv1,yv2))
zip3Volume amp = Proc.pure $ CutV.zip3Volume amp
{- |
Uses maximum input volume as output volume.
-}
{-# INLINE arrange #-}
arrange ::
(Ring.C t, Dim.C u,
RealFrac t, NonNeg.C t,
Ord y, Field.C y, Dim.C v,
Module.C y yv) =>
DN.T u t {-^ Dim of the time values in the time ordered list. -}
-> Proc.T s u t (
EventList.T t (SigA.R s v y yv)
{- v A list of pairs: (relative start time, signal part),
The start time is relative
to the start time of the previous event. -}
-> SigA.R s v y yv)
{- ^ The mixed signal. -}
arrange unit' =
Proc.withParam $ \sched ->
let amp = List.maximum (map SigA.amplitude (EventList.getBodies sched))
in arrangeVolume amp unit' $# sched
{- |
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.
-}
{-# INLINE arrangeVolume #-}
arrangeVolume ::
(Ring.C t, Dim.C u,
RealFrac t, NonNeg.C t,
Field.C y, Dim.C v,
Module.C y yv) =>
DN.T v y {- ^ Output volume. -}
-> DN.T u t {- ^ Dim of the time values in the time ordered list. -}
-> Proc.T s u t (
EventList.T t (SigA.R s v y yv)
{- v A list of pairs: (relative start time, signal part),
The start time is relative
to the start time of the previous event. -}
-> SigA.R s v y yv)
{- ^ The mixed signal. -}
arrangeVolume amp unit' =
do unit <- toTimeScalar unit'
return $ \sched' ->
let sched =
EventList.mapBody (SigA.vectorSamples (toAmplitudeScalar z)) sched'
z = SigA.fromSamples amp
(CutS.arrange (EventList.resample unit sched))
in z