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