-- 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
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
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 = Double -> Int
forall f i. (HasCallStack, RealFrac f, Integral i) => f -> i
Num.assertIntegral (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$
    Frames -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Config -> Frames
_controlsPerBlock Config
config) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
blocksPerSecond
    where
    blocksPerSecond :: Double
blocksPerSecond =
        Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Config.samplingRate Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Frames -> Double
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 Frames -> Frames -> Frames
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 = Stream (Of Block) (ResourceT IO) () -> Audio
forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
Stream (Of Block) m () -> Audio m rate chan
Audio.Audio (Stream (Of Block) (ResourceT IO) () -> Audio)
-> Stream (Of Block) (ResourceT IO) () -> 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) <- ResourceT IO (ReleaseKey, Effect)
-> Stream (Of Block) (ResourceT IO) (ReleaseKey, Effect)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT IO (ReleaseKey, Effect)
 -> Stream (Of Block) (ResourceT IO) (ReleaseKey, Effect))
-> ResourceT IO (ReleaseKey, Effect)
-> Stream (Of Block) (ResourceT IO) (ReleaseKey, Effect)
forall a b. (a -> b) -> a -> b
$
        IO Effect -> (Effect -> IO ()) -> ResourceT IO (ReleaseKey, Effect)
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
    Maybe State
-> (State -> Stream (Of Block) (ResourceT IO) ())
-> Stream (Of Block) (ResourceT IO) ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe State
mbState ((State -> Stream (Of Block) (ResourceT IO) ())
 -> Stream (Of Block) (ResourceT IO) ())
-> (State -> Stream (Of Block) (ResourceT IO) ())
-> Stream (Of Block) (ResourceT IO) ()
forall a b. (a -> b) -> a -> b
$ IO () -> Stream (Of Block) (ResourceT IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Stream (Of Block) (ResourceT IO) ())
-> (State -> IO ()) -> State -> Stream (Of Block) (ResourceT IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Effect -> State -> IO ()
EffectC.putState Effect
effect
    Stream (Of [Block]) (ResourceT IO) ()
input <- Stream (Of [Block]) (ResourceT IO) ()
-> Stream
     (Of Block) (ResourceT IO) (Stream (Of [Block]) (ResourceT IO) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream (Of [Block]) (ResourceT IO) ()
 -> Stream
      (Of Block) (ResourceT IO) (Stream (Of [Block]) (ResourceT IO) ()))
-> Stream (Of [Block]) (ResourceT IO) ()
-> Stream
     (Of Block) (ResourceT IO) (Stream (Of [Block]) (ResourceT IO) ())
forall a b. (a -> b) -> a -> b
$ NAudio (ResourceT IO) SamplingRate
-> Stream (Of [Block]) (ResourceT IO) ()
forall (m :: * -> *) (rate :: Nat).
NAudio m rate -> Stream (Of [Block]) m ()
Audio._nstream (NAudio (ResourceT IO) SamplingRate
 -> Stream (Of [Block]) (ResourceT IO) ())
-> NAudio (ResourceT IO) SamplingRate
-> Stream (Of [Block]) (ResourceT IO) ()
forall a b. (a -> b) -> a -> b
$ -- Audio.zeroPadN (_blockSize config) $
        Audio -> NAudio (ResourceT IO) SamplingRate
forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
(Monad m, KnownNat chan) =>
Audio m rate chan -> NAudio m rate
Audio.splitChannels Audio
input
    (Map Control Audio1, Stream (Of [Block]) (ResourceT IO) ())
-> (((Map Control Audio1, Stream (Of [Block]) (ResourceT IO) ())
     -> Stream (Of Block) (ResourceT IO) ())
    -> (Map Control Audio1, Stream (Of [Block]) (ResourceT IO) ())
    -> Stream (Of Block) (ResourceT IO) ())
-> Stream (Of Block) (ResourceT IO) ()
forall state a. state -> ((state -> a) -> state -> a) -> a
Util.Control.loop1 (Map Control Audio1
controls, Stream (Of [Block]) (ResourceT IO) ()
input) ((((Map Control Audio1, Stream (Of [Block]) (ResourceT IO) ())
   -> Stream (Of Block) (ResourceT IO) ())
  -> (Map Control Audio1, Stream (Of [Block]) (ResourceT IO) ())
  -> Stream (Of Block) (ResourceT IO) ())
 -> Stream (Of Block) (ResourceT IO) ())
-> (((Map Control Audio1, Stream (Of [Block]) (ResourceT IO) ())
     -> Stream (Of Block) (ResourceT IO) ())
    -> (Map Control Audio1, Stream (Of [Block]) (ResourceT IO) ())
    -> Stream (Of Block) (ResourceT IO) ())
-> Stream (Of Block) (ResourceT IO) ()
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) ->
        ResourceT
  IO (Maybe ([Block], Stream (Of [Block]) (ResourceT IO) ()))
-> Stream
     (Of Block)
     (ResourceT IO)
     (Maybe ([Block], Stream (Of [Block]) (ResourceT IO) ()))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Stream (Of [Block]) (ResourceT IO) ()
-> ResourceT
     IO (Maybe ([Block], Stream (Of [Block]) (ResourceT IO) ()))
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) Stream
  (Of Block)
  (ResourceT IO)
  (Maybe ([Block], Stream (Of [Block]) (ResourceT IO) ()))
-> (Maybe ([Block], Stream (Of [Block]) (ResourceT IO) ())
    -> Stream (Of Block) (ResourceT IO) ())
-> Stream (Of Block) (ResourceT IO) ()
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) <- ResourceT IO (Map Control Block, Map Control Audio1)
-> Stream
     (Of Block) (ResourceT IO) (Map Control Block, Map Control Audio1)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT IO (Map Control Block, Map Control Audio1)
 -> Stream
      (Of Block) (ResourceT IO) (Map Control Block, Map Control Audio1))
-> ResourceT IO (Map Control Block, Map Control Audio1)
-> Stream
     (Of Block) (ResourceT IO) (Map Control Block, Map Control Audio1)
forall a b. (a -> b) -> a -> b
$
                    Frames
-> Map Control Audio1
-> ResourceT IO (Map Control Block, Map Control Audio1)
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 <- IO (Vector Sample)
-> Stream (Of Block) (ResourceT IO) (Vector Sample)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Vector Sample)
 -> Stream (Of Block) (ResourceT IO) (Vector Sample))
-> IO (Vector Sample)
-> Stream (Of Block) (ResourceT IO) (Vector Sample)
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
                Block -> Stream (Of Block) (ResourceT IO) ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
S.yield (Block -> Stream (Of Block) (ResourceT IO) ())
-> Block -> Stream (Of Block) (ResourceT IO) ()
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 =
        Frames
-> Map Control Audio1
-> ((Frames
     -> Map Control Audio1 -> Stream (Of Block) (ResourceT IO) ())
    -> Frames
    -> Map Control Audio1
    -> Stream (Of Block) (ResourceT IO) ())
-> Stream (Of Block) (ResourceT IO) ()
forall s1 s2 a. s1 -> s2 -> ((s1 -> s2 -> a) -> s1 -> s2 -> a) -> a
Util.Control.loop2 Frames
0 Map Control Audio1
controls (((Frames
   -> Map Control Audio1 -> Stream (Of Block) (ResourceT IO) ())
  -> Frames
  -> Map Control Audio1
  -> Stream (Of Block) (ResourceT IO) ())
 -> Stream (Of Block) (ResourceT IO) ())
-> ((Frames
     -> Map Control Audio1 -> Stream (Of Block) (ResourceT IO) ())
    -> Frames
    -> Map Control Audio1
    -> Stream (Of Block) (ResourceT IO) ())
-> Stream (Of Block) (ResourceT IO) ()
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 Frames -> Frames -> Bool
forall a. Ord a => a -> a -> Bool
>= Config -> Frames
_maxDecay Config
config then ReleaseKey -> Stream (Of Block) (ResourceT IO) ()
forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
Resource.release ReleaseKey
key
            else do
                (Map Control Block
controls, Map Control Audio1
nextControls) <- ResourceT IO (Map Control Block, Map Control Audio1)
-> Stream
     (Of Block) (ResourceT IO) (Map Control Block, Map Control Audio1)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT IO (Map Control Block, Map Control Audio1)
 -> Stream
      (Of Block) (ResourceT IO) (Map Control Block, Map Control Audio1))
-> ResourceT IO (Map Control Block, Map Control Audio1)
-> Stream
     (Of Block) (ResourceT IO) (Map Control Block, Map Control Audio1)
forall a b. (a -> b) -> a -> b
$
                    Frames
-> Map Control Audio1
-> ResourceT IO (Map Control Block, Map Control Audio1)
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 <- IO (Vector Sample)
-> Stream (Of Block) (ResourceT IO) (Vector Sample)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Vector Sample)
 -> Stream (Of Block) (ResourceT IO) (Vector Sample))
-> IO (Vector Sample)
-> Stream (Of Block) (ResourceT IO) (Vector Sample)
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 ReleaseKey -> Stream (Of Block) (ResourceT IO) ()
forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
Resource.release ReleaseKey
key
                    else do
                        Block -> Stream (Of Block) (ResourceT IO) ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
S.yield (Block -> Stream (Of Block) (ResourceT IO) ())
-> Block -> Stream (Of Block) (ResourceT IO) ()
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 Frames -> Frames -> Frames
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 (Frames -> Int
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 = Map Control (Ptr Sample, Text)
-> Map Control Block -> [(Ptr Sample, Block)]
forall control ptr config block.
Ord control =>
Map control (ptr, config) -> Map control block -> [(ptr, block)]
RenderUtil.findControls (Effect -> Map Control (Ptr Sample, Text)
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 ((Block -> Vector Sample) -> [Block] -> [Vector Sample]
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 (State -> IO ()) -> IO State -> IO ()
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
_] -> Vector Sample -> IO (Vector Sample)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Sample -> IO (Vector Sample))
-> Vector Sample -> IO (Vector Sample)
forall a b. (a -> b) -> a -> b
$ [Vector Sample] -> Vector Sample
forall a. Storable a => [Vector a] -> Vector a
Audio.interleaveV [Vector Sample]
outputs
        -- This should have already been checked by EffectC.makePatch.
        [Vector Sample]
_ -> Text -> IO (Vector Sample)
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => Text -> m a
Audio.throwIO Text
"patch with outputs /= 2"