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

-- | High level binding to faust dsps, treated as audio effect processors.
module Synth.Faust.Effect (
    Patch, EffectT(..)
    , Config(..), controlRate
    , config
    , process
) where
import qualified Control.Monad.Trans.Resource as Resource
import qualified Data.Vector.Storable as V
import qualified Streaming.Prelude as S

import qualified Util.Audio.Audio as Audio
import qualified Util.Control
import qualified Util.Num as Num

import qualified Synth.Faust.EffectC as EffectC
import           Synth.Faust.EffectC (Patch, EffectT(..))
import qualified Synth.Faust.RenderUtil as RenderUtil
import qualified Synth.Lib.AUtil as AUtil
import qualified Synth.Shared.Config as Config
import qualified Synth.Shared.Control as Control

import           Global


-- TODO this has to be initialized to be consistent with the sampler
data Config = Config {
    Config -> Frames
_blockSize :: !Audio.Frames
    -- | This is _blockSize / _controlsPerBlock
    , Config -> Frames
_controlSize :: !Audio.Frames
    -- | This is _blockSize / _controlSize
    , Config -> Frames
_controlsPerBlock :: !Audio.Frames
    -- | Force an end if the signal hasn't gone to zero before this.
    , Config -> Frames
_maxDecay :: !Audio.Frames
    } deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show)

-- TODO duplicated with Faust.Render.Config

-- | Control signals run at this rate.
--
-- This should divide into Config.blockSize, which in turn divides into
-- Config.SamplingRate.
controlRate :: Config -> Int
controlRate :: Config -> Int
controlRate Config
config = forall f i. (HasCallStack, RealFrac f, Integral i) => f -> i
Num.assertIntegral forall a b. (a -> b) -> a -> b
$
    forall a b. (Integral a, Num b) => a -> b
fromIntegral (Config -> Frames
_controlsPerBlock Config
config) forall a. Num a => a -> a -> a
* Double
blocksPerSecond
    where
    blocksPerSecond :: Double
blocksPerSecond =
        forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Config.samplingRate forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Config -> Frames
_blockSize Config
config)

config :: Audio.Frames -> Audio.Frames -> Config
config :: Frames -> Frames -> Config
config Frames
blockSize Frames
controlsPerBlock = Config
    { _blockSize :: Frames
_blockSize = Frames
blockSize
    , _controlSize :: Frames
_controlSize = Frames
blockSize forall a. (HasCallStack, Integral a) => a -> a -> a
`Num.assertDiv` Frames
controlsPerBlock
    , _controlsPerBlock :: Frames
_controlsPerBlock = Frames
controlsPerBlock
    , _maxDecay :: Frames
_maxDecay = RealTime -> Frames
AUtil.toFrames RealTime
32
    }

process :: Config
    -> Patch
    -> Maybe EffectC.State
    -> (EffectC.State -> IO ()) -- ^ notify new state after each audio chunk
    -> Map Control.Control AUtil.Audio1
    -> AUtil.Audio -> AUtil.Audio
process :: Config
-> Patch
-> Maybe State
-> (State -> IO ())
-> Map Control Audio1
-> Audio
-> Audio
process Config
config Patch
patch Maybe State
mbState State -> IO ()
notifyState Map Control Audio1
controls Audio
input = forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
Stream (Of Block) m () -> Audio m rate chan
Audio.Audio forall a b. (a -> b) -> a -> b
$ do
    -- This never exits on its own, so the effect is only destroyed when the
    -- audio as a whole is complete.
    (ReleaseKey
key, Effect
effect) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
Resource.allocate (Patch -> IO Effect
EffectC.allocate Patch
patch) Effect -> IO ()
EffectC.destroy
    forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe State
mbState forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Effect -> State -> IO ()
EffectC.putState Effect
effect
    Stream (Of [Block]) (ResourceT IO) ()
input <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (rate :: Nat).
NAudio m rate -> Stream (Of [Block]) m ()
Audio._nstream forall a b. (a -> b) -> a -> b
$ -- Audio.zeroPadN (_blockSize config) $
        forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
(Monad m, KnownNat chan) =>
Audio m rate chan -> NAudio m rate
Audio.splitChannels Audio
input
    forall state a. state -> ((state -> a) -> state -> a) -> a
Util.Control.loop1 (Map Control Audio1
controls, Stream (Of [Block]) (ResourceT IO) ()
input) forall a b. (a -> b) -> a -> b
$ \(Map Control Audio1, Stream (Of [Block]) (ResourceT IO) ())
-> Stream (Of Block) (ResourceT IO) ()
loop (Map Control Audio1
controls, Stream (Of [Block]) (ResourceT IO) ()
input) ->
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Maybe (a, Stream (Of a) m r))
S.uncons Stream (Of [Block]) (ResourceT IO) ()
input) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just ([Block]
inputBlocks, Stream (Of [Block]) (ResourceT IO) ()
input) -> do
                (Map Control Block
controls, Map Control Audio1
nextControls) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
                    forall control.
Ord control =>
Frames
-> Map control Audio1
-> ResourceT IO (Map control Block, Map control Audio1)
RenderUtil.takeControls (Config -> Frames
_controlsPerBlock Config
config) Map Control Audio1
controls
                -- Debug.tracepM "inputs" (map trim inputBlocks)
                Vector Sample
output <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
                    Config
-> (State -> IO ())
-> Effect
-> Map Control Block
-> [Block]
-> IO (Vector Sample)
renderBlock Config
config State -> IO ()
notifyState Effect
effect Map Control Block
controls [Block]
inputBlocks
                forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
S.yield forall a b. (a -> b) -> a -> b
$ Vector Sample -> Block
Audio.Block Vector Sample
output
                (Map Control Audio1, Stream (Of [Block]) (ResourceT IO) ())
-> Stream (Of Block) (ResourceT IO) ()
loop (Map Control Audio1
nextControls, Stream (Of [Block]) (ResourceT IO) ()
input)
            Maybe ([Block], Stream (Of [Block]) (ResourceT IO) ())
Nothing -> Effect
-> ReleaseKey
-> Map Control Audio1
-> Stream (Of Block) (ResourceT IO) ()
decay Effect
effect ReleaseKey
key Map Control Audio1
controls
    where
    decay :: Effect
-> ReleaseKey
-> Map Control Audio1
-> Stream (Of Block) (ResourceT IO) ()
decay Effect
effect ReleaseKey
key Map Control Audio1
controls =
        forall s1 s2 a. s1 -> s2 -> ((s1 -> s2 -> a) -> s1 -> s2 -> a) -> a
Util.Control.loop2 Frames
0 Map Control Audio1
controls forall a b. (a -> b) -> a -> b
$ \Frames -> Map Control Audio1 -> Stream (Of Block) (ResourceT IO) ()
loop Frames
now Map Control Audio1
controls ->
            if Frames
now forall a. Ord a => a -> a -> Bool
>= Config -> Frames
_maxDecay Config
config then forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
Resource.release ReleaseKey
key
            else do
                (Map Control Block
controls, Map Control Audio1
nextControls) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
                    forall control.
Ord control =>
Frames
-> Map control Audio1
-> ResourceT IO (Map control Block, Map control Audio1)
RenderUtil.takeControls (Config -> Frames
_controlsPerBlock Config
config) Map Control Audio1
controls
                Vector Sample
output <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
                    Config
-> (State -> IO ())
-> Effect
-> Map Control Block
-> [Block]
-> IO (Vector Sample)
renderBlock Config
config State -> IO ()
notifyState Effect
effect Map Control Block
controls
                        [Block
silence, Block
silence]
                if Vector Sample -> Bool
RenderUtil.isBasicallySilent Vector Sample
output
                    then forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
Resource.release ReleaseKey
key
                    else do
                        forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
S.yield forall a b. (a -> b) -> a -> b
$ Vector Sample -> Block
Audio.Block Vector Sample
output
                        Frames -> Map Control Audio1 -> Stream (Of Block) (ResourceT IO) ()
loop (Frames
now forall a. Num a => a -> a -> a
+ Config -> Frames
_blockSize Config
config) Map Control Audio1
nextControls
        where
        silence :: Block
silence = Int -> Sample -> Block
Audio.Constant (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Config -> Frames
_blockSize Config
config)) Sample
0

-- trim :: Audio.Block -> Audio.Block
-- trim (Audio.Block v) = Audio.Block (V.take 4 v)
-- trim b = b

renderBlock :: Config -> (EffectC.State -> IO ())
    -> EffectC.Effect -> Map Control.Control Audio.Block
    -> [Audio.Block] -> IO (V.Vector Audio.Sample)
renderBlock :: Config
-> (State -> IO ())
-> Effect
-> Map Control Block
-> [Block]
-> IO (Vector Sample)
renderBlock Config
config State -> IO ()
notifyState Effect
effect Map Control Block
controls [Block]
inputBlocks = do
    let controlVals :: [(Ptr Sample, Block)]
controlVals = forall control ptr config block.
Ord control =>
Map control (ptr, config) -> Map control block -> [(ptr, block)]
RenderUtil.findControls (forall ptr cptr. EffectT ptr cptr -> Map Control (cptr, Text)
EffectC._controls Effect
effect)
            Map Control Block
controls
    -- Debug.tracepM "controls"
    --     ( map (\(c, _, val) -> (c, val)) $
    --       Maps.zipIntersection (EffectC._controls effect) controls
    --     )
    [Vector Sample]
outputs <- Frames
-> Frames
-> Effect
-> [(Ptr Sample, Block)]
-> [Vector Sample]
-> IO [Vector Sample]
EffectC.render
        (Config -> Frames
_controlSize Config
config) (Config -> Frames
_controlsPerBlock Config
config) Effect
effect
        [(Ptr Sample, Block)]
controlVals (forall a b. (a -> b) -> [a] -> [b]
map Block -> Vector Sample
Audio.blockVector [Block]
inputBlocks)
    -- XXX Since this uses unsafeGetState, readers of notifyState have to
    -- entirely use the state before returning.  See Checkpoint.getFilename and
    -- Checkpoint.writeBs.
    State -> IO ()
notifyState forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Effect -> IO State
EffectC.unsafeGetState Effect
effect
    case [Vector Sample]
outputs of
        [Vector Sample
_, Vector Sample
_] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Storable a => [Vector a] -> Vector a
Audio.interleaveV [Vector Sample]
outputs
        -- This should have already been checked by EffectC.makePatch.
        [Vector Sample]
_ -> forall (m :: * -> *) a. (HasCallStack, MonadIO m) => Text -> m a
Audio.throwIO Text
"patch with outputs /= 2"