{-# LANGUAGE NoImplicitPrelude #-}
{- |
Construction of a data type that describes piecewise defined curves.
-}
module Synthesizer.Piecewise where

import Data.Ix (Ix, )

import qualified Algebra.RealRing as RealRing

import NumericPrelude.Numeric
import NumericPrelude.Base


{-
ToDo:
Make it a new data type with Monoid and Generic.Cut instances.
However there is no fast and generic way for splitting a piece.
-}
type T t y sig = [PieceData t y sig]

{- |
The curve type of a piece of a piecewise defined control curve.
-}
newtype Piece t y sig =
   Piece {forall t y sig. Piece t y sig -> y -> y -> t -> sig
computePiece :: y  {- y0 -}
                       -> y  {- y1 -}
                       -> t  {- duration -}
                       -> sig}

pieceFromFunction :: (y -> y -> t -> sig) -> Piece t y sig
pieceFromFunction :: forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
pieceFromFunction = (y -> y -> t -> sig) -> Piece t y sig
forall t y sig. (y -> y -> t -> sig) -> Piece t y sig
Piece


{- |
The full description of a control curve piece.
-}
data PieceData t y sig =
     PieceData {forall t y sig. PieceData t y sig -> Piece t y sig
pieceType :: Piece t y sig,
                forall t y sig. PieceData t y sig -> y
pieceY0 :: y,
                forall t y sig. PieceData t y sig -> y
pieceY1 :: y,
                forall t y sig. PieceData t y sig -> t
pieceDur :: t}
--   deriving (Eq, Show)


newtype PieceRightSingle y = PRS y
newtype PieceRightDouble y = PRD y

data PieceDist t y sig = PD t (Piece t y sig) y


-- precedence and associativity like (:)
infixr 5 -|#, #|-, =|#, #|=, |#, #|

{- |
The 6 operators simplify constructing a list of @PieceData a@.
The description consists of nodes (namely the curve values at nodes)
and the connecting curve types.
The naming scheme is as follows:
In the middle there is a bar @|@.
With respect to the bar,
the pad symbol @\#@ is at the side of the curve type,
at the other side there is nothing, a minus sign @-@, or an equality sign @=@.

 (1) Nothing means that here is the start or the end node of a curve.

 (2) Minus means that here is a node where left and right curve meet at the same value.
     The node description is thus one value.

 (3) Equality sign means that here is a split node,
     where left and right curve might have different ending and beginning values, respectively.
     The node description consists of a pair of values.
-}

-- the leading space is necessary for the Haddock parser

( #|-) :: (t, Piece t y sig) -> (PieceRightSingle y, T t y sig) ->
   (PieceDist t y sig, T t y sig)
(t
d,Piece t y sig
c) #|- :: forall t y sig.
(t, Piece t y sig)
-> (PieceRightSingle y, T t y sig)
-> (PieceDist t y sig, T t y sig)
#|- (PRS y
y1, T t y sig
xs)  =  (t -> Piece t y sig -> y -> PieceDist t y sig
forall t y sig. t -> Piece t y sig -> y -> PieceDist t y sig
PD t
d Piece t y sig
c y
y1, T t y sig
xs)

(-|#) :: y -> (PieceDist t y sig, T t y sig) ->
   (PieceRightSingle y, T t y sig)
y
y0 -|# :: forall y t sig.
y
-> (PieceDist t y sig, T t y sig)
-> (PieceRightSingle y, T t y sig)
-|# (PD t
d Piece t y sig
c y
y1, T t y sig
xs)  =  (y -> PieceRightSingle y
forall y. y -> PieceRightSingle y
PRS y
y0, Piece t y sig -> y -> y -> t -> PieceData t y sig
forall t y sig. Piece t y sig -> y -> y -> t -> PieceData t y sig
PieceData Piece t y sig
c y
y0 y
y1 t
d PieceData t y sig -> T t y sig -> T t y sig
forall a. a -> [a] -> [a]
: T t y sig
xs)

( #|=) :: (t, Piece t y sig) -> (PieceRightDouble y, T t y sig) ->
   (PieceDist t y sig, T t y sig)
(t
d,Piece t y sig
c) #|= :: forall t y sig.
(t, Piece t y sig)
-> (PieceRightDouble y, T t y sig)
-> (PieceDist t y sig, T t y sig)
#|= (PRD y
y1, T t y sig
xs)  =  (t -> Piece t y sig -> y -> PieceDist t y sig
forall t y sig. t -> Piece t y sig -> y -> PieceDist t y sig
PD t
d Piece t y sig
c y
y1, T t y sig
xs)

(=|#) :: (y,y) -> (PieceDist t y sig, T t y sig) ->
   (PieceRightDouble y, T t y sig)
(y
y01,y
y10) =|# :: forall y t sig.
(y, y)
-> (PieceDist t y sig, T t y sig)
-> (PieceRightDouble y, T t y sig)
=|# (PD t
d Piece t y sig
c y
y11, T t y sig
xs)  =  (y -> PieceRightDouble y
forall y. y -> PieceRightDouble y
PRD y
y01, Piece t y sig -> y -> y -> t -> PieceData t y sig
forall t y sig. Piece t y sig -> y -> y -> t -> PieceData t y sig
PieceData Piece t y sig
c y
y10 y
y11 t
d PieceData t y sig -> T t y sig -> T t y sig
forall a. a -> [a] -> [a]
: T t y sig
xs)

( #|) :: (t, Piece t y sig) -> y ->
   (PieceDist t y sig, T t y sig)
(t
d,Piece t y sig
c) #| :: forall t y sig.
(t, Piece t y sig) -> y -> (PieceDist t y sig, T t y sig)
#| y
y1  =  (t -> Piece t y sig -> y -> PieceDist t y sig
forall t y sig. t -> Piece t y sig -> y -> PieceDist t y sig
PD t
d Piece t y sig
c y
y1, [])

(|#) :: y -> (PieceDist t y sig, T t y sig) ->
   T t y sig
y
y0 |# :: forall y t sig. y -> (PieceDist t y sig, T t y sig) -> T t y sig
|# (PD t
d Piece t y sig
c y
y1, T t y sig
xs)  =  Piece t y sig -> y -> y -> t -> PieceData t y sig
forall t y sig. Piece t y sig -> y -> y -> t -> PieceData t y sig
PieceData Piece t y sig
c y
y0 y
y1 t
d PieceData t y sig -> T t y sig -> T t y sig
forall a. a -> [a] -> [a]
: T t y sig
xs


data FlatPosition = FlatLeft | FlatRight
   deriving (Int -> FlatPosition -> ShowS
[FlatPosition] -> ShowS
FlatPosition -> String
(Int -> FlatPosition -> ShowS)
-> (FlatPosition -> String)
-> ([FlatPosition] -> ShowS)
-> Show FlatPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FlatPosition -> ShowS
showsPrec :: Int -> FlatPosition -> ShowS
$cshow :: FlatPosition -> String
show :: FlatPosition -> String
$cshowList :: [FlatPosition] -> ShowS
showList :: [FlatPosition] -> ShowS
Show, FlatPosition -> FlatPosition -> Bool
(FlatPosition -> FlatPosition -> Bool)
-> (FlatPosition -> FlatPosition -> Bool) -> Eq FlatPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FlatPosition -> FlatPosition -> Bool
== :: FlatPosition -> FlatPosition -> Bool
$c/= :: FlatPosition -> FlatPosition -> Bool
/= :: FlatPosition -> FlatPosition -> Bool
Eq, Eq FlatPosition
Eq FlatPosition =>
(FlatPosition -> FlatPosition -> Ordering)
-> (FlatPosition -> FlatPosition -> Bool)
-> (FlatPosition -> FlatPosition -> Bool)
-> (FlatPosition -> FlatPosition -> Bool)
-> (FlatPosition -> FlatPosition -> Bool)
-> (FlatPosition -> FlatPosition -> FlatPosition)
-> (FlatPosition -> FlatPosition -> FlatPosition)
-> Ord FlatPosition
FlatPosition -> FlatPosition -> Bool
FlatPosition -> FlatPosition -> Ordering
FlatPosition -> FlatPosition -> FlatPosition
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FlatPosition -> FlatPosition -> Ordering
compare :: FlatPosition -> FlatPosition -> Ordering
$c< :: FlatPosition -> FlatPosition -> Bool
< :: FlatPosition -> FlatPosition -> Bool
$c<= :: FlatPosition -> FlatPosition -> Bool
<= :: FlatPosition -> FlatPosition -> Bool
$c> :: FlatPosition -> FlatPosition -> Bool
> :: FlatPosition -> FlatPosition -> Bool
$c>= :: FlatPosition -> FlatPosition -> Bool
>= :: FlatPosition -> FlatPosition -> Bool
$cmax :: FlatPosition -> FlatPosition -> FlatPosition
max :: FlatPosition -> FlatPosition -> FlatPosition
$cmin :: FlatPosition -> FlatPosition -> FlatPosition
min :: FlatPosition -> FlatPosition -> FlatPosition
Ord, Ord FlatPosition
Ord FlatPosition =>
((FlatPosition, FlatPosition) -> [FlatPosition])
-> ((FlatPosition, FlatPosition) -> FlatPosition -> Int)
-> ((FlatPosition, FlatPosition) -> FlatPosition -> Int)
-> ((FlatPosition, FlatPosition) -> FlatPosition -> Bool)
-> ((FlatPosition, FlatPosition) -> Int)
-> ((FlatPosition, FlatPosition) -> Int)
-> Ix FlatPosition
(FlatPosition, FlatPosition) -> Int
(FlatPosition, FlatPosition) -> [FlatPosition]
(FlatPosition, FlatPosition) -> FlatPosition -> Bool
(FlatPosition, FlatPosition) -> FlatPosition -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (FlatPosition, FlatPosition) -> [FlatPosition]
range :: (FlatPosition, FlatPosition) -> [FlatPosition]
$cindex :: (FlatPosition, FlatPosition) -> FlatPosition -> Int
index :: (FlatPosition, FlatPosition) -> FlatPosition -> Int
$cunsafeIndex :: (FlatPosition, FlatPosition) -> FlatPosition -> Int
unsafeIndex :: (FlatPosition, FlatPosition) -> FlatPosition -> Int
$cinRange :: (FlatPosition, FlatPosition) -> FlatPosition -> Bool
inRange :: (FlatPosition, FlatPosition) -> FlatPosition -> Bool
$crangeSize :: (FlatPosition, FlatPosition) -> Int
rangeSize :: (FlatPosition, FlatPosition) -> Int
$cunsafeRangeSize :: (FlatPosition, FlatPosition) -> Int
unsafeRangeSize :: (FlatPosition, FlatPosition) -> Int
Ix, Int -> FlatPosition
FlatPosition -> Int
FlatPosition -> [FlatPosition]
FlatPosition -> FlatPosition
FlatPosition -> FlatPosition -> [FlatPosition]
FlatPosition -> FlatPosition -> FlatPosition -> [FlatPosition]
(FlatPosition -> FlatPosition)
-> (FlatPosition -> FlatPosition)
-> (Int -> FlatPosition)
-> (FlatPosition -> Int)
-> (FlatPosition -> [FlatPosition])
-> (FlatPosition -> FlatPosition -> [FlatPosition])
-> (FlatPosition -> FlatPosition -> [FlatPosition])
-> (FlatPosition -> FlatPosition -> FlatPosition -> [FlatPosition])
-> Enum FlatPosition
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: FlatPosition -> FlatPosition
succ :: FlatPosition -> FlatPosition
$cpred :: FlatPosition -> FlatPosition
pred :: FlatPosition -> FlatPosition
$ctoEnum :: Int -> FlatPosition
toEnum :: Int -> FlatPosition
$cfromEnum :: FlatPosition -> Int
fromEnum :: FlatPosition -> Int
$cenumFrom :: FlatPosition -> [FlatPosition]
enumFrom :: FlatPosition -> [FlatPosition]
$cenumFromThen :: FlatPosition -> FlatPosition -> [FlatPosition]
enumFromThen :: FlatPosition -> FlatPosition -> [FlatPosition]
$cenumFromTo :: FlatPosition -> FlatPosition -> [FlatPosition]
enumFromTo :: FlatPosition -> FlatPosition -> [FlatPosition]
$cenumFromThenTo :: FlatPosition -> FlatPosition -> FlatPosition -> [FlatPosition]
enumFromThenTo :: FlatPosition -> FlatPosition -> FlatPosition -> [FlatPosition]
Enum)

splitDurations :: (RealRing.C t) => [t] -> [(Int, t)]
splitDurations :: forall t. C t => [t] -> [(Int, t)]
splitDurations [t]
ts0 =
   let ([Int]
ds,[t]
ts) =
           [(Int, t)] -> ([Int], [t])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Int, t)] -> ([Int], [t])) -> [(Int, t)] -> ([Int], [t])
forall a b. (a -> b) -> a -> b
$ ((Int, t) -> t -> (Int, t)) -> (Int, t) -> [t] -> [(Int, t)]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl
              (\(Int
_,t
fr) t
d -> t -> (Int, t)
forall b. C b => t -> (b, t)
forall a b. (C a, C b) => a -> (b, a)
RealRing.splitFraction (t
frt -> t -> t
forall a. C a => a -> a -> a
+t
d))
              (Int
0,t
1) [t]
ts0
   in  [Int] -> [t] -> [(Int, t)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int] -> [Int]
forall a. HasCallStack => [a] -> [a]
tail [Int]
ds) ((t -> t) -> [t] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (t -> t -> t
forall a. C a => a -> a -> a
subtract t
1) [t]
ts)