-- 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 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 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 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)