-- Copyright 2020 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 DataKinds #-} {-# LANGUAGE TypeApplications #-} -- | Functions shared between instrument and effect faust patches. module Synth.Faust.RenderUtil where import qualified Control.Monad.Trans.Resource as Resource import qualified Data.Map as Map import qualified Data.Vector.Storable as V import qualified GHC.TypeLits as TypeLits import qualified Util.Audio.Audio as Audio import qualified Util.Maps as Maps import qualified Util.Num as Num import qualified Util.Segment as Segment import qualified Util.Seq as Seq import qualified Perform.RealTime as RealTime import Perform.RealTime (RealTime) import qualified Synth.Lib.AUtil as AUtil import qualified Synth.Shared.Control as Control import qualified Synth.Shared.Signal as Signal import Global isBasicallySilent :: V.Vector Audio.Sample -> Bool isBasicallySilent :: Vector Float -> Bool isBasicallySilent Vector Float samples = Vector Float -> Float rms Vector Float samples Float -> Float -> Bool forall a. Ord a => a -> a -> Bool < Float -> Float Audio.dbToLinear (-Float 82) -- I arrived at the dB by just trying it and seeing how it sounds. rms :: V.Vector Float -> Float rms :: Vector Float -> Float rms Vector Float block = Float -> Float forall a. Floating a => a -> a sqrt (Float -> Float) -> Float -> Float forall a b. (a -> b) -> a -> b $ Vector Float -> Float forall a. (Storable a, Num a) => Vector a -> a V.sum ((Float -> Float) -> Vector Float -> Vector Float forall a b. (Storable a, Storable b) => (a -> b) -> Vector a -> Vector b V.map (\Float n -> Float nFloat -> Float -> Float forall a. Num a => a -> a -> a *Float n) Vector Float block) Float -> Float -> Float forall a. Fractional a => a -> a -> a / Int -> Float forall a b. (Integral a, Num b) => a -> b fromIntegral (Vector Float -> Int forall a. Storable a => Vector a -> Int V.length Vector Float block) -- * controls findControls :: Ord control => Map control (ptr, config) -> Map control block -> [(ptr, block)] findControls :: forall control ptr config block. Ord control => Map control (ptr, config) -> Map control block -> [(ptr, block)] findControls Map control (ptr, config) controls Map control block vals = ((control, (ptr, config), block) -> (ptr, block)) -> [(control, (ptr, config), block)] -> [(ptr, block)] forall a b. (a -> b) -> [a] -> [b] map (control, (ptr, config), block) -> (ptr, block) forall {a} {a} {b} {b}. (a, (a, b), b) -> (a, b) get ([(control, (ptr, config), block)] -> [(ptr, block)]) -> [(control, (ptr, config), block)] -> [(ptr, block)] forall a b. (a -> b) -> a -> b $ Map control (ptr, config) -> Map control block -> [(control, (ptr, config), block)] forall k v1 v2. Ord k => Map k v1 -> Map k v2 -> [(k, v1, v2)] Maps.zipIntersection Map control (ptr, config) controls Map control block vals where get :: (a, (a, b), b) -> (a, b) get (a _, (a ptr, b _), b block) = (a ptr, b block) -- | Pull a chunk from each of the controls. Omit the control if its signal -- has run out. This is ok because controls naturally retain their last value. takeControls :: Ord control => Audio.Frames -> Map control AUtil.Audio1 -> Resource.ResourceT IO (Map control Audio.Block, Map control AUtil.Audio1) takeControls :: forall control. Ord control => Frames -> Map control Audio1 -> ResourceT IO (Map control Block, Map control Audio1) takeControls Frames frames Map control Audio1 controlStreams = do [Maybe (Block, Audio1)] nexts <- (Audio1 -> ResourceT IO (Maybe (Block, Audio1))) -> [Audio1] -> ResourceT IO [Maybe (Block, Audio1)] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM (Frames -> Audio1 -> ResourceT IO (Maybe (Block, Audio1)) forall (m :: * -> *) (rate :: Nat). Monad m => Frames -> Audio m rate 1 -> m (Maybe (Block, Audio m rate 1)) takeExtend Frames frames) [Audio1] streams (Map control Block, Map control Audio1) -> ResourceT IO (Map control Block, Map control Audio1) forall (m :: * -> *) a. Monad m => a -> m a return ( [(control, Block)] -> Map control Block forall k a. Ord k => [(k, a)] -> Map k a Map.fromList [(control c, Block block) | (control c, Just (Block block, Audio1 _)) <- [control] -> [Maybe (Block, Audio1)] -> [(control, Maybe (Block, Audio1))] forall a b. [a] -> [b] -> [(a, b)] zip [control] controls [Maybe (Block, Audio1)] nexts] , [(control, Audio1)] -> Map control Audio1 forall k a. Ord k => [(k, a)] -> Map k a Map.fromList [(control c, Audio1 stream) | (control c, Just (Block _, Audio1 stream)) <- [control] -> [Maybe (Block, Audio1)] -> [(control, Maybe (Block, Audio1))] forall a b. [a] -> [b] -> [(a, b)] zip [control] controls [Maybe (Block, Audio1)] nexts] ) where ([control] controls, [Audio1] streams) = [(control, Audio1)] -> ([control], [Audio1]) forall a b. [(a, b)] -> ([a], [b]) unzip ([(control, Audio1)] -> ([control], [Audio1])) -> [(control, Audio1)] -> ([control], [Audio1]) forall a b. (a -> b) -> a -> b $ Map control Audio1 -> [(control, Audio1)] forall k a. Map k a -> [(k, a)] Map.toList Map control Audio1 controlStreams -- | 'Audio.splitAt', but extend the final sample. I need this because -- PatchC.render relies on all control blocks being the same length, for -- simplicity. takeExtend :: Monad m => Audio.Frames -> Audio.Audio m rate 1 -> m (Maybe (Audio.Block, Audio.Audio m rate 1)) takeExtend :: forall (m :: * -> *) (rate :: Nat). Monad m => Frames -> Audio m rate 1 -> m (Maybe (Block, Audio m rate 1)) takeExtend Frames frames Audio m rate 1 audio = do ([Block] blocks_, Audio m rate 1 audio) <- Frames -> Audio m rate 1 -> m ([Block], Audio m rate 1) forall (m :: * -> *) (rate :: Nat) (chan :: Nat). (Monad m, KnownNat chan) => Frames -> Audio m rate chan -> m ([Block], Audio m rate chan) Audio.splitAt Frames frames Audio m rate 1 audio let blocks :: [Block] blocks = (Block -> Bool) -> [Block] -> [Block] forall a. (a -> Bool) -> [a] -> [a] filter (Bool -> Bool not (Bool -> Bool) -> (Block -> Bool) -> Block -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Block -> Bool Audio.isEmptyBlock) [Block] blocks_ let missing :: Int missing = Proxy 1 -> Frames -> Int forall (chan :: Nat). KnownNat chan => Proxy chan -> Frames -> Int Audio.framesCount (forall {t :: Nat}. Proxy t forall {k} (t :: k). Proxy t Proxy @1) (Frames -> Int) -> Frames -> Int forall a b. (a -> b) -> a -> b $ Frames frames Frames -> Frames -> Frames forall a. Num a => a -> a -> a - [Frames] -> Frames forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a Num.sum ((Block -> Frames) -> [Block] -> [Frames] forall a b. (a -> b) -> [a] -> [b] map (Proxy 1 -> Block -> Frames forall (chan :: Nat). KnownNat chan => Proxy chan -> Block -> Frames Audio.blockFrames (forall {t :: Nat}. Proxy t forall {k} (t :: k). Proxy t Proxy @1)) [Block] blocks) let final :: Float final = case [Block] -> Block forall a. [a] -> a last [Block] blocks of Audio.Constant Int _ Float val -> Float val Audio.Block Vector Float v -> Vector Float -> Float forall a. Storable a => Vector a -> a V.last Vector Float v Maybe (Block, Audio m rate 1) -> m (Maybe (Block, Audio m rate 1)) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe (Block, Audio m rate 1) -> m (Maybe (Block, Audio m rate 1))) -> Maybe (Block, Audio m rate 1) -> m (Maybe (Block, Audio m rate 1)) forall a b. (a -> b) -> a -> b $ if [Block] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [Block] blocks then Maybe (Block, Audio m rate 1) forall a. Maybe a Nothing else if Int missing Int -> Int -> Bool forall a. Eq a => a -> a -> Bool == Int 0 then (Block, Audio m rate 1) -> Maybe (Block, Audio m rate 1) forall a. a -> Maybe a Just ([Block] -> Block forall a. Monoid a => [a] -> a mconcat [Block] blocks, Audio m rate 1 audio) else (Block, Audio m rate 1) -> Maybe (Block, Audio m rate 1) forall a. a -> Maybe a Just ([Block] -> Block forall a. Monoid a => [a] -> a mconcat ([Block] blocks [Block] -> [Block] -> [Block] forall a. [a] -> [a] -> [a] ++ [Int -> Float -> Block Audio.Constant Int missing Float final]), Audio m rate 1 audio) renderControl :: Monad m => Int -> RealTime -> [(Double, Double)] -> Audio.Audio m rate 1 renderControl :: forall (m :: * -> *) (rate :: Nat). Monad m => Int -> RealTime -> [(Double, Double)] -> Audio m rate 1 renderControl Int controlRate RealTime start = case Int -> SomeNat Audio.someNat Int controlRate of TypeLits.SomeNat (Proxy n _ :: Proxy cRate) -> -- Audio.linear gets its breakpoints in seconds, so I have to do this -- little dance. Maybe it could use frames? Audio m n 1 -> Audio m rate 1 forall (m :: * -> *) (rate1 :: Nat) (chan :: Nat) (rate2 :: Nat). Audio m rate1 chan -> Audio m rate2 chan Audio.castRate (Audio m n 1 -> Audio m rate 1) -> ([(Double, Double)] -> Audio m n 1) -> [(Double, Double)] -> Audio m rate 1 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *) (rate :: Nat). (Monad m, KnownNat rate) => Bool -> [(Double, Double)] -> Audio m rate 1 Audio.linear @_ @cRate Bool False ([(Double, Double)] -> Audio m n 1) -> ([(Double, Double)] -> [(Double, Double)]) -> [(Double, Double)] -> Audio m n 1 forall b c a. (b -> c) -> (a -> b) -> a -> c . [(Double, Double)] -> [(Double, Double)] forall {c}. [(Double, c)] -> [(Double, c)] shiftBack where shiftBack :: [(Double, c)] -> [(Double, c)] shiftBack = ((Double, c) -> (Double, c)) -> [(Double, c)] -> [(Double, c)] forall a b. (a -> b) -> [a] -> [b] map (((Double, c) -> (Double, c)) -> [(Double, c)] -> [(Double, c)]) -> ((Double, c) -> (Double, c)) -> [(Double, c)] -> [(Double, c)] forall a b. (a -> b) -> a -> b $ (Double -> Double) -> (Double, c) -> (Double, c) forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first ((Double -> Double) -> (Double, c) -> (Double, c)) -> (Double -> Double) -> (Double, c) -> (Double, c) forall a b. (a -> b) -> a -> b $ Double -> Double -> Double forall a. Num a => a -> a -> a subtract (Double -> Double -> Double) -> Double -> Double -> Double forall a b. (a -> b) -> a -> b $ RealTime -> Double RealTime.to_seconds RealTime start controlBreakpoints :: Audio.Frames -> Control.Control -> [(RealTime, Map Control.Control Signal.Signal)] -> [(Double, Double)] controlBreakpoints :: Frames -> Control -> [(RealTime, Map Control Signal)] -> [(Double, Double)] controlBreakpoints Frames controlSize Control control = [(Double, Double)] -> [(Double, Double)] forall x y. (Eq x, Eq y) => [(x, y)] -> [(x, y)] Segment.simplify ([(Double, Double)] -> [(Double, Double)]) -> ([(RealTime, Map Control Signal)] -> [(Double, Double)]) -> [(RealTime, Map Control Signal)] -> [(Double, Double)] forall b c a. (b -> c) -> (a -> b) -> a -> c . [[(Double, Double)]] -> [(Double, Double)] forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat ([[(Double, Double)]] -> [(Double, Double)]) -> ([(RealTime, Map Control Signal)] -> [[(Double, Double)]]) -> [(RealTime, Map Control Signal)] -> [(Double, Double)] forall b c a. (b -> c) -> (a -> b) -> a -> c . (((RealTime, Map Control Signal), Maybe (RealTime, Map Control Signal)) -> Maybe [(Double, Double)]) -> [((RealTime, Map Control Signal), Maybe (RealTime, Map Control Signal))] -> [[(Double, Double)]] forall a b. (a -> Maybe b) -> [a] -> [b] mapMaybe ((RealTime, Map Control Signal), Maybe (RealTime, Map Control Signal)) -> Maybe [(Double, Double)] forall {k} {kind :: k} {b}. ((RealTime, Map Control (Signal kind)), Maybe (RealTime, b)) -> Maybe [(Double, Double)] get ([((RealTime, Map Control Signal), Maybe (RealTime, Map Control Signal))] -> [[(Double, Double)]]) -> ([(RealTime, Map Control Signal)] -> [((RealTime, Map Control Signal), Maybe (RealTime, Map Control Signal))]) -> [(RealTime, Map Control Signal)] -> [[(Double, Double)]] forall b c a. (b -> c) -> (a -> b) -> a -> c . [(RealTime, Map Control Signal)] -> [((RealTime, Map Control Signal), Maybe (RealTime, Map Control Signal))] forall a. [a] -> [(a, Maybe a)] Seq.zip_next where get :: ((RealTime, Map Control (Signal kind)), Maybe (RealTime, b)) -> Maybe [(Double, Double)] get ((RealTime start, Map Control (Signal kind) controls), Maybe (RealTime, b) next) = do Signal kind signal <- Control -> Map Control (Signal kind) -> Maybe (Signal kind) forall k a. Ord k => k -> Map k a -> Maybe a Map.lookup Control control Map Control (Signal kind) controls [(Double, Double)] -> Maybe [(Double, Double)] forall (m :: * -> *) a. Monad m => a -> m a return ([(Double, Double)] -> Maybe [(Double, Double)]) -> [(Double, Double)] -> Maybe [(Double, Double)] forall a b. (a -> b) -> a -> b $ (if Frames controlSize Frames -> Frames -> Bool forall a. Eq a => a -> a -> Bool == Frames 1 then [(Double, Double)] -> [(Double, Double)] forall a. a -> a id else [(Double, Double)] -> [(Double, Double)] forall {c}. [(Double, c)] -> [(Double, c)] tweak) ([(Double, Double)] -> [(Double, Double)]) -> [(Double, Double)] -> [(Double, Double)] forall a b. (a -> b) -> a -> b $ Frames -> [(RealTime, Double)] -> [(Double, Double)] roundBreakpoints Frames controlSize ([(RealTime, Double)] -> [(Double, Double)]) -> [(RealTime, Double)] -> [(Double, Double)] forall a b. (a -> b) -> a -> b $ Signal kind -> [(RealTime, Double)] forall {k} (kind :: k). Signal kind -> [(RealTime, Double)] Signal.to_pairs (Signal kind -> [(RealTime, Double)]) -> Signal kind -> [(RealTime, Double)] forall a b. (a -> b) -> a -> b $ (Signal kind -> Signal kind) -> ((RealTime, b) -> Signal kind -> Signal kind) -> Maybe (RealTime, b) -> Signal kind -> Signal kind forall b a. b -> (a -> b) -> Maybe a -> b maybe Signal kind -> Signal kind forall a. a -> a id (RealTime -> Signal kind -> Signal kind forall {k} (kind :: k). RealTime -> Signal kind -> Signal kind Signal.clip_after_keep_last (RealTime -> Signal kind -> Signal kind) -> ((RealTime, b) -> RealTime) -> (RealTime, b) -> Signal kind -> Signal kind forall b c a. (b -> c) -> (a -> b) -> a -> c . (RealTime, b) -> RealTime forall a b. (a, b) -> a fst) Maybe (RealTime, b) next (Signal kind -> Signal kind) -> Signal kind -> Signal kind forall a b. (a -> b) -> a -> b $ RealTime -> Signal kind -> Signal kind forall {k} (kind :: k). RealTime -> Signal kind -> Signal kind Signal.clip_before RealTime start Signal kind signal controlSizeS :: Double controlSizeS = RealTime -> Double RealTime.to_seconds (RealTime -> Double) -> RealTime -> Double forall a b. (a -> b) -> a -> b $ Frames -> RealTime AUtil.toSeconds Frames controlSize -- See NOTE [faust-controls]. tweak :: [(Double, c)] -> [(Double, c)] tweak = ((Double, c) -> (Double, c)) -> [(Double, c)] -> [(Double, c)] forall a b. (a -> b) -> [a] -> [b] map (((Double, c) -> (Double, c)) -> [(Double, c)] -> [(Double, c)]) -> ((Double, c) -> (Double, c)) -> [(Double, c)] -> [(Double, c)] forall a b. (a -> b) -> a -> b $ (Double -> Double) -> (Double, c) -> (Double, c) forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first ((Double -> Double) -> (Double, c) -> (Double, c)) -> (Double -> Double) -> (Double, c) -> (Double, c) forall a b. (a -> b) -> a -> b $ Double -> Double -> Double forall a. Num a => a -> a -> a subtract Double controlSizeS -- | Round controls to controlSize boundaries. See NOTE [faust-controls]. roundBreakpoints :: Audio.Frames -> [(RealTime, Signal.Y)] -> [(Double, Double)] roundBreakpoints :: Frames -> [(RealTime, Double)] -> [(Double, Double)] roundBreakpoints Frames controlSize | Frames controlSize Frames -> Frames -> Bool forall a. Eq a => a -> a -> Bool == Frames 1 = ((RealTime, Double) -> (Double, Double)) -> [(RealTime, Double)] -> [(Double, Double)] forall a b. (a -> b) -> [a] -> [b] map ((RealTime -> Double) -> (RealTime, Double) -> (Double, Double) forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first RealTime -> Double RealTime.to_seconds) | Bool otherwise = ((RealTime, Double) -> (Double, Double)) -> [(RealTime, Double)] -> [(Double, Double)] forall a b. (a -> b) -> [a] -> [b] map ((RealTime -> Double) -> (RealTime, Double) -> (Double, Double) forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first (RealTime -> Double RealTime.to_seconds (RealTime -> Double) -> (RealTime -> RealTime) -> RealTime -> Double forall b c a. (b -> c) -> (a -> b) -> a -> c . RealTime -> RealTime -> RealTime roundTo RealTime size)) where size :: RealTime size = Frames -> RealTime AUtil.toSeconds Frames controlSize roundTo :: RealTime -> RealTime -> RealTime roundTo :: RealTime -> RealTime -> RealTime roundTo RealTime factor = Double -> RealTime RealTime.seconds (Double -> RealTime) -> (RealTime -> Double) -> RealTime -> RealTime forall b c a. (b -> c) -> (a -> b) -> a -> c . Double -> Double -> Double Num.roundToD (RealTime -> Double RealTime.to_seconds RealTime factor) (Double -> Double) -> (RealTime -> Double) -> RealTime -> Double forall b c a. (b -> c) -> (a -> b) -> a -> c . RealTime -> Double RealTime.to_seconds