-- Copyright 2018 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | This is a piecewise-constant signal, with a subset of the TimeVector
-- operations, as used by "Perform.Midi.Perform".
--
-- Unlike the signals built on "Util.Segment', this signal shouldn't have
-- samples with the same 'X'.
module Perform.Midi.MSignal (
    module Perform.Midi.MSignal, module Util.TimeVector
) where
import Prelude hiding (head, last)
import qualified Util.Num as Num
import qualified Util.TimeVector as TimeVector
import Util.TimeVector
       (Sample(..), constant, drop_before, drop_at_after, within, map_y,
        map_err)

import qualified Midi.Midi as Midi
import Global
import Types


type Signal = TimeVector.Unboxed
type Y = TimeVector.UnboxedY
type X = RealTime


-- * re-exports

head, last :: Signal -> Maybe (X, Y)
head :: Signal -> Maybe (X, Y)
head = (Sample Y -> (X, Y)) -> Maybe (Sample Y) -> Maybe (X, Y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sample Y -> (X, Y)
forall y. Sample y -> (X, y)
TimeVector.to_pair (Maybe (Sample Y) -> Maybe (X, Y))
-> (Signal -> Maybe (Sample Y)) -> Signal -> Maybe (X, Y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal -> Maybe (Sample Y)
forall (v :: * -> *) a. Vector v a => v a -> Maybe a
TimeVector.head
last :: Signal -> Maybe (X, Y)
last = (Sample Y -> (X, Y)) -> Maybe (Sample Y) -> Maybe (X, Y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sample Y -> (X, Y)
forall y. Sample y -> (X, y)
TimeVector.to_pair (Maybe (Sample Y) -> Maybe (X, Y))
-> (Signal -> Maybe (Sample Y)) -> Signal -> Maybe (X, Y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal -> Maybe (Sample Y)
forall (v :: * -> *) a. Vector v a => v a -> Maybe a
TimeVector.last

at :: X -> Signal -> Y
at :: X -> Signal -> Y
at X
x = Y -> Maybe Y -> Y
forall a. a -> Maybe a -> a
fromMaybe Y
0 (Maybe Y -> Y) -> (Signal -> Maybe Y) -> Signal -> Y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> Signal -> Maybe Y
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Maybe y
TimeVector.at X
x

from_pairs :: [(X, Y)] -> Signal
from_pairs :: [(X, Y)] -> Signal
from_pairs = [(X, Y)] -> Signal
forall (v :: * -> *) y.
Vector v (Sample y) =>
[(X, y)] -> v (Sample y)
TimeVector.from_pairs

to_pairs :: Signal -> [(X, Y)]
to_pairs :: Signal -> [(X, Y)]
to_pairs = Signal -> [(X, Y)]
forall (v :: * -> *) y.
Vector v (Sample y) =>
v (Sample y) -> [(X, y)]
TimeVector.to_pairs

scalar_add :: Y -> Signal -> Signal
scalar_add :: Y -> Signal -> Signal
scalar_add Y
y = (Y -> Y) -> Signal -> Signal
forall (v :: * -> *) y.
Vector v (Sample y) =>
(y -> y) -> v (Sample y) -> v (Sample y)
TimeVector.map_y (Y -> Y -> Y
forall a. Num a => a -> a -> a
+Y
y)

-- * clip_bounds

-- | Clip the signal's Y values to lie between (0, 1), inclusive.  Return the
-- half-open ranges during which the Y was out of range, if any.
--
-- TODO return Y value too, maybe just each (X, Y) where it goes out of range,
-- suppressing adjacent samples.
clip_bounds :: Y -> Y -> Signal -> (Signal, [(X, X)])
clip_bounds :: Y -> Y -> Signal -> (Signal, [(X, X)])
clip_bounds Y
low Y
high Signal
sig = (Signal
clipped, [(X, X)] -> [(X, X)]
forall a. [a] -> [a]
reverse [(X, X)]
out_of_range)
    where
    clipped :: Signal
clipped = if [(X, X)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [(X, X)]
out_of_range then Signal
sig
        else (Y -> Y) -> Signal -> Signal
forall (v :: * -> *) y.
Vector v (Sample y) =>
(y -> y) -> v (Sample y) -> v (Sample y)
TimeVector.map_y (Y -> Y -> Y -> Y
forall a. Ord a => a -> a -> a -> a
Num.clamp Y
low Y
high) Signal
sig
    ([(X, X)]
ranges, Maybe X
in_clip) = (([(X, X)], Maybe X) -> Sample Y -> ([(X, X)], Maybe X))
-> ([(X, X)], Maybe X) -> Signal -> ([(X, X)], Maybe X)
forall (v :: * -> *) b a.
Vector v b =>
(a -> b -> a) -> a -> v b -> a
TimeVector.foldl' ([(X, X)], Maybe X) -> Sample Y -> ([(X, X)], Maybe X)
go ([], Maybe X
forall a. Maybe a
Nothing) Signal
sig
    out_of_range :: [(X, X)]
out_of_range = case (Maybe X
in_clip, Signal -> Maybe (Sample Y)
forall (v :: * -> *) a. Vector v a => v a -> Maybe a
TimeVector.last Signal
sig) of
        (Just X
start, Just (TimeVector.Sample X
end Y
_)) -> (X
start, X
end) (X, X) -> [(X, X)] -> [(X, X)]
forall a. a -> [a] -> [a]
: [(X, X)]
ranges
        (Maybe X, Maybe (Sample Y))
_ -> [(X, X)]
ranges
    go :: ([(X, X)], Maybe X) -> Sample Y -> ([(X, X)], Maybe X)
go state :: ([(X, X)], Maybe X)
state@([(X, X)]
accum, Maybe X
Nothing) (TimeVector.Sample X
x Y
y)
        | Y
y Y -> Y -> Bool
forall a. Ord a => a -> a -> Bool
< Y
low Bool -> Bool -> Bool
|| Y
y Y -> Y -> Bool
forall a. Ord a => a -> a -> Bool
> Y
high = ([(X, X)]
accum, X -> Maybe X
forall a. a -> Maybe a
Just X
x)
        | Bool
otherwise = ([(X, X)], Maybe X)
state
    go state :: ([(X, X)], Maybe X)
state@([(X, X)]
accum, Just X
start) (TimeVector.Sample X
x Y
y)
        | Y
y Y -> Y -> Bool
forall a. Ord a => a -> a -> Bool
< Y
low Bool -> Bool -> Bool
|| Y
y Y -> Y -> Bool
forall a. Ord a => a -> a -> Bool
> Y
high = ([(X, X)], Maybe X)
state
        | Bool
otherwise = ((X
start, X
x) (X, X) -> [(X, X)] -> [(X, X)]
forall a. a -> [a] -> [a]
: [(X, X)]
accum, Maybe X
forall a. Maybe a
Nothing)

-- ** pitches_share

{- | Can the pitch signals share a channel within the given range?

    Pitch is complicated.  Like other controls, if the pitch curves are
    different they may not share a channel.  However, if the pitch curves
    are integral transpositions of each other, and the transposition is not
    0, they should share.  Unless the overlap occurs during the decay of one or
    both notes, at which point 0 transposition is ok.
-}
pitches_share :: Bool -> X -> X
    -> Midi.Key -> Signal -> Midi.Key -> Signal -> Bool
pitches_share :: Bool -> X -> X -> Key -> Signal -> Key -> Signal -> Bool
pitches_share Bool
in_decay X
start X
end Key
initial1 Signal
sig1 Key
initial2 Signal
sig2
    | Bool -> Bool
not Bool
in_decay Bool -> Bool -> Bool
&& Key
initial1 Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
initial2 = Bool
False
    | Bool
otherwise = Y -> Y -> Bool
pitch_eq (Signal
sig1 Signal -> X -> Y
forall {a} {v :: * -> *}.
(Num a, Vector v (Sample a)) =>
v (Sample a) -> X -> a
! X
start) (Signal
sig2 Signal -> X -> Y
forall {a} {v :: * -> *}.
(Num a, Vector v (Sample a)) =>
v (Sample a) -> X -> a
! X
start)
        Bool -> Bool -> Bool
&& Y -> Y -> Bool
pitch_eq (Signal
sig1 Signal -> X -> Y
forall {a} {v :: * -> *}.
(Num a, Vector v (Sample a)) =>
v (Sample a) -> X -> a
! X
end) (Signal
sig2 Signal -> X -> Y
forall {a} {v :: * -> *}.
(Num a, Vector v (Sample a)) =>
v (Sample a) -> X -> a
! X
end)
        Bool -> Bool -> Bool
&& (Y -> Y -> Bool) -> X -> Signal -> Signal -> Bool
signals_share Y -> Y -> Bool
pitch_eq X
start Signal
in1 Signal
in2
    where
    in1 :: Signal
in1 = X -> X -> Signal -> Signal
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> X -> v (Sample y) -> v (Sample y)
TimeVector.within X
start X
end Signal
sig1
    in2 :: Signal
in2 = X -> X -> Signal -> Signal
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> X -> v (Sample y) -> v (Sample y)
TimeVector.within X
start X
end Signal
sig2
    pitch_eq :: Y -> Y -> Bool
pitch_eq = Key -> Key -> Y -> Y -> Bool
nns_share Key
initial1 Key
initial2
    ! :: v (Sample a) -> X -> a
(!) v (Sample a)
sig X
x = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
0 (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ X -> v (Sample a) -> Maybe a
forall (v :: * -> *) y.
Vector v (Sample y) =>
X -> v (Sample y) -> Maybe y
TimeVector.at X
x v (Sample a)
sig

-- | I need to sample points from start to end, including the start and the
-- end.  Unfortunately it's not as simple as it seems it should be, especially
-- since this function is a hotspot and must be efficient.
--
-- Segment.within may return samples before start to get the proper value so
-- I ignore samples before the start.  Start itself is tested explicitly above.
{-# INLINE signals_share #-}
signals_share :: (Y -> Y -> Bool) -> X -> TimeVector.Unboxed
    -> TimeVector.Unboxed -> Bool
signals_share :: (Y -> Y -> Bool) -> X -> Signal -> Signal -> Bool
signals_share Y -> Y -> Bool
eq X
start Signal
vec1 Signal
vec2 = Y -> Y -> Int -> Int -> Bool
go Y
0 Y
0 Int
0 Int
0
    where
    go :: Y -> Y -> Int -> Int -> Bool
go Y
prev_ay Y
prev_by Int
i1 Int
i2 =
        case Y
-> Y
-> Int
-> Int
-> Int
-> Int
-> Signal
-> Signal
-> Maybe (X, Y, Y, Int, Int)
forall (v1 :: * -> *) y1 (v2 :: * -> *) y2.
(Vector v1 (Sample y1), Vector v2 (Sample y2)) =>
y1
-> y2
-> Int
-> Int
-> Int
-> Int
-> v1 (Sample y1)
-> v2 (Sample y2)
-> Maybe (X, y1, y2, Int, Int)
TimeVector.resample1 Y
prev_ay Y
prev_by Int
len1 Int
len2 Int
i1 Int
i2 Signal
vec1 Signal
vec2 of
            Maybe (X, Y, Y, Int, Int)
Nothing -> Bool
True
            Just (X
x, Y
ay, Y
by, Int
i1, Int
i2) ->
                (X
x X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= X
start Bool -> Bool -> Bool
|| Y -> Y -> Bool
eq Y
ay Y
by) Bool -> Bool -> Bool
&& Y -> Y -> Int -> Int -> Bool
go Y
ay Y
by Int
i1 Int
i2
    len1 :: Int
len1 = Signal -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
TimeVector.length Signal
vec1
    len2 :: Int
len2 = Signal -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
TimeVector.length Signal
vec2

nns_share :: Midi.Key -> Midi.Key -> Y -> Y -> Bool
nns_share :: Key -> Key -> Y -> Y -> Bool
nns_share Key
initial1 Key
initial2 Y
nn1 Y
nn2 =
    Y -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor ((Y
nn1 Y -> Y -> Y
forall a. Num a => a -> a -> a
- Key -> Y
forall a. Num a => Key -> a
Midi.from_key Key
initial1) Y -> Y -> Y
forall a. Num a => a -> a -> a
* Y
1000)
        Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Y -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor ((Y
nn2 Y -> Y -> Y
forall a. Num a => a -> a -> a
- Key -> Y
forall a. Num a => Key -> a
Midi.from_key Key
initial2) Y -> Y -> Y
forall a. Num a => a -> a -> a
* Y
1000)