-- Copyright 2017 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

{-# LANGUAGE EmptyDataDecls #-}
{- | Sample values are doubles, which means each point in the signal is 8*2
    bytes.  The double resolution is overkill for the value, but float would
    be too small for time given the time stretching.

    TODO split this into Float and Double versions since only Warp really
    needs Double.  Or does Warp really need Double?
-}
module Perform.Signal (
    -- * types
    Signal, Sample(..)
    , X, Y, x_to_y, y_to_x, y_to_score, y_to_nn, nn_to_y
    , Tempo, Warp, Control, NoteNumber, Display

    -- * construct / destruct
    , from_sample, from_pairs, from_segments
    , to_samples, to_pairs, to_pairs_desc
    , to_segments, to_vector
    , constant, constant_val, constant_val_from
    , zero_or_below
    , beginning
    , prepend
    , unfoldr
    , coerce
    , to_piecewise_constant
    , with_ptr

    -- * query
    , null
    , at, at_maybe, segment_at
    , head, last
    , minimum, maximum
    , find

    -- * transform
    , drop_after, drop_before
    , clip_after, clip_before, clip_before_segments, clip_before_pairs
    , clip_after_keep_last
    , shift

    , invert, sig_add, sig_subtract, sig_multiply, sig_scale
    , scale, scale_invert

    -- ** hacks
    , drop_discontinuity_at

    -- ** scalar transformation
    , scalar_max
    , scalar_add, scalar_subtract, scalar_multiply, scalar_divide
    , scalar_scale
    , map_x, map_y, map_y_linear, map_err

    -- * special functions
    , integrate_inverse, integrate, tempo_srate
) where
import           Prelude hiding (head, last, maximum, minimum, null, drop)
import qualified Control.DeepSeq as DeepSeq
import qualified Data.Vector.Storable as Vector
import qualified Foreign

import qualified Util.Num as Num
import qualified Util.Pretty as Pretty
import qualified Util.Segment as Segment
import           Util.Segment (Sample(..), X)
import qualified Util.Seq as Seq
import qualified Util.Serialize as Serialize
import qualified Util.TimeVector as TimeVector

import qualified Perform.Pitch as Pitch
import qualified Perform.RealTime as RealTime
import qualified Ui.ScoreTime as ScoreTime

import           Global
import           Types


-- * types

-- | A Signal is a 'Segment.Signal' of 'Y' values, which are just Doubles.  It
-- takes a phantom type parameter to make the signal's intended uses a little
-- clearer.  There are type aliases for the various flavors of signal below,
-- but it really is just documentation and anyone who wants to operate on
-- a generic signal can take a @Signal kind@.
newtype Signal kind = Signal Segment.NumSignal
    deriving (Int -> Signal kind -> ShowS
[Signal kind] -> ShowS
Signal kind -> String
(Int -> Signal kind -> ShowS)
-> (Signal kind -> String)
-> ([Signal kind] -> ShowS)
-> Show (Signal kind)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (kind :: k). Int -> Signal kind -> ShowS
forall k (kind :: k). [Signal kind] -> ShowS
forall k (kind :: k). Signal kind -> String
showList :: [Signal kind] -> ShowS
$cshowList :: forall k (kind :: k). [Signal kind] -> ShowS
show :: Signal kind -> String
$cshow :: forall k (kind :: k). Signal kind -> String
showsPrec :: Int -> Signal kind -> ShowS
$cshowsPrec :: forall k (kind :: k). Int -> Signal kind -> ShowS
Show, Signal kind -> Signal kind -> Bool
(Signal kind -> Signal kind -> Bool)
-> (Signal kind -> Signal kind -> Bool) -> Eq (Signal kind)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (kind :: k). Signal kind -> Signal kind -> Bool
/= :: Signal kind -> Signal kind -> Bool
$c/= :: forall k (kind :: k). Signal kind -> Signal kind -> Bool
== :: Signal kind -> Signal kind -> Bool
$c== :: forall k (kind :: k). Signal kind -> Signal kind -> Bool
Eq, Signal kind -> ()
(Signal kind -> ()) -> NFData (Signal kind)
forall a. (a -> ()) -> NFData a
forall k (kind :: k). Signal kind -> ()
rnf :: Signal kind -> ()
$crnf :: forall k (kind :: k). Signal kind -> ()
DeepSeq.NFData, Get (Signal kind)
Putter (Signal kind)
Putter (Signal kind)
-> Get (Signal kind) -> Serialize (Signal kind)
forall a. Putter a -> Get a -> Serialize a
forall k (kind :: k). Get (Signal kind)
forall k (kind :: k). Putter (Signal kind)
get :: Get (Signal kind)
$cget :: forall k (kind :: k). Get (Signal kind)
put :: Putter (Signal kind)
$cput :: forall k (kind :: k). Putter (Signal kind)
Serialize.Serialize)

instance Pretty (Signal kind) where
    format :: Signal kind -> Doc
format Signal kind
sig = case Signal kind -> Maybe Y
forall {k} (kind :: k). Signal kind -> Maybe Y
constant_val Signal kind
sig of
        Just Y
y -> Doc
"Signal.constant" Doc -> Doc -> Doc
Pretty.<+> Y -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Y
y
        Maybe Y
Nothing -> NumSignal -> Doc
forall a. Pretty a => a -> Doc
Pretty.format (Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal Signal kind
sig)

_signal :: Signal kind -> Segment.NumSignal
_signal :: forall {k} (kind :: k). Signal kind -> NumSignal
_signal (Signal NumSignal
sig) = NumSignal
sig

modify :: (Segment.NumSignal -> Segment.NumSignal) -> Signal kind -> Signal kind
modify :: forall {k} (kind :: k).
(NumSignal -> NumSignal) -> Signal kind -> Signal kind
modify NumSignal -> NumSignal
f = NumSignal -> Signal kind
forall {k} (kind :: k). NumSignal -> Signal kind
Signal (NumSignal -> Signal kind)
-> (Signal kind -> NumSignal) -> Signal kind -> Signal kind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumSignal -> NumSignal
f (NumSignal -> NumSignal)
-> (Signal kind -> NumSignal) -> Signal kind -> NumSignal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal

type Y = Double

instance Semigroup (Signal kind) where
    Signal kind
s1 <> :: Signal kind -> Signal kind -> Signal kind
<> Signal kind
s2
        | Signal kind -> Bool
forall {k} (kind :: k). Signal kind -> Bool
null Signal kind
s1 = Signal kind
s2
        | Signal kind -> Bool
forall {k} (kind :: k). Signal kind -> Bool
null Signal kind
s2 = Signal kind
s1
        | Bool
otherwise = [Signal kind] -> Signal kind
forall a. Monoid a => [a] -> a
mconcat [Signal kind
s1, Signal kind
s2]

instance Monoid (Signal kind) where
    mempty :: Signal kind
mempty = NumSignal -> Signal kind
forall {k} (kind :: k). NumSignal -> Signal kind
Signal NumSignal
forall (v :: * -> *) a. Vector v a => Signal (v a)
Segment.empty
    mappend :: Signal kind -> Signal kind -> Signal kind
mappend = Signal kind -> Signal kind -> Signal kind
forall a. Semigroup a => a -> a -> a
(<>)
    mconcat :: [Signal kind] -> Signal kind
mconcat = NumSignal -> Signal kind
forall {k} (kind :: k). NumSignal -> Signal kind
Signal (NumSignal -> Signal kind)
-> ([Signal kind] -> NumSignal) -> [Signal kind] -> Signal kind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Y -> Y -> Bool) -> Interpolate Y -> [NumSignal] -> NumSignal
forall (v :: * -> *) y.
Vector v (Sample y) =>
Maybe (y -> y -> Bool)
-> Interpolate y -> [SignalS v y] -> SignalS v y
Segment.concat ((Y -> Y -> Bool) -> Maybe (Y -> Y -> Bool)
forall a. a -> Maybe a
Just Y -> Y -> Bool
forall a. Eq a => a -> a -> Bool
(==)) Interpolate Y
Segment.num_interpolate
        ([NumSignal] -> NumSignal)
-> ([Signal kind] -> [NumSignal]) -> [Signal kind] -> NumSignal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Signal kind -> NumSignal) -> [Signal kind] -> [NumSignal]
forall a b. (a -> b) -> [a] -> [b]
map Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal ([Signal kind] -> [NumSignal])
-> ([Signal kind] -> [Signal kind]) -> [Signal kind] -> [NumSignal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Signal kind -> Bool) -> [Signal kind] -> [Signal kind]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Signal kind -> Bool) -> Signal kind -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal kind -> Bool
forall {k} (kind :: k). Signal kind -> Bool
null)

-- | This is the type of performer-interpreted controls that go into the
-- event's control map.
type Control = Signal ControlSig
data ControlSig

-- | A tempo is a normal Control signal, except that instead of going into the
-- control map, it gets turned into a Warp and goes into the warp map.
type Tempo = Signal TempoSig
data TempoSig

-- | A tempo warp maps score time to real time.  Of course the type is still
-- (ScoreTime, Y), so functions that process Warps have to convert.
type Warp = Signal WarpSig
data WarpSig

-- | This is the type of pitch signals used by the performer, after the scale
-- has been factored out.
type NoteNumber = Signal NoteNumberSig
data NoteNumberSig

-- | This is the type of signals which are sent to the UI for display.
type Display = Signal DisplaySig
data DisplaySig

x_to_y :: X -> Y
x_to_y :: RealTime -> Y
x_to_y = RealTime -> Y
RealTime.to_seconds

y_to_x :: Y -> X
y_to_x :: Y -> RealTime
y_to_x = Y -> RealTime
RealTime.seconds

-- | Some control signals may be interpreted as score time.
y_to_score :: Y -> ScoreTime
y_to_score :: Y -> ScoreTime
y_to_score = Y -> ScoreTime
ScoreTime.from_double

y_to_nn :: Y -> Pitch.NoteNumber
y_to_nn :: Y -> NoteNumber
y_to_nn = Y -> NoteNumber
Pitch.NoteNumber

nn_to_y :: Pitch.NoteNumber -> Y
nn_to_y :: NoteNumber -> Y
nn_to_y (Pitch.NoteNumber Y
nn) = Y
nn

-- * construct / destruct

from_sample :: X -> Y -> Signal kind
from_sample :: forall {k} (kind :: k). RealTime -> Y -> Signal kind
from_sample RealTime
x Y
y = [(RealTime, Y)] -> Signal kind
forall {k} (kind :: k). [(RealTime, Y)] -> Signal kind
from_pairs [(RealTime
x, Y
y)]

from_pairs :: [(X, Y)] -> Signal kind
from_pairs :: forall {k} (kind :: k). [(RealTime, Y)] -> Signal kind
from_pairs = NumSignal -> Signal kind
forall {k} (kind :: k). NumSignal -> Signal kind
Signal (NumSignal -> Signal kind)
-> ([(RealTime, Y)] -> NumSignal) -> [(RealTime, Y)] -> Signal kind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RealTime, Y)] -> NumSignal
forall (v :: * -> *) y.
Vector v (Sample y) =>
[(RealTime, y)] -> SignalS v y
Segment.from_pairs

from_segments :: [Segment.Segment Y] -> Signal kind
from_segments :: forall {k} (kind :: k). [Segment Y] -> Signal kind
from_segments = NumSignal -> Signal kind
forall {k} (kind :: k). NumSignal -> Signal kind
Signal (NumSignal -> Signal kind)
-> ([Segment Y] -> NumSignal) -> [Segment Y] -> Signal kind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Segment Y] -> NumSignal
forall (v :: * -> *) y.
Vector v (Sample y) =>
[Segment y] -> SignalS v y
Segment.from_segments

to_samples :: Signal kind -> [Sample Y]
to_samples :: forall {k} (kind :: k). Signal kind -> [Sample Y]
to_samples = NumSignal -> [Sample Y]
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [Sample y]
Segment.to_samples (NumSignal -> [Sample Y])
-> (Signal kind -> NumSignal) -> Signal kind -> [Sample Y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal

to_pairs :: Signal kind -> [(X, Y)]
to_pairs :: forall {k} (kind :: k). Signal kind -> [(RealTime, Y)]
to_pairs = ((RealTime, Y) -> (RealTime, Y))
-> [(RealTime, Y)] -> [(RealTime, Y)]
forall k a. Eq k => (a -> k) -> [a] -> [a]
Seq.drop_dups (RealTime, Y) -> (RealTime, Y)
forall a. a -> a
id ([(RealTime, Y)] -> [(RealTime, Y)])
-> (Signal kind -> [(RealTime, Y)])
-> Signal kind
-> [(RealTime, Y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumSignal -> [(RealTime, Y)]
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [(RealTime, y)]
Segment.to_pairs (NumSignal -> [(RealTime, Y)])
-> (Signal kind -> NumSignal) -> Signal kind -> [(RealTime, Y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal
    -- Since Segment functions don't have Eq y, they can emit duplicate
    -- samples.  They should be harmless but they clutter tests.

to_pairs_desc :: Signal kind -> [(X, Y)]
to_pairs_desc :: forall {k} (kind :: k). Signal kind -> [(RealTime, Y)]
to_pairs_desc = ((RealTime, Y) -> (RealTime, Y))
-> [(RealTime, Y)] -> [(RealTime, Y)]
forall k a. Eq k => (a -> k) -> [a] -> [a]
Seq.drop_dups (RealTime, Y) -> (RealTime, Y)
forall a. a -> a
id ([(RealTime, Y)] -> [(RealTime, Y)])
-> (Signal kind -> [(RealTime, Y)])
-> Signal kind
-> [(RealTime, Y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumSignal -> [(RealTime, Y)]
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [(RealTime, y)]
Segment.to_pairs_desc (NumSignal -> [(RealTime, Y)])
-> (Signal kind -> NumSignal) -> Signal kind -> [(RealTime, Y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal

to_segments :: Signal kind -> [Segment.Segment Y]
to_segments :: forall {k} (kind :: k). Signal kind -> [Segment Y]
to_segments = NumSignal -> [Segment Y]
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> [Segment y]
Segment.to_segments (NumSignal -> [Segment Y])
-> (Signal kind -> NumSignal) -> Signal kind -> [Segment Y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal

to_vector :: Signal kind -> Vector.Vector (Sample Y)
to_vector :: forall {k} (kind :: k). Signal kind -> Vector (Sample Y)
to_vector = NumSignal -> Vector (Sample Y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> v (Sample y)
Segment.to_vector (NumSignal -> Vector (Sample Y))
-> (Signal kind -> NumSignal) -> Signal kind -> Vector (Sample Y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal

constant :: Y -> Signal kind
constant :: forall {k} (kind :: k). Y -> Signal kind
constant = NumSignal -> Signal kind
forall {k} (kind :: k). NumSignal -> Signal kind
Signal (NumSignal -> Signal kind) -> (Y -> NumSignal) -> Y -> Signal kind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Y -> NumSignal
forall (v :: * -> *) y. Vector v (Sample y) => y -> SignalS v y
Segment.constant

-- | Just if the signal is constant.
constant_val :: Signal kind -> Maybe Y
constant_val :: forall {k} (kind :: k). Signal kind -> Maybe Y
constant_val = RealTime -> NumSignal -> Maybe Y
Segment.constant_val_num (-RealTime
RealTime.large) (NumSignal -> Maybe Y)
-> (Signal kind -> NumSignal) -> Signal kind -> Maybe Y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal

constant_val_from :: X -> Signal kind -> Maybe Y
constant_val_from :: forall {k} (kind :: k). RealTime -> Signal kind -> Maybe Y
constant_val_from RealTime
x = RealTime -> NumSignal -> Maybe Y
Segment.constant_val_num RealTime
x (NumSignal -> Maybe Y)
-> (Signal kind -> NumSignal) -> Signal kind -> Maybe Y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal

-- | True if the signal becomes <=0 at any point.  This assumes the signal
-- starts at X==0, which is true of signals from control tracks only.
zero_or_below :: Signal kind -> Bool
zero_or_below :: forall {k} (kind :: k). Signal kind -> Bool
zero_or_below Signal kind
signal = case Signal kind -> Maybe (RealTime, Y)
forall {k} (kind :: k). Signal kind -> Maybe (RealTime, Y)
head Signal kind
signal of
    Maybe (RealTime, Y)
Nothing -> Bool
True
    Just (RealTime
x, Y
_)
        | RealTime
x RealTime -> RealTime -> Bool
forall a. Ord a => a -> a -> Bool
> RealTime
0 -> Bool
True
        | Bool
otherwise -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Y -> Bool) -> NumSignal -> Bool
Segment.all_y (Y -> Y -> Bool
forall a. Ord a => a -> a -> Bool
>Y
0) (Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal Signal kind
signal)

beginning :: RealTime
beginning :: RealTime
beginning = RealTime
Segment.beginning

prepend :: Signal kind -> Signal kind -> Signal kind
prepend :: forall k (kind :: k). Signal kind -> Signal kind -> Signal kind
prepend Signal kind
sig1 Signal kind
sig2 = NumSignal -> Signal kind
forall {k} (kind :: k). NumSignal -> Signal kind
Signal (NumSignal -> Signal kind) -> NumSignal -> Signal kind
forall a b. (a -> b) -> a -> b
$
    Maybe (Y -> Y -> Bool)
-> Interpolate Y -> NumSignal -> NumSignal -> NumSignal
forall (v :: * -> *) y.
Vector v (Sample y) =>
Maybe (y -> y -> Bool)
-> Interpolate y -> SignalS v y -> SignalS v y -> SignalS v y
Segment.prepend ((Y -> Y -> Bool) -> Maybe (Y -> Y -> Bool)
forall a. a -> Maybe a
Just Y -> Y -> Bool
forall a. Eq a => a -> a -> Bool
(==)) Interpolate Y
Segment.num_interpolate
        (Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal Signal kind
sig1) (Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal Signal kind
sig2)

unfoldr :: (state -> Maybe ((X, Y), state)) -> state -> Signal kind
unfoldr :: forall {k} state (kind :: k).
(state -> Maybe ((RealTime, Y), state)) -> state -> Signal kind
unfoldr state -> Maybe ((RealTime, Y), state)
gen state
state = NumSignal -> Signal kind
forall {k} (kind :: k). NumSignal -> Signal kind
Signal (NumSignal -> Signal kind) -> NumSignal -> Signal kind
forall a b. (a -> b) -> a -> b
$ (state -> Maybe ((RealTime, Y), state)) -> state -> NumSignal
forall (v :: * -> *) y state.
Vector v (Sample y) =>
(state -> Maybe ((RealTime, y), state)) -> state -> SignalS v y
Segment.unfoldr state -> Maybe ((RealTime, Y), state)
gen state
state

-- | Sometimes signal types need to be converted.
coerce :: Signal kind1 -> Signal kind2
coerce :: forall {k} {k} (kind1 :: k) (kind2 :: k).
Signal kind1 -> Signal kind2
coerce (Signal NumSignal
vec) = NumSignal -> Signal kind2
forall {k} (kind :: k). NumSignal -> Signal kind
Signal NumSignal
vec

to_piecewise_constant :: X -> Signal kind -> TimeVector.Unboxed
to_piecewise_constant :: forall {k} (kind :: k).
RealTime -> Signal kind -> Vector (Sample Y)
to_piecewise_constant RealTime
srate = RealTime -> NumSignal -> Vector (Sample Y)
Segment.to_piecewise_constant RealTime
srate (NumSignal -> Vector (Sample Y))
-> (Signal kind -> NumSignal) -> Signal kind -> Vector (Sample Y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal

-- | 'Segment.with_ptr'.
with_ptr :: Display -> (X -> Foreign.Ptr (Sample Y) -> Int -> IO a) -> IO a
with_ptr :: forall a.
Display -> (RealTime -> Ptr (Sample Y) -> Int -> IO a) -> IO a
with_ptr Display
sig = NumSignal -> (RealTime -> Ptr (Sample Y) -> Int -> IO a) -> IO a
forall a b.
Storable a =>
Signal (Vector a) -> (RealTime -> Ptr a -> Int -> IO b) -> IO b
Segment.with_ptr (Display -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal Display
sig)

-- * query

null :: Signal kind -> Bool
null :: forall {k} (kind :: k). Signal kind -> Bool
null = NumSignal -> Bool
forall (v :: * -> *) y. Vector v (Sample y) => SignalS v y -> Bool
Segment.null (NumSignal -> Bool)
-> (Signal kind -> NumSignal) -> Signal kind -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal

at :: X -> Signal kind -> Y
at :: forall {k} (kind :: k). RealTime -> Signal kind -> Y
at RealTime
x = Y -> Maybe Y -> Y
forall a. a -> Maybe a -> a
fromMaybe Y
0 (Maybe Y -> Y) -> (Signal kind -> Maybe Y) -> Signal kind -> Y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealTime -> Signal kind -> Maybe Y
forall {k} (kind :: k). RealTime -> Signal kind -> Maybe Y
at_maybe RealTime
x

at_maybe :: X -> Signal kind -> Maybe Y
at_maybe :: forall {k} (kind :: k). RealTime -> Signal kind -> Maybe Y
at_maybe RealTime
x = Interpolate Y -> RealTime -> NumSignal -> Maybe Y
forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> RealTime -> SignalS v y -> Maybe y
Segment.at Interpolate Y
Segment.num_interpolate RealTime
x (NumSignal -> Maybe Y)
-> (Signal kind -> NumSignal) -> Signal kind -> Maybe Y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal

segment_at :: X -> Signal kind -> Maybe (Segment.Segment Y)
segment_at :: forall {k} (kind :: k).
RealTime -> Signal kind -> Maybe (Segment Y)
segment_at RealTime
x = RealTime -> NumSignal -> Maybe (Segment Y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
RealTime -> SignalS v y -> Maybe (Segment y)
Segment.segment_at RealTime
x (NumSignal -> Maybe (Segment Y))
-> (Signal kind -> NumSignal) -> Signal kind -> Maybe (Segment Y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal

head, last :: Signal kind -> Maybe (X, Y)
head :: forall {k} (kind :: k). Signal kind -> Maybe (RealTime, Y)
head = NumSignal -> Maybe (RealTime, Y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> Maybe (RealTime, y)
Segment.head (NumSignal -> Maybe (RealTime, Y))
-> (Signal kind -> NumSignal) -> Signal kind -> Maybe (RealTime, Y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal
last :: forall {k} (kind :: k). Signal kind -> Maybe (RealTime, Y)
last = NumSignal -> Maybe (RealTime, Y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> Maybe (RealTime, y)
Segment.last (NumSignal -> Maybe (RealTime, Y))
-> (Signal kind -> NumSignal) -> Signal kind -> Maybe (RealTime, Y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal

-- * transform

drop_after, drop_before :: X -> Signal kind -> Signal kind
drop_after :: forall {k} (kind :: k). RealTime -> Signal kind -> Signal kind
drop_after RealTime
x = (NumSignal -> NumSignal) -> Signal kind -> Signal kind
forall {k} (kind :: k).
(NumSignal -> NumSignal) -> Signal kind -> Signal kind
modify ((NumSignal -> NumSignal) -> Signal kind -> Signal kind)
-> (NumSignal -> NumSignal) -> Signal kind -> Signal kind
forall a b. (a -> b) -> a -> b
$ RealTime -> NumSignal -> NumSignal
forall (v :: * -> *) y.
Vector v (Sample y) =>
RealTime -> SignalS v y -> SignalS v y
Segment.drop_after RealTime
x
drop_before :: forall {k} (kind :: k). RealTime -> Signal kind -> Signal kind
drop_before RealTime
x = (NumSignal -> NumSignal) -> Signal kind -> Signal kind
forall {k} (kind :: k).
(NumSignal -> NumSignal) -> Signal kind -> Signal kind
modify ((NumSignal -> NumSignal) -> Signal kind -> Signal kind)
-> (NumSignal -> NumSignal) -> Signal kind -> Signal kind
forall a b. (a -> b) -> a -> b
$ RealTime -> NumSignal -> NumSignal
forall (v :: * -> *) y.
Vector v (Sample y) =>
RealTime -> SignalS v y -> SignalS v y
Segment.drop_before RealTime
x

clip_after, clip_before :: X -> Signal kind -> Signal kind
clip_after :: forall {k} (kind :: k). RealTime -> Signal kind -> Signal kind
clip_after RealTime
x = (NumSignal -> NumSignal) -> Signal kind -> Signal kind
forall {k} (kind :: k).
(NumSignal -> NumSignal) -> Signal kind -> Signal kind
modify ((NumSignal -> NumSignal) -> Signal kind -> Signal kind)
-> (NumSignal -> NumSignal) -> Signal kind -> Signal kind
forall a b. (a -> b) -> a -> b
$ Bool -> RealTime -> NumSignal -> NumSignal
Segment.num_clip_after Bool
False RealTime
x
clip_before :: forall {k} (kind :: k). RealTime -> Signal kind -> Signal kind
clip_before RealTime
x = (NumSignal -> NumSignal) -> Signal kind -> Signal kind
forall {k} (kind :: k).
(NumSignal -> NumSignal) -> Signal kind -> Signal kind
modify ((NumSignal -> NumSignal) -> Signal kind -> Signal kind)
-> (NumSignal -> NumSignal) -> Signal kind -> Signal kind
forall a b. (a -> b) -> a -> b
$ Interpolate Y -> RealTime -> NumSignal -> NumSignal
forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> RealTime -> SignalS v y -> SignalS v y
Segment.clip_before Interpolate Y
Segment.num_interpolate RealTime
x

-- TODO if Segment.clip_before_samples is the same as Segment.clip_before,
-- then this is the same as 'clip_before'.
clip_before_segments :: X -> Signal kind -> [Segment.Segment Y]
clip_before_segments :: forall {k} (kind :: k). RealTime -> Signal kind -> [Segment Y]
clip_before_segments RealTime
x = [Sample Y] -> [Segment Y]
forall y. [Sample y] -> [Segment y]
Segment.samples_to_segments
    ([Sample Y] -> [Segment Y])
-> (Signal kind -> [Sample Y]) -> Signal kind -> [Segment Y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interpolate Y -> RealTime -> NumSignal -> [Sample Y]
forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> RealTime -> SignalS v y -> [Sample y]
Segment.clip_before_samples Interpolate Y
Segment.num_interpolate RealTime
x
    (NumSignal -> [Sample Y])
-> (Signal kind -> NumSignal) -> Signal kind -> [Sample Y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal

clip_before_pairs :: X -> Signal kind -> [(X, Y)]
clip_before_pairs :: forall {k} (kind :: k). RealTime -> Signal kind -> [(RealTime, Y)]
clip_before_pairs RealTime
x =
    (Sample Y -> (RealTime, Y)) -> [Sample Y] -> [(RealTime, Y)]
forall a b. (a -> b) -> [a] -> [b]
map Sample Y -> (RealTime, Y)
forall y. Sample y -> (RealTime, y)
TimeVector.to_pair
    ([Sample Y] -> [(RealTime, Y)])
-> (Signal kind -> [Sample Y]) -> Signal kind -> [(RealTime, Y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interpolate Y -> RealTime -> NumSignal -> [Sample Y]
forall (v :: * -> *) y.
Vector v (Sample y) =>
Interpolate y -> RealTime -> SignalS v y -> [Sample y]
Segment.clip_before_samples Interpolate Y
Segment.num_interpolate RealTime
x
    (NumSignal -> [Sample Y])
-> (Signal kind -> NumSignal) -> Signal kind -> [Sample Y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal

-- | Like 'clip_after', but always put a sample at the end time, even if it's
-- flat.  This is not necessary if you keep this as a Signal since (<>) will
-- extend the final sample, but might be if you go to breakpoints via
-- 'to_pairs'.
clip_after_keep_last :: X -> Signal kind -> Signal kind
clip_after_keep_last :: forall {k} (kind :: k). RealTime -> Signal kind -> Signal kind
clip_after_keep_last RealTime
x = (NumSignal -> NumSignal) -> Signal kind -> Signal kind
forall {k} (kind :: k).
(NumSignal -> NumSignal) -> Signal kind -> Signal kind
modify ((NumSignal -> NumSignal) -> Signal kind -> Signal kind)
-> (NumSignal -> NumSignal) -> Signal kind -> Signal kind
forall a b. (a -> b) -> a -> b
$ Bool -> RealTime -> NumSignal -> NumSignal
Segment.num_clip_after Bool
True RealTime
x

shift :: X -> Signal kind -> Signal kind
shift :: forall {k} (kind :: k). RealTime -> Signal kind -> Signal kind
shift RealTime
x = (NumSignal -> NumSignal) -> Signal kind -> Signal kind
forall {k} (kind :: k).
(NumSignal -> NumSignal) -> Signal kind -> Signal kind
modify (RealTime -> NumSignal -> NumSignal
forall v. RealTime -> Signal v -> Signal v
Segment.shift RealTime
x)

invert :: Signal kind -> Signal kind
invert :: forall {k} (kind :: k). Signal kind -> Signal kind
invert = (NumSignal -> NumSignal) -> Signal kind -> Signal kind
forall {k} (kind :: k).
(NumSignal -> NumSignal) -> Signal kind -> Signal kind
modify NumSignal -> NumSignal
Segment.invert

sig_add, sig_multiply :: Control -> Control -> Control
sig_add :: Control -> Control -> Control
sig_add = Maybe Y -> (Y -> Y -> Y) -> Control -> Control -> Control
forall {k} (kind :: k).
Maybe Y
-> (Y -> Y -> Y) -> Signal kind -> Signal kind -> Signal kind
linear_operator (Y -> Maybe Y
forall a. a -> Maybe a
Just Y
0) Y -> Y -> Y
forall a. Num a => a -> a -> a
(+)
sig_multiply :: Control -> Control -> Control
sig_multiply = Maybe Y -> (Y -> Y -> Y) -> Control -> Control -> Control
forall {k} (kind :: k).
Maybe Y
-> (Y -> Y -> Y) -> Signal kind -> Signal kind -> Signal kind
linear_operator (Y -> Maybe Y
forall a. a -> Maybe a
Just Y
1) Y -> Y -> Y
forall a. Num a => a -> a -> a
(*)

sig_subtract :: Control -> Control -> Control
sig_subtract :: Control -> Control -> Control
sig_subtract Control
sig1 Control
sig2
    | Just Y
v <- Control -> Maybe Y
forall {k} (kind :: k). Signal kind -> Maybe Y
constant_val Control
sig2, Y
v Y -> Y -> Bool
forall a. Eq a => a -> a -> Bool
== Y
0 = Control
sig1
    | Bool
otherwise = Maybe Y -> (Y -> Y -> Y) -> Control -> Control -> Control
forall {k} (kind :: k).
Maybe Y
-> (Y -> Y -> Y) -> Signal kind -> Signal kind -> Signal kind
linear_operator Maybe Y
forall a. Maybe a
Nothing (-) Control
sig1 Control
sig2

-- TODO I think this is linear?  Because Num.scale is just add and multiply?
sig_scale :: Control -> Control -> Control
sig_scale :: Control -> Control -> Control
sig_scale = Maybe Y -> (Y -> Y -> Y) -> Control -> Control -> Control
forall {k} (kind :: k).
Maybe Y
-> (Y -> Y -> Y) -> Signal kind -> Signal kind -> Signal kind
linear_operator (Y -> Maybe Y
forall a. a -> Maybe a
Just Y
1) Y -> Y -> Y
scale

scale :: Y -> Y -> Y
scale :: Y -> Y -> Y
scale Y
x Y
v
    | Y
v Y -> Y -> Bool
forall a. Ord a => a -> a -> Bool
>= Y
0 = Y -> Y -> Y -> Y
forall a. (Eq a, Num a) => a -> a -> a -> a
Num.scale Y
x Y
1 Y
v
    | Bool
otherwise = Y -> Y -> Y -> Y
forall a. (Eq a, Num a) => a -> a -> a -> a
Num.scale Y
0 Y
x (Y
v Y -> Y -> Y
forall a. Num a => a -> a -> a
+ Y
1)

scale_invert :: Y -> Y -> Y
scale_invert :: Y -> Y -> Y
scale_invert Y
old Y
new
    | Y
new Y -> Y -> Bool
forall a. Ord a => a -> a -> Bool
>= Y
old = Y -> Y -> Y -> Y
forall a. (Eq a, Fractional a) => a -> a -> a -> a
Num.normalize Y
old Y
1 Y
new
    | Bool
otherwise = Y -> Y -> Y -> Y
forall a. (Eq a, Fractional a) => a -> a -> a -> a
Num.normalize Y
0 Y
old Y
new Y -> Y -> Y
forall a. Num a => a -> a -> a
- Y
1

linear_operator :: Maybe Y -- ^ If an identity value is given, I can avoid
    -- copying the whole signal if the other one is a constant identity.
    -> (Y -> Y -> Y) -> Signal kind -> Signal kind -> Signal kind
linear_operator :: forall {k} (kind :: k).
Maybe Y
-> (Y -> Y -> Y) -> Signal kind -> Signal kind -> Signal kind
linear_operator (Just Y
identity) Y -> Y -> Y
_ Signal kind
sig1 Signal kind
sig2
    | Just Y
v <- Signal kind -> Maybe Y
forall {k} (kind :: k). Signal kind -> Maybe Y
constant_val Signal kind
sig1, Y
v Y -> Y -> Bool
forall a. Eq a => a -> a -> Bool
== Y
identity = Signal kind
sig2
    | Just Y
v <- Signal kind -> Maybe Y
forall {k} (kind :: k). Signal kind -> Maybe Y
constant_val Signal kind
sig2, Y
v Y -> Y -> Bool
forall a. Eq a => a -> a -> Bool
== Y
identity = Signal kind
sig1
linear_operator Maybe Y
_ Y -> Y -> Y
op Signal kind
sig1 Signal kind
sig2 =
    NumSignal -> Signal kind
forall {k} (kind :: k). NumSignal -> Signal kind
Signal (NumSignal -> Signal kind) -> NumSignal -> Signal kind
forall a b. (a -> b) -> a -> b
$ (Y -> Y -> Y) -> NumSignal -> NumSignal -> NumSignal
Segment.linear_operator Y -> Y -> Y
op (Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal Signal kind
sig1) (Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal Signal kind
sig2)

-- ** hacks

drop_discontinuity_at :: X -> Control -> Control
drop_discontinuity_at :: RealTime -> Control -> Control
drop_discontinuity_at RealTime
x = (NumSignal -> NumSignal) -> Control -> Control
forall {k} (kind :: k).
(NumSignal -> NumSignal) -> Signal kind -> Signal kind
modify ((NumSignal -> NumSignal) -> Control -> Control)
-> (NumSignal -> NumSignal) -> Control -> Control
forall a b. (a -> b) -> a -> b
$ RealTime -> NumSignal -> NumSignal
forall (v :: * -> *) y.
Vector v (Sample y) =>
RealTime -> SignalS v y -> SignalS v y
Segment.drop_discontinuity_at RealTime
x

-- ** scalar transformation

scalar_add, scalar_subtract, scalar_multiply, scalar_divide ::
    Y -> Signal kind -> Signal kind
scalar_add :: forall {k} (kind :: k). Y -> Signal kind -> Signal kind
scalar_add Y
n = (Y -> Y) -> Signal kind -> Signal kind
forall {k} (kind :: k). (Y -> Y) -> Signal kind -> Signal kind
map_y_linear (Y -> Y -> Y
forall a. Num a => a -> a -> a
+Y
n)
scalar_subtract :: forall {k} (kind :: k). Y -> Signal kind -> Signal kind
scalar_subtract Y
n = (Y -> Y) -> Signal kind -> Signal kind
forall {k} (kind :: k). (Y -> Y) -> Signal kind -> Signal kind
map_y_linear (Y -> Y -> Y
forall a. Num a => a -> a -> a
subtract Y
n)
scalar_multiply :: forall {k} (kind :: k). Y -> Signal kind -> Signal kind
scalar_multiply Y
n = (Y -> Y) -> Signal kind -> Signal kind
forall {k} (kind :: k). (Y -> Y) -> Signal kind -> Signal kind
map_y_linear (Y -> Y -> Y
forall a. Num a => a -> a -> a
*Y
n)
scalar_divide :: forall {k} (kind :: k). Y -> Signal kind -> Signal kind
scalar_divide Y
n = (Y -> Y) -> Signal kind -> Signal kind
forall {k} (kind :: k). (Y -> Y) -> Signal kind -> Signal kind
map_y_linear (Y -> Y -> Y
forall a. Fractional a => a -> a -> a
/Y
n)

scalar_scale :: Y -> Signal kind -> Signal kind
scalar_scale :: forall {k} (kind :: k). Y -> Signal kind -> Signal kind
scalar_scale Y
n = (Y -> Y) -> Signal kind -> Signal kind
forall {k} (kind :: k). (Y -> Y) -> Signal kind -> Signal kind
map_y_linear (Y -> Y -> Y
scale Y
n)

-- | Clip signal to never go below the given value.
--
-- This is way more complicated than the piecewise constant version.
scalar_max :: Y -> Signal kind -> Signal kind
scalar_max :: forall {k} (kind :: k). Y -> Signal kind -> Signal kind
scalar_max Y
val Signal kind
sig
    | Signal kind -> Y
forall {k} (kind :: k). Signal kind -> Y
minimum Signal kind
sig Y -> Y -> Bool
forall a. Ord a => a -> a -> Bool
>= Y
val = Signal kind
sig
    | Bool
otherwise = (NumSignal -> NumSignal) -> Signal kind -> Signal kind
forall {k} (kind :: k).
(NumSignal -> NumSignal) -> Signal kind -> Signal kind
modify (([Sample Y] -> [Sample Y]) -> NumSignal -> NumSignal
forall (v :: * -> *) y.
Vector v (Sample y) =>
([Sample y] -> [Sample y]) -> SignalS v y -> SignalS v y
Segment.transform_samples [Sample Y] -> [Sample Y]
go) Signal kind
sig
    where
    go :: [Sample Y] -> [Sample Y]
go [] = []
    go [Sample RealTime
x Y
y] = [RealTime -> Y -> Sample Y
forall y. RealTime -> y -> Sample y
Sample RealTime
x (Y -> Y -> Y
forall a. Ord a => a -> a -> a
max Y
val Y
y)]
    go (s1 :: Sample Y
s1@(Sample RealTime
x1 Y
y1) : s2s :: [Sample Y]
s2s@(Sample RealTime
x2 Y
y2 : [Sample Y]
sn))
        | Y
y1 Y -> Y -> Bool
forall a. Ord a => a -> a -> Bool
< Y
val Bool -> Bool -> Bool
&& Y
y2 Y -> Y -> Bool
forall a. Ord a => a -> a -> Bool
< Y
val = RealTime -> Y -> Sample Y
forall y. RealTime -> y -> Sample y
Sample RealTime
x1 Y
val Sample Y -> [Sample Y] -> [Sample Y]
forall a. a -> [a] -> [a]
: [Sample Y] -> [Sample Y]
below (Sample Y
s1 Sample Y -> [Sample Y] -> [Sample Y]
forall a. a -> [a] -> [a]
: [Sample Y]
s2s)
        | Y
y1 Y -> Y -> Bool
forall a. Ord a => a -> a -> Bool
>= Y
val Bool -> Bool -> Bool
&& Y
y2 Y -> Y -> Bool
forall a. Ord a => a -> a -> Bool
>= Y
val = Sample Y
s1 Sample Y -> [Sample Y] -> [Sample Y]
forall a. a -> [a] -> [a]
: [Sample Y] -> [Sample Y]
go [Sample Y]
s2s
        | Bool
otherwise = case RealTime -> Y -> RealTime -> Y -> Y -> Maybe RealTime
TimeVector.x_at RealTime
x1 Y
y1 RealTime
x2 Y
y2 Y
val of
            Maybe RealTime
Nothing
                | Y
y1 Y -> Y -> Bool
forall a. Ord a => a -> a -> Bool
< Y
val -> RealTime -> Y -> Sample Y
forall y. RealTime -> y -> Sample y
Sample RealTime
x1 Y
val Sample Y -> [Sample Y] -> [Sample Y]
forall a. a -> [a] -> [a]
: [Sample Y] -> [Sample Y]
go (RealTime -> Y -> Sample Y
forall y. RealTime -> y -> Sample y
Sample RealTime
x2 Y
val Sample Y -> [Sample Y] -> [Sample Y]
forall a. a -> [a] -> [a]
: [Sample Y]
sn)
                | Bool
otherwise -> Sample Y
s1 Sample Y -> [Sample Y] -> [Sample Y]
forall a. a -> [a] -> [a]
: [Sample Y] -> [Sample Y]
go [Sample Y]
s2s
            Just RealTime
x_val
                | Y
y1 Y -> Y -> Bool
forall a. Ord a => a -> a -> Bool
< Y
val -> RealTime -> Y -> Sample Y
forall y. RealTime -> y -> Sample y
Sample RealTime
x1 Y
val Sample Y -> [Sample Y] -> [Sample Y]
forall a. a -> [a] -> [a]
: [Sample Y] -> [Sample Y]
go (RealTime -> Y -> Sample Y
forall y. RealTime -> y -> Sample y
Sample RealTime
x_val Y
val Sample Y -> [Sample Y] -> [Sample Y]
forall a. a -> [a] -> [a]
: [Sample Y]
s2s)
                | Bool
otherwise -> Sample Y
s1 Sample Y -> [Sample Y] -> [Sample Y]
forall a. a -> [a] -> [a]
: RealTime -> Y -> Sample Y
forall y. RealTime -> y -> Sample y
Sample RealTime
x_val Y
val Sample Y -> [Sample Y] -> [Sample Y]
forall a. a -> [a] -> [a]
: [Sample Y] -> [Sample Y]
below [Sample Y]
s2s
    -- The first sample is below val, discard until it comes back up again.
    below :: [Sample Y] -> [Sample Y]
below (Sample RealTime
x1 Y
y1 : s2s :: [Sample Y]
s2s@(Sample RealTime
x2 Y
y2 : [Sample Y]
_))
        | Y
y2 Y -> Y -> Bool
forall a. Ord a => a -> a -> Bool
< Y
val = [Sample Y] -> [Sample Y]
below [Sample Y]
s2s
        | Y
y2 Y -> Y -> Bool
forall a. Eq a => a -> a -> Bool
== Y
val = [Sample Y] -> [Sample Y]
go [Sample Y]
s2s
        | Bool
otherwise = case RealTime -> Y -> RealTime -> Y -> Y -> Maybe RealTime
TimeVector.x_at RealTime
x1 Y
y1 RealTime
x2 Y
y2 Y
val of
            -- y1 and y2 are both below, should have been caught above.
            Maybe RealTime
Nothing -> [Sample Y] -> [Sample Y]
below [Sample Y]
s2s
            Just RealTime
x_val -> [Sample Y] -> [Sample Y]
go (RealTime -> Y -> Sample Y
forall y. RealTime -> y -> Sample y
Sample RealTime
x_val Y
val Sample Y -> [Sample Y] -> [Sample Y]
forall a. a -> [a] -> [a]
: [Sample Y]
s2s)
    below [Sample Y
_] = []
    below [] = []

minimum, maximum :: Signal kind -> Y
minimum :: forall {k} (kind :: k). Signal kind -> Y
minimum = Y -> Maybe Y -> Y
forall a. a -> Maybe a -> a
fromMaybe Y
0 (Maybe Y -> Y) -> (Signal kind -> Maybe Y) -> Signal kind -> Y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumSignal -> Maybe Y
forall (v :: * -> *) a.
(Vector v (Sample a), Ord a) =>
SignalS v a -> Maybe a
Segment.minimum (NumSignal -> Maybe Y)
-> (Signal kind -> NumSignal) -> Signal kind -> Maybe Y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal
maximum :: forall {k} (kind :: k). Signal kind -> Y
maximum = Y -> Maybe Y -> Y
forall a. a -> Maybe a -> a
fromMaybe Y
0 (Maybe Y -> Y) -> (Signal kind -> Maybe Y) -> Signal kind -> Y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumSignal -> Maybe Y
forall (v :: * -> *) a.
(Vector v (Sample a), Ord a) =>
SignalS v a -> Maybe a
Segment.maximum (NumSignal -> Maybe Y)
-> (Signal kind -> NumSignal) -> Signal kind -> Maybe Y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal

find :: (X -> Y -> Bool) -> Signal kind -> Maybe (X, Y)
find :: forall {k} (kind :: k).
(RealTime -> Y -> Bool) -> Signal kind -> Maybe (RealTime, Y)
find RealTime -> Y -> Bool
f = (RealTime -> Y -> Bool) -> NumSignal -> Maybe (RealTime, Y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
(RealTime -> y -> Bool)
-> Signal (v (Sample y)) -> Maybe (RealTime, y)
Segment.find RealTime -> Y -> Bool
f (NumSignal -> Maybe (RealTime, Y))
-> (Signal kind -> NumSignal) -> Signal kind -> Maybe (RealTime, Y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal

-- | Map Xs.  The slopes will definitely change unless the function is adding
-- a constant, but presumably that's what you want.
{-# SCC map_x #-}
map_x :: (X -> X) -> Signal kind -> Signal kind
map_x :: forall {k} (kind :: k).
(RealTime -> RealTime) -> Signal kind -> Signal kind
map_x = (NumSignal -> NumSignal) -> Signal kind -> Signal kind
forall {k} (kind :: k).
(NumSignal -> NumSignal) -> Signal kind -> Signal kind
modify ((NumSignal -> NumSignal) -> Signal kind -> Signal kind)
-> ((RealTime -> RealTime) -> NumSignal -> NumSignal)
-> (RealTime -> RealTime)
-> Signal kind
-> Signal kind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RealTime -> RealTime) -> NumSignal -> NumSignal
forall (v :: * -> *) y.
Vector v (Sample y) =>
(RealTime -> RealTime) -> SignalS v y -> SignalS v y
Segment.map_x

-- | Map Ys.  This resamples the signal, so it's valid for a nonlinear
-- function.
{-# SCC map_y #-}
map_y :: X -> (Y -> Y) -> Signal kind -> Signal kind
map_y :: forall {k} (kind :: k).
RealTime -> (Y -> Y) -> Signal kind -> Signal kind
map_y RealTime
srate = (NumSignal -> NumSignal) -> Signal kind -> Signal kind
forall {k} (kind :: k).
(NumSignal -> NumSignal) -> Signal kind -> Signal kind
modify ((NumSignal -> NumSignal) -> Signal kind -> Signal kind)
-> ((Y -> Y) -> NumSignal -> NumSignal)
-> (Y -> Y)
-> Signal kind
-> Signal kind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealTime -> (Y -> Y) -> NumSignal -> NumSignal
Segment.map_y RealTime
srate

-- | If the function is linear, there's no need to resample.
{-# SCC map_y_linear #-}
map_y_linear :: (Y -> Y) -> Signal kind -> Signal kind
map_y_linear :: forall {k} (kind :: k). (Y -> Y) -> Signal kind -> Signal kind
map_y_linear = (NumSignal -> NumSignal) -> Signal kind -> Signal kind
forall {k} (kind :: k).
(NumSignal -> NumSignal) -> Signal kind -> Signal kind
modify ((NumSignal -> NumSignal) -> Signal kind -> Signal kind)
-> ((Y -> Y) -> NumSignal -> NumSignal)
-> (Y -> Y)
-> Signal kind
-> Signal kind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Y -> Y) -> NumSignal -> NumSignal
forall (v :: * -> *) y.
Vector v (Sample y) =>
(y -> y) -> SignalS v y -> SignalS v y
Segment.map_y_linear

map_err :: (Sample Y -> Either err (Sample Y)) -> Signal kind
    -> (Signal kind, [err])
map_err :: forall {k} err (kind :: k).
(Sample Y -> Either err (Sample Y))
-> Signal kind -> (Signal kind, [err])
map_err Sample Y -> Either err (Sample Y)
f = (NumSignal -> Signal kind)
-> (NumSignal, [err]) -> (Signal kind, [err])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first NumSignal -> Signal kind
forall {k} (kind :: k). NumSignal -> Signal kind
Signal ((NumSignal, [err]) -> (Signal kind, [err]))
-> (Signal kind -> (NumSignal, [err]))
-> Signal kind
-> (Signal kind, [err])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sample Y -> Either err (Sample Y))
-> NumSignal -> (NumSignal, [err])
forall (v :: * -> *) y err.
Vector v (Sample y) =>
(Sample y -> Either err (Sample y))
-> SignalS v y -> (SignalS v y, [err])
Segment.map_err Sample Y -> Either err (Sample Y)
f (NumSignal -> (NumSignal, [err]))
-> (Signal kind -> NumSignal) -> Signal kind -> (NumSignal, [err])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal kind -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal

-- * special functions

integrate_inverse :: Tempo -> Warp
integrate_inverse :: Tempo -> Warp
integrate_inverse = Tempo -> Warp
integrate (Tempo -> Warp) -> (Tempo -> Tempo) -> Tempo -> Warp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealTime -> (Y -> Y) -> Tempo -> Tempo
forall {k} (kind :: k).
RealTime -> (Y -> Y) -> Signal kind -> Signal kind
map_y RealTime
tempo_srate (Y
1/)

-- | Integrate the signal.
--
-- Since the output will have more samples than the input, this needs
-- a sampling rate.  The sampling rate determines the resolution of the tempo
-- track.  So it can probably be fairly low resolution before having
-- a noticeable impact.
--
-- TODO this is only called after map_y at srate, so it's already been
-- resampled.  Maybe it would be more efficient to remove srate from
-- Segment.integrate.
integrate :: Tempo -> Warp
integrate :: Tempo -> Warp
integrate = NumSignal -> Warp
forall {k} (kind :: k). NumSignal -> Signal kind
Signal (NumSignal -> Warp) -> (Tempo -> NumSignal) -> Tempo -> Warp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealTime -> NumSignal -> NumSignal
Segment.integrate RealTime
tempo_srate (NumSignal -> NumSignal)
-> (Tempo -> NumSignal) -> Tempo -> NumSignal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tempo -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal

tempo_srate :: X
tempo_srate :: RealTime
tempo_srate = Y -> RealTime
RealTime.seconds Y
10

-- | Total duration of horizontal segments in the warp signal.  These are
-- the places where 'Warp.compose_hybrid' will emit a 1\/1 line.
_flat_duration :: Warp -> ScoreTime
_flat_duration :: Warp -> ScoreTime
_flat_duration =
    RealTime -> ScoreTime
RealTime.to_score (RealTime -> ScoreTime) -> (Warp -> RealTime) -> Warp -> ScoreTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RealTime, Sample Y) -> RealTime
forall a b. (a, b) -> a
fst ((RealTime, Sample Y) -> RealTime)
-> (Warp -> (RealTime, Sample Y)) -> Warp -> RealTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((RealTime, Sample Y) -> Sample Y -> (RealTime, Sample Y))
-> (RealTime, Sample Y)
-> Vector (Sample Y)
-> (RealTime, Sample Y)
forall b a. Storable b => (a -> b -> a) -> a -> Vector b -> a
Vector.foldl' (RealTime, Sample Y) -> Sample Y -> (RealTime, Sample Y)
forall {a}.
Eq a =>
(RealTime, Sample a) -> Sample a -> (RealTime, Sample a)
go (RealTime
0, RealTime -> Y -> Sample Y
forall y. RealTime -> y -> Sample y
Segment.Sample RealTime
0 Y
0)
        (Vector (Sample Y) -> (RealTime, Sample Y))
-> (Warp -> Vector (Sample Y)) -> Warp -> (RealTime, Sample Y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumSignal -> Vector (Sample Y)
forall (v :: * -> *) y.
Vector v (Sample y) =>
SignalS v y -> v (Sample y)
Segment.to_vector (NumSignal -> Vector (Sample Y))
-> (Warp -> NumSignal) -> Warp -> Vector (Sample Y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Warp -> NumSignal
forall {k} (kind :: k). Signal kind -> NumSignal
_signal
    where
    go :: (RealTime, Sample a) -> Sample a -> (RealTime, Sample a)
go (!RealTime
acc, Segment.Sample RealTime
x0 a
y0) sample :: Sample a
sample@(Segment.Sample RealTime
x a
y)
        | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y0 = (RealTime
acc RealTime -> RealTime -> RealTime
forall a. Num a => a -> a -> a
+ (RealTime
x RealTime -> RealTime -> RealTime
forall a. Num a => a -> a -> a
- RealTime
x0), Sample a
sample)
        | Bool
otherwise = (RealTime
acc, Sample a
sample)