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

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes
-}
module Synthesizer.Plain.Cut (
   {- * dissection -}
   takeUntilPause,
   takeUntilInterval,

   {- * glueing -}
   selectBool,
   select,
   arrange,
   ) where

import qualified Synthesizer.Plain.Signal as Sig

import qualified Data.EventList.Relative.TimeBody as EventList

import Data.Array (Array, Ix, (!))

import qualified MathObj.LaurentPolynomial as Laurent
import qualified Algebra.RealRing as RealRing
import qualified Algebra.Additive as Additive

import qualified Number.NonNegative as NonNeg

import NumericPrelude.Numeric
import NumericPrelude.Base



{- |
Take signal until it falls short of a certain amplitude for a given time.
-}
takeUntilPause :: (RealRing.C a) => a -> Int -> Sig.T a -> Sig.T a
takeUntilPause :: forall a. C a => a -> Int -> T a -> T a
takeUntilPause a
y =
   forall a. (a -> Bool) -> Int -> T a -> T a
takeUntilInterval ((forall a. Ord a => a -> a -> Bool
<=a
y) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. C a => a -> a
abs)

{- |
Take values until the predicate p holds for n successive values.
The list is truncated at the beginning of the interval of matching values.
-}
takeUntilInterval :: (a -> Bool) -> Int -> Sig.T a -> Sig.T a
takeUntilInterval :: forall a. (a -> Bool) -> Int -> T a -> T a
takeUntilInterval a -> Bool
p Int
n T a
xs =
   forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$
   forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((forall a. Ord a => a -> a -> Bool
<Int
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
   forall a b. [a] -> [b] -> [(a, b)]
zip T a
xs forall a b. (a -> b) -> a -> b
$
   forall a. Int -> [a] -> [a]
drop Int
n forall a b. (a -> b) -> a -> b
$
   forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\Int
acc a
x -> if a -> Bool
p a
x then forall a. Enum a => a -> a
succ Int
acc else Int
0) Int
0 T a
xs
      forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Int
0



-- Better use zipWithMatch from NumericPrelude.Numeric?
selectBool :: (Sig.T a, Sig.T a) -> Sig.T Bool -> Sig.T a
selectBool :: forall a. (T a, T a) -> T Bool -> T a
selectBool =
   forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\a
xf a
xt Bool
c -> if Bool
c then a
xt else a
xf))
{-
   zipWithMatch (\(xf,xt) c -> if c then xt else xf) .
   uncurry (zipWithMatch (,))
-}


select :: Ix i => Array i (Sig.T a) -> Sig.T i -> Sig.T a
select :: forall i a. Ix i => Array i (T a) -> T i -> T a
select Array i (T a)
arr =
   forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall i e. Ix i => Array i e -> i -> e
(!)
      (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> a
head) forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> [a]
tail) Array i (T a)
arr)



{- |
Given a list of signals with time stamps,
mix them into one signal as they occur in time.
Ideally for composing music.

Cf. 'MathObj.LaurentPolynomial.series'
-}
arrange :: (Additive.C v) =>
       EventList.T NonNeg.Int (Sig.T v)
            {-^ A list of pairs: (relative start time, signal part),
                The start time is relative to the start time
                of the previous event. -}
    -> Sig.T v
            {-^ The mixed signal. -}
arrange :: forall v. C v => T Int (T v) -> T v
arrange T Int (T v)
evs =
   let xs :: [T v]
xs = forall time body. T time body -> [body]
EventList.getBodies T Int (T v)
evs
   in  case forall a b. (a -> b) -> [a] -> [b]
map forall a. T a -> a
NonNeg.toNumber (forall time body. T time body -> [time]
EventList.getTimes T Int (T v)
evs) of
          Int
t:[Int]
ts -> forall a. Int -> a -> [a]
replicate Int
t forall a. C a => a
zero forall a. [a] -> [a] -> [a]
++ forall a. C a => [Int] -> [[a]] -> [a]
Laurent.addShiftedMany [Int]
ts [T v]
xs
          []   -> []