-- 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.Lists as Lists

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 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 =
    forall a. Floating a => a -> a
sqrt forall a b. (a -> b) -> a -> b
$ forall a. (Storable a, Num a) => Vector a -> a
V.sum (forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
V.map (\Float
n -> Float
nforall a. Num a => a -> a -> a
*Float
n) Vector Float
block) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (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 = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {b} {b}. (a, (a, b), b) -> (a, b)
get forall a b. (a -> b) -> a -> b
$ 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 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) (rate :: Nat).
Monad m =>
Frames -> Audio m rate 1 -> m (Maybe (Block, Audio m rate 1))
takeExtend Frames
frames) [Audio1]
streams
    forall (m :: * -> *) a. Monad m => a -> m a
return
        ( forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [(control
c, Block
block) | (control
c, Just (Block
block, Audio1
_)) <- forall a b. [a] -> [b] -> [(a, b)]
zip [control]
controls [Maybe (Block, Audio1)]
nexts]
        , forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [(control
c, Audio1
stream) | (control
c, Just (Block
_, Audio1
stream)) <- forall a b. [a] -> [b] -> [(a, b)]
zip [control]
controls [Maybe (Block, Audio1)]
nexts]
        )
    where
    ([control]
controls, [Audio1]
streams) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ 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) <- 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 = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Bool
Audio.isEmptyBlock) [Block]
blocks_
    let missing :: Int
missing = forall (chan :: Nat). KnownNat chan => Proxy chan -> Frames -> Int
Audio.framesCount (forall {k} (t :: k). Proxy t
Proxy @1) forall a b. (a -> b) -> a -> b
$
            Frames
frames forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum (forall a b. (a -> b) -> [a] -> [b]
map (forall (chan :: Nat).
KnownNat chan =>
Proxy chan -> Block -> Frames
Audio.blockFrames (forall {k} (t :: k). Proxy t
Proxy @1)) [Block]
blocks)
    let final :: Float
final = case forall a. [a] -> a
last [Block]
blocks of
            Audio.Constant Int
_ Float
val -> Float
val
            Audio.Block Vector Float
v -> forall a. Storable a => Vector a -> a
V.last Vector Float
v
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
blocks then forall a. Maybe a
Nothing
        else if Int
missing forall a. Eq a => a -> a -> Bool
== Int
0 then forall a. a -> Maybe a
Just (forall a. Monoid a => [a] -> a
mconcat [Block]
blocks, Audio m rate 1
audio)
        else forall a. a -> Maybe a
Just (forall a. Monoid a => [a] -> a
mconcat ([Block]
blocks 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?
        forall (m :: * -> *) (rate1 :: Nat) (chan :: Nat) (rate2 :: Nat).
Audio m rate1 chan -> Audio m rate2 chan
Audio.castRate 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {c}. [(Double, c)] -> [(Double, c)]
shiftBack
    where shiftBack :: [(Double, c)] -> [(Double, c)]
shiftBack = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a -> a
subtract 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 =
    forall x y. (Eq x, Eq y) => [(x, y)] -> [(x, y)]
Segment.simplify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {k} {kind :: k} {b}.
((RealTime, Map Control (Signal kind)), Maybe (RealTime, b))
-> Maybe [(Double, Double)]
get forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [(a, Maybe a)]
Lists.zipNext
    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 <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Control
control Map Control (Signal kind)
controls
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (if Frames
controlSize forall a. Eq a => a -> a -> Bool
== Frames
1 then forall a. a -> a
id else forall {c}. [(Double, c)] -> [(Double, c)]
tweak) forall a b. (a -> b) -> a -> b
$
            Frames -> [(RealTime, Double)] -> [(Double, Double)]
roundBreakpoints Frames
controlSize forall a b. (a -> b) -> a -> b
$ forall {k} (kind :: k). Signal kind -> [(RealTime, Double)]
Signal.to_pairs forall a b. (a -> b) -> a -> b
$
            forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall {k} (kind :: k). RealTime -> Signal kind -> Signal kind
Signal.clip_after_keep_last forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Maybe (RealTime, b)
next forall a b. (a -> b) -> a -> b
$
            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 forall a b. (a -> b) -> a -> b
$ Frames -> RealTime
AUtil.toSeconds Frames
controlSize
    -- See NOTE [faust-controls].
    tweak :: [(Double, c)] -> [(Double, c)]
tweak = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
== Frames
1 = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first RealTime -> Double
RealTime.to_seconds)
    | Bool
otherwise = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (RealTime -> Double
RealTime.to_seconds 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Double
Num.roundToD (RealTime -> Double
RealTime.to_seconds RealTime
factor) forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealTime -> Double
RealTime.to_seconds