-- Copyright 2018 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 #-}
-- | Render FAUST instruments.
module Synth.Faust.Render where
import qualified Control.Exception as Exception
import qualified Control.Monad.Trans.Resource as Resource
import qualified Data.IORef as IORef
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Vector.Storable as V

import qualified GHC.Stack
import qualified GHC.TypeLits as TypeLits
import qualified Streaming.Prelude as S
import qualified System.IO.Error as IO.Error

import qualified Util.Audio.Audio as Audio
import qualified Util.Control
import qualified Util.Lists as Lists
import qualified Util.Log as Log
import qualified Util.Num as Num
import qualified Util.Segment as Segment

import qualified Perform.RealTime as RealTime
import qualified Synth.Faust.InstrumentC as InstrumentC
import qualified Synth.Faust.RenderUtil as RenderUtil
import qualified Synth.Lib.AUtil as AUtil
import qualified Synth.Lib.Checkpoint as Checkpoint
import qualified Synth.Shared.Config as Config
import qualified Synth.Shared.Control as Control
import qualified Synth.Shared.Note as Note

import qualified Ui.Id as Id

import           Global
import           Synth.Types


type Error = Text

-- * write

write :: Config -> FilePath -> Set Id.TrackId -> InstrumentC.Patch
    -> [Note.Note] -> IO (Either Error (Int, Int))
    -- ^ (renderedChunks, totalChunks)
write :: Config
-> FilePath
-> Set TrackId
-> Patch
-> [Note]
-> IO (Either Element (Int, Int))
write Config
config FilePath
outputDir Set TrackId
trackIds Patch
patch [Note]
notes = forall {b}. IO (Either Element b) -> IO (Either Element b)
catch forall a b. (a -> b) -> a -> b
$ do
    ([FilePath]
skipped, [(Int, Hash)]
hashes, Maybe State
mbState) <-
        FilePath
-> State
-> [(Int, Hash)]
-> IO ([FilePath], [(Int, Hash)], Maybe State)
Checkpoint.skipCheckpoints FilePath
outputDir State
emptyState forall a b. (a -> b) -> a -> b
$
        Frames -> [Span] -> [(Int, Hash)]
Checkpoint.noteHashes Frames
chunkSize (forall a b. (a -> b) -> [a] -> [b]
map Note -> Span
toSpan [Note]
notes)
    IORef State
stateRef <- forall a. a -> IO (IORef a)
IORef.newIORef forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe State
emptyState Maybe State
mbState
    let startFrame :: Frames
startFrame = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
skipped) forall a. Num a => a -> a -> a
* Config -> Frames
_chunkSize Config
config
        start :: RealTime
start = Frames -> RealTime
AUtil.toSeconds Frames
startFrame
    forall (m :: * -> *). (HasCallStack, LogMonad m) => Element -> m ()
Log.debug forall a b. (a -> b) -> a -> b
$ Element
"skipped " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Element
pretty [FilePath]
skipped
        forall a. Semigroup a => a -> a -> a
<> Element
", resume at " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Element
pretty (forall a. Int -> [a] -> [a]
take Int
1 [(Int, Hash)]
hashes)
        forall a. Semigroup a => a -> a -> a
<> Element
" state: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Element
pretty Maybe State
mbState
        forall a. Semigroup a => a -> a -> a
<> Element
" start: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Element
pretty RealTime
start
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> FilePath -> FilePath -> IO Int
Checkpoint.linkOutput Bool
True FilePath
outputDir) [FilePath]
skipped
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
skipped) forall a b. (a -> b) -> a -> b
$ HasCallStack => Payload -> IO ()
emitMessage forall a b. (a -> b) -> a -> b
$
        [Int] -> Payload
Config.WaveformsCompleted [Int
0 .. forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
skipped forall a. Num a => a -> a -> a
- Int
1]
    let notifyState :: State -> IO ()
notifyState = forall a. IORef a -> a -> IO ()
IORef.writeIORef IORef State
stateRef
        getState :: IO State
getState = forall a. IORef a -> IO a
IORef.readIORef IORef State
stateRef
    (Payload -> IO ()) -> Patch -> [Note] -> IO ()
checkElements HasCallStack => Payload -> IO ()
emitMessage Patch
patch [Note]
notes
    Either Element (Int, Int)
result <- Bool
-> FilePath
-> Set TrackId
-> Int
-> Frames
-> [(Int, Hash)]
-> IO State
-> Audio
-> IO (Either Element (Int, Int))
Checkpoint.write Bool
True FilePath
outputDir Set TrackId
trackIds (forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
skipped)
            Frames
chunkSize [(Int, Hash)]
hashes IO State
getState forall a b. (a -> b) -> a -> b
$
        (Payload -> IO ())
-> Patch
-> Config
-> Maybe State
-> (State -> IO ())
-> [Note]
-> RealTime
-> Audio
renderPatch HasCallStack => Payload -> IO ()
emitMessage Patch
patch Config
config Maybe State
mbState State -> IO ()
notifyState [Note]
notes RealTime
start
    case Either Element (Int, Int)
result of
        Right (Int
_, Int
total) -> FilePath -> Int -> IO ()
Checkpoint.clearRemainingOutput FilePath
outputDir Int
total
        Either Element (Int, Int)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    forall (m :: * -> *) a. Monad m => a -> m a
return Either Element (Int, Int)
result
    where
    chunkSize :: Frames
chunkSize = Config -> Frames
_chunkSize Config
config
    catch :: IO (Either Element b) -> IO (Either Element b)
catch IO (Either Element b)
io = forall a. IO a -> [Handler a] -> IO a
Exception.catches IO (Either Element b)
io
        [ forall a e. Exception e => (e -> IO a) -> Handler a
Exception.Handler forall a b. (a -> b) -> a -> b
$ \(Audio.Exception Element
err) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Element
err
        , forall a e. Exception e => (e -> IO a) -> Handler a
Exception.Handler forall a b. (a -> b) -> a -> b
$ \(IOError
exc :: IO.Error.IOError) ->
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ FilePath -> Element
txt forall a b. (a -> b) -> a -> b
$ forall e. Exception e => e -> FilePath
Exception.displayException IOError
exc
        ]
    emitMessage :: GHC.Stack.HasCallStack => Config.Payload -> IO ()
    emitMessage :: HasCallStack => Payload -> IO ()
emitMessage Payload
payload
        | Config -> Bool
_emitProgress Config
config = HasCallStack => Message -> IO ()
Config.emitMessage forall a b. (a -> b) -> a -> b
$ Config.Message
            { _blockId :: BlockId
_blockId = FilePath -> BlockId
Config.pathToBlockId FilePath
outputDir
            , _trackIds :: Set TrackId
_trackIds = Set TrackId
trackIds
            , _instrument :: Instrument
_instrument = FilePath -> Instrument
Config.dirToInstrument FilePath
outputDir
            , _payload :: Payload
_payload = Payload
payload
            }
        | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    emptyState :: State
emptyState = ByteString -> State
Checkpoint.State forall a. Monoid a => a
mempty

-- | Emit a warning if the patch expects element-address controls and a note
-- doesn't have an element, or vice versa.
checkElements :: (Config.Payload -> IO ()) -> InstrumentC.Patch -> [Note.Note]
    -> IO ()
checkElements :: (Payload -> IO ()) -> Patch -> [Note] -> IO ()
checkElements Payload -> IO ()
emitMessage Patch
patch = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Note -> IO ()
check
    where
    check :: Note -> IO ()
check Note
note
        | forall a. Set a -> Bool
Set.null Set Element
elements = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Element
elt forall a. Eq a => a -> a -> Bool
/= Element
"") forall a b. (a -> b) -> a -> b
$
            Element -> IO ()
warn forall a b. (a -> b) -> a -> b
$ Element
"expected no element but got: " forall a. Semigroup a => a -> a -> a
<> Element
elt
        | Element
elt forall a. Eq a => a -> a -> Bool
== Element
"" = Element -> IO ()
warn forall a b. (a -> b) -> a -> b
$ Element
"expected element from " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Element
pretty Set Element
elements
            forall a. Semigroup a => a -> a -> a
<> Element
", but didn't have one"
        | Element
elt forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Element
elements = Element -> IO ()
warn forall a b. (a -> b) -> a -> b
$ Element
"element " forall a. Semigroup a => a -> a -> a
<> Element
elt forall a. Semigroup a => a -> a -> a
<> Element
" not in "
            forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Element
pretty Set Element
elements
        | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return ()
        where
        elt :: Element
elt = Note -> Element
Note.element Note
note
        warn :: Element -> IO ()
warn Element
msg = Payload -> IO ()
emitMessage forall a b. (a -> b) -> a -> b
$ Stack -> Element -> Payload
Config.Warn (Note -> Stack
Note.stack Note
note) Element
msg
    elements :: Set Element
elements = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Element
"") forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
Map.keys forall a b. (a -> b) -> a -> b
$
        forall ptr cptr.
PatchT ptr cptr -> Map Control (cptr, ControlConfig)
InstrumentC._controls Patch
patch

toSpan :: Note.Note -> Checkpoint.Span
toSpan :: Note -> Span
toSpan Note
note = Checkpoint.Span
    { _start :: RealTime
_start = Note -> RealTime
Note.start Note
note
    , _duration :: RealTime
_duration = Note -> RealTime
Note.duration Note
note
    , _hash :: Hash
_hash = Note -> Hash
Note.hash Note
note
    }

-- * render

-- Since _controlSize and _controlsPerBlock overlap, this isn't in normal
-- form.
data Config = Config {
    Config -> Frames
_chunkSize :: !Audio.Frames
    , 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
    , Config -> Bool
_emitProgress :: !Bool
    } deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> FilePath
$cshow :: Config -> FilePath
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show)

{-
    Here are the various constants and derived values:

    SamplingRate = 44100
    chunkSeconds = 4
    blocksPerChunk = 16
    controlsPerBlock = 25

    chunkSize = chunkSeconds * SamplingRate
    blockSize = chunkSize / blocksPerChunk -- 11025
    controlSize = blockSize / controlsPerBlock -- 441

    blocksPerSecond = blocksPerChunk / chunkSeconds -- 4
    controlRate = controlsPerBlock * blocksPerSecond -- 100
-}
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config
    { _chunkSize :: Frames
_chunkSize = Frames
Config.chunkSize
    , _blockSize :: Frames
_blockSize = Frames
Config.blockSize
    , _controlSize :: Frames
_controlSize = Frames
Config.blockSize forall a. (HasCallStack, Integral a) => a -> a -> a
`Num.assertDiv` Frames
controlsPerBlock -- 147
    , _controlsPerBlock :: Frames
_controlsPerBlock = Frames
controlsPerBlock
    , _maxDecay :: Frames
_maxDecay = RealTime -> Frames
AUtil.toFrames RealTime
32
    , _emitProgress :: Bool
_emitProgress = Bool
False
    }
    where controlsPerBlock :: Frames
controlsPerBlock = Frames
75
    -- if c-rate is 100, then 10ms
    -- if c-rate is 300, then 3ms

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

-- | Render notes belonging to a single FAUST patch.  Since they render on
-- a single element, they should either not overlap, or be ok if overlaps
-- cut each other off.
renderPatch :: (Config.Payload -> IO ()) -> InstrumentC.Patch -> Config
    -> Maybe Checkpoint.State -> (Checkpoint.State -> IO ()) -> [Note.Note]
    -> RealTime -> AUtil.Audio
renderPatch :: (Payload -> IO ())
-> Patch
-> Config
-> Maybe State
-> (State -> IO ())
-> [Note]
-> RealTime
-> Audio
renderPatch Payload -> IO ()
emitMessage Patch
patch Config
config Maybe State
mbState State -> IO ()
notifyState [Note]
notes RealTime
start_ =
    (Audio
silence<>) forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id Audio1 -> Audio -> Audio
AUtil.volume Maybe Audio1
vol forall a b. (a -> b) -> a -> b
$ NAudio -> Audio
interleave forall a b. (a -> b) -> a -> b
$
        (Payload -> IO ())
-> Patch
-> Maybe State
-> (State -> IO ())
-> Map Control Audio1
-> NAudio
-> Frames
-> Frames
-> Config
-> NAudio
render Payload -> IO ()
emitMessage Patch
patch Maybe State
mbState State -> IO ()
notifyState
            forall {rate :: Nat}. Map Control (Audio (ResourceT IO) rate 1)
controls NAudio
inputs (RealTime -> Frames
AUtil.toFrames RealTime
start) (RealTime -> Frames
AUtil.toFrames RealTime
final) Config
config
    where
    -- TODO useLeadingSilence is broken because it needs to avoid loading state
    -- after a silence.
    useLeadingSilence :: Bool
useLeadingSilence = Bool
False
    (Audio
silence, RealTime
silenceS)
        | Bool -> Bool
not Bool
useLeadingSilence = (forall a. Monoid a => a
mempty, RealTime
0)
        | Bool
otherwise = (Audio
silence, RealTime
silenceS)
        where
        -- I write silent chunks efficiently, so this not only avoids running
        -- the dsp, it also saves disk writes.  I'd like to revert back to
        -- silence after notes stop and isBasicallySilent, but I'd have to put
        -- in some special logic to detect that and reset the state, which
        -- means notes have to be stateless.
        silence :: Audio
silence = forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
(Monad m, KnownNat chan) =>
Frames -> Frames -> Audio m rate chan -> Audio m rate chan
Audio.synchronizeToSize Frames
0 (Config -> Frames
_blockSize Config
config) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
(Monad m, KnownNat rate, KnownNat chan) =>
Double -> Audio m rate chan -> Audio m rate chan
Audio.takeS (RealTime -> Double
RealTime.to_seconds RealTime
silenceS) forall (m :: * -> *) (chan :: Nat) (rate :: Nat).
(Monad m, KnownNat chan) =>
Audio m rate chan
Audio.silence
        firstNote :: RealTime
firstNote = forall b a. b -> (a -> b) -> Maybe a -> b
maybe RealTime
0 Note -> RealTime
Note.start forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
Lists.head forall a b. (a -> b) -> a -> b
$
            forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((forall a. Eq a => a -> a -> Bool
==Double
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Control -> Note -> Double
Note.initial0 Control
Control.dynamic) [Note]
notes
        -- Emit silence from the start time until the first note, if there is
        -- any such time.
        silenceF :: Frames
silenceF = forall a. Ord a => a -> a -> a
max Frames
0 forall a b. (a -> b) -> a -> b
$
            forall factor a. (Integral factor, Real a) => factor -> a -> factor
Num.roundDown (Config -> Frames
_chunkSize Config
config) (RealTime -> Frames
AUtil.toFrames RealTime
firstNote)
                forall a. Num a => a -> a -> a
- RealTime -> Frames
AUtil.toFrames RealTime
start_
        silenceS :: RealTime
silenceS = Frames -> RealTime
AUtil.toSeconds Frames
silenceF
    -- Now adjust the start to account for the inserted silence.
    start :: RealTime
start = RealTime
start_ forall a. Num a => a -> a -> a
+ RealTime
silenceS

    -- I emit leading silence, but because I round down to a chunk boundary,
    -- I'm still aligned to chunk boundaries.  This way the render loop is
    -- simpler, since it always has the same chunk size.
    align :: Frames
align = Frames
0
    inputs :: NAudio
inputs = forall (m :: * -> *) (rate :: Nat) ptr cptr.
(Monad m, KnownNat rate) =>
Config
-> Frames -> PatchT ptr cptr -> [Note] -> RealTime -> NAudio m rate
renderInputs Config
config Frames
align Patch
patch [Note]
notes RealTime
start
    controls :: Map Control (Audio (ResourceT IO) rate 1)
controls = forall (m :: * -> *) ptr cptr (rate :: Nat).
Monad m =>
Config
-> PatchT ptr cptr
-> [Note]
-> RealTime
-> Map Control (Audio m rate 1)
renderControls Config
config Patch
patch [Note]
notes RealTime
start
    vol :: Maybe Audio1
vol = forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
(Monad m, KnownNat chan) =>
Frames -> Frames -> Audio m rate chan -> Audio m rate chan
Audio.synchronizeToSize Frames
align (Config -> Frames
_blockSize Config
config) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall (m :: * -> *) (rate :: Nat).
(Monad m, KnownNat rate) =>
RealTime -> [(Double, Double)] -> Maybe (Audio m rate 1)
renderInput RealTime
start (Frames -> Bool -> Control -> [Note] -> [(Double, Double)]
controlBreakpoints Frames
1 Bool
False Control
Control.volume [Note]
notes)
    final :: RealTime
final = forall b a. b -> (a -> b) -> Maybe a -> b
maybe RealTime
0 Note -> RealTime
Note.end (forall a. [a] -> Maybe a
Lists.last [Note]
notes)

interleave :: AUtil.NAudio -> AUtil.Audio
interleave :: NAudio -> Audio
interleave NAudio
naudio = case forall (m :: * -> *) (rate :: Nat) (chan :: Nat).
(Monad m, KnownNat chan) =>
NAudio m rate -> Either Element (Audio m rate chan)
Audio.interleaved NAudio
naudio of
    Right Audio
audio -> Audio
audio
    -- All faust instruments are required to have 1 or 2 outputs.  This should
    -- have been verified by InstrumentC.getPatch.
    Left Element
err -> forall (rate :: Nat) (chan :: Nat).
HasCallStack =>
Element -> AudioIO rate chan
Audio.throw forall a b. (a -> b) -> a -> b
$ Element
"expected 1 or 2 outputs: " forall a. Semigroup a => a -> a -> a
<> Element
err

-- | Faust has internal state, and it all starts at 0, and because controls are
-- designed for realtime, they interpolate after the value changed instead of
-- before, I have to initialize then render for long enough to avoid attack
-- artifacts.
_initialize :: Audio.Frames -> InstrumentC.Instrument
    -> Map InstrumentC.Control Float -> IO ()
_initialize :: Frames -> Instrument -> Map Control Float -> IO ()
_initialize Frames
size Instrument
inst Map Control Float
controls = do
    [Vector Float]
_ <- Frames
-> Frames
-> Instrument
-> [(Ptr Float, Block)]
-> [Vector Float]
-> IO [Vector Float]
InstrumentC.render Frames
size Frames
1 Instrument
inst [(Ptr Float, Block)]
controlVals [Vector Float]
inputSamples
    forall (m :: * -> *) a. Monad m => a -> m a
return ()
    where
    controlVals :: [(Ptr Float, Block)]
controlVals = forall control ptr config block.
Ord control =>
Map control (ptr, config) -> Map control block -> [(ptr, block)]
RenderUtil.findControls (forall ptr cptr.
PatchT ptr cptr -> Map Control (cptr, ControlConfig)
InstrumentC._controls Instrument
inst)
        (Int -> Float -> Block
Audio.Constant Int
1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Control Float
controls)
    -- I don't pass any inputs, but they might not need initialization anyway,
    -- since they don't need interpolation.
    inputSamples :: [Vector Float]
inputSamples = forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall ptr cptr. PatchT ptr cptr -> [(Control, ControlConfig)]
InstrumentC._inputControls Instrument
inst)) forall a b. (a -> b) -> a -> b
$
        forall a. Storable a => Int -> a -> Vector a
V.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Frames
size) Float
0
    -- inputSamples = map (get . fst) (InstrumentC._inputControls inst)
    -- get control = V.replicate (fromIntegral size) val
    --     where val = Map.findWithDefault 0 ("", control) controls
    --     -- TODO: inputs don't support Elements yet.

-- | Render a FAUST instrument incrementally.
--
-- Chunk size is determined by the size of the @inputs@ chunks, or
-- Audio.blockSize if they're empty or run out.  The inputs will go to zero
-- if they end before the given time.
render :: (Config.Payload -> IO ())
    -> InstrumentC.Patch
    -> Maybe Checkpoint.State
    -> (Checkpoint.State -> IO ()) -- ^ notify new state after each audio chunk
    -> Map InstrumentC.Control AUtil.Audio1
    -> AUtil.NAudio -> Audio.Frames -> Audio.Frames -- ^ logical end time
    -> Config -> AUtil.NAudio
render :: (Payload -> IO ())
-> Patch
-> Maybe State
-> (State -> IO ())
-> Map Control Audio1
-> NAudio
-> Frames
-> Frames
-> Config
-> NAudio
render Payload -> IO ()
emitMessage Patch
patch Maybe State
mbState State -> IO ()
notifyState Map Control Audio1
controls NAudio
inputs Frames
start Frames
end Config
config =
    forall (m :: * -> *) (rate :: Nat).
Int -> Stream (Of [Block]) m () -> NAudio m rate
Audio.NAudio (forall ptr cptr. PatchT ptr cptr -> Int
InstrumentC._outputs Patch
patch) forall a b. (a -> b) -> a -> b
$ do
        (ReleaseKey
key, Instrument
inst) <- 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 Instrument
InstrumentC.allocate Patch
patch) Instrument -> IO ()
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
. Instrument -> State -> IO ()
InstrumentC.putState Instrument
inst
            -- -- TODO this doesn't seem to be necessary since I can use
            -- -- si.polySmooth.  But leave it here in case I need it after all.
            -- -- I'll probably need it for explicit initilaization, e.g. string
            -- -- tuning.
            -- Nothing -> do
            --     (vals, _) <- lift $ takeControls 1 controls
            --     -- Just one control period should be enough, because that's
            --     -- what the faust-level interpolation should be tuned to, but
            --     -- from listening *1 still seems to have some artifact.
            --     -- Perhaps the faust interpolation is IIR.
            --     liftIO $ initialize (_controlSize config * 2) inst
            --         ((V.! 0) <$> vals)
        Stream (Of [Block]) (ResourceT IO) ()
inputs <- 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
$
            forall (m :: * -> *) (rate :: Nat).
Monad m =>
Frames -> NAudio m rate -> NAudio m rate
Audio.zeroPadN (Config -> Frames
_blockSize Config
config) NAudio
inputs
        forall state a. state -> ((state -> a) -> state -> a) -> a
Util.Control.loop1 (Frames
start, Map Control Audio1
controls, Stream (Of [Block]) (ResourceT IO) ()
inputs) forall a b. (a -> b) -> a -> b
$
            \(Frames, Map Control Audio1, Stream (Of [Block]) (ResourceT IO) ())
-> Stream (Of [Block]) (ResourceT IO) ()
loop (Frames
start, Map Control Audio1
controls, Stream (Of [Block]) (ResourceT IO) ()
inputs) -> do
                -- Audio.zeroPadN should have made this infinite.
                ([Block]
inputSamples, Stream (Of [Block]) (ResourceT IO) ()
nextInputs) <-
                    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. (HasCallStack, MonadIO m) => Element -> m a
Audio.throwIO Element
"end of endless stream") forall (m :: * -> *) a. Monad m => a -> m a
return
                        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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) ()
inputs)
                -- For inputs I try to create the right block size, and then
                -- InstrumentC.render will assert that they are the expected
                -- block size.  This is more finicky but should be more
                -- efficient.  For controls, I take the correct number of
                -- frames so upstream doesn't have to synchronize.  Maybe
                -- controls should do the efficient thing too.
                (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
                Maybe Frames
result <- forall (m :: * -> *).
MonadIO m =>
(Payload -> IO ())
-> Config
-> (State -> IO ())
-> Instrument
-> Map Control Block
-> [Block]
-> Frames
-> Frames
-> Stream (Of [Block]) m (Maybe Frames)
renderBlock Payload -> IO ()
emitMessage Config
config State -> IO ()
notifyState Instrument
inst
                    Map Control Block
controls [Block]
inputSamples Frames
start Frames
end
                case Maybe Frames
result of
                    Maybe Frames
Nothing -> forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
Resource.release ReleaseKey
key
                    Just Frames
nextStart -> (Frames, Map Control Audio1, Stream (Of [Block]) (ResourceT IO) ())
-> Stream (Of [Block]) (ResourceT IO) ()
loop (Frames
nextStart, Map Control Audio1
nextControls, Stream (Of [Block]) (ResourceT IO) ()
nextInputs)
    where
    destroy :: Instrument -> IO ()
destroy Instrument
inst = do
        -- I'm about to deallocate the instrument, so replace the unsafe
        -- pointer to its state with a safe copy.
        State -> IO ()
notifyState forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Instrument -> IO State
InstrumentC.getState Instrument
inst
        Instrument -> IO ()
InstrumentC.destroy Instrument
inst

renderBlock :: MonadIO m => (Config.Payload -> IO ()) -> Config
    -> (Checkpoint.State -> IO ()) -> InstrumentC.Instrument
    -> Map InstrumentC.Control Audio.Block
    -> [Audio.Block]
    -> Audio.Frames -> Audio.Frames
    -> S.Stream (S.Of [Audio.Block]) m (Maybe Audio.Frames)
renderBlock :: forall (m :: * -> *).
MonadIO m =>
(Payload -> IO ())
-> Config
-> (State -> IO ())
-> Instrument
-> Map Control Block
-> [Block]
-> Frames
-> Frames
-> Stream (Of [Block]) m (Maybe Frames)
renderBlock Payload -> IO ()
emitMessage Config
config State -> IO ()
notifyState Instrument
inst Map Control Block
controls [Block]
inputSamples Frames
start Frames
end
    | Frames
start forall a. Ord a => a -> a -> Bool
>= Frames
end forall a. Num a => a -> a -> a
+ Config -> Frames
_maxDecay Config
config = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    | Bool
otherwise = do
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Payload -> IO ()
emitMessage forall a b. (a -> b) -> a -> b
$ RealTime -> RealTime -> Payload
Config.RenderingRange
            (Frames -> RealTime
AUtil.toSeconds Frames
start)
            (Frames -> RealTime
AUtil.toSeconds (Frames
start forall a. Num a => a -> a -> a
+ Config -> Frames
_blockSize Config
config))
        let controlVals :: [(Ptr Float, Block)]
controlVals = forall control ptr config block.
Ord control =>
Map control (ptr, config) -> Map control block -> [(ptr, block)]
RenderUtil.findControls (forall ptr cptr.
PatchT ptr cptr -> Map Control (cptr, ControlConfig)
InstrumentC._controls Instrument
inst)
                Map Control Block
controls
        -- Debug.tracepM "controls"
        --     ( InstrumentC._name inst
        --     , start
        --     , map (\(c, _, val) -> (c, val)) $
        --       Maps.zipIntersection (InstrumentC._controls inst) controls
        --     )
        [Vector Float]
outputs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Frames
-> Frames
-> Instrument
-> [(Ptr Float, Block)]
-> [Vector Float]
-> IO [Vector Float]
InstrumentC.render
            (Config -> Frames
_controlSize Config
config) (Config -> Frames
_controlsPerBlock Config
config) Instrument
inst
            [(Ptr Float, Block)]
controlVals (forall a b. (a -> b) -> [a] -> [b]
map Block -> Vector Float
Audio.blockVector [Block]
inputSamples)
        -- XXX Since this uses unsafeGetState, readers of notifyState
        -- have to entirely use the state before returning.  See
        -- Checkpoint.getFilename and Checkpoint.writeBs.
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ State -> IO ()
notifyState forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Instrument -> IO State
InstrumentC.unsafeGetState Instrument
inst
        forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
S.yield forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Vector Float -> Block
Audio.Block [Vector Float]
outputs
        case [Vector Float]
outputs of
            -- This should have already been checked by InstrumentC.getPatches.
            [] -> forall (m :: * -> *) a. (HasCallStack, MonadIO m) => Element -> m a
Audio.throwIO Element
"patch with 0 outputs"
            Vector Float
output : [Vector Float]
_
                | Frames
frames forall a. Eq a => a -> a -> Bool
== Frames
0
                        Bool -> Bool -> Bool
|| Frames
chunkEnd forall a. Ord a => a -> a -> Bool
>= Frames
end forall a. Num a => a -> a -> a
+ Config -> Frames
_maxDecay Config
config
                        Bool -> Bool -> Bool
|| Frames
chunkEnd forall a. Ord a => a -> a -> Bool
>= Frames
end
                            Bool -> Bool -> Bool
&& Vector Float -> Bool
RenderUtil.isBasicallySilent Vector Float
output ->
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                | Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Frames
chunkEnd
                where
                chunkEnd :: Frames
chunkEnd = Frames
start forall a. Num a => a -> a -> a
+ Frames
frames
                frames :: Frames
frames = Int -> Frames
Audio.Frames forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Vector a -> Int
V.length Vector Float
output

-- ** render breakpoints

renderControls :: Monad m => Config -> InstrumentC.PatchT ptr cptr
    -> [Note.Note] -> RealTime
    -> Map InstrumentC.Control (Audio.Audio m rate 1)
renderControls :: forall (m :: * -> *) ptr cptr (rate :: Nat).
Monad m =>
Config
-> PatchT ptr cptr
-> [Note]
-> RealTime
-> Map Control (Audio m rate 1)
renderControls Config
config PatchT ptr cptr
patch [Note]
notes RealTime
start =
    forall (m :: * -> *) (rate :: Nat).
Monad m =>
Int -> RealTime -> [(Double, Double)] -> Audio m rate 1
RenderUtil.renderControl (Config -> Int
_controlRate Config
config) RealTime
start forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    forall ptr cptr.
Frames
-> PatchT ptr cptr -> [Note] -> Map Control [(Double, Double)]
controlsBreakpoints (Config -> Frames
_controlSize Config
config) PatchT ptr cptr
patch [Note]
notes

-- | Render the supported controls down to audio rate signals.  This causes the
-- stream to be synchronized by '_blockSize', which should determine 'render'
-- chunk sizes, which should be a factor of '_chunkSize'.
renderInputs :: (Monad m, TypeLits.KnownNat rate) => Config -> Audio.Frames
    -> InstrumentC.PatchT ptr cptr -> [Note.Note] -> RealTime
    -> Audio.NAudio m rate
renderInputs :: forall (m :: * -> *) (rate :: Nat) ptr cptr.
(Monad m, KnownNat rate) =>
Config
-> Frames -> PatchT ptr cptr -> [Note] -> RealTime -> NAudio m rate
renderInputs Config
config Frames
align PatchT ptr cptr
patch [Note]
notes RealTime
start =
    forall (m :: * -> *) (rate :: Nat).
Monad m =>
Frames -> Frames -> [Audio m rate 1] -> NAudio m rate
Audio.nonInterleaved Frames
align (Config -> Frames
_blockSize Config
config) forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Maybe a -> a
fromMaybe forall (m :: * -> *) (chan :: Nat) (rate :: Nat).
(Monad m, KnownNat chan) =>
Audio m rate chan
Audio.silence forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (rate :: Nat).
(Monad m, KnownNat rate) =>
RealTime -> [(Double, Double)] -> Maybe (Audio m rate 1)
renderInput RealTime
start) forall a b. (a -> b) -> a -> b
$
    forall ptr cptr. PatchT ptr cptr -> [Note] -> [[(Double, Double)]]
inputsBreakpoints PatchT ptr cptr
patch [Note]
notes

renderInput :: (Monad m, TypeLits.KnownNat rate)
    => RealTime -> [(Double, Double)] -> Maybe (Audio.Audio m rate 1)
renderInput :: forall (m :: * -> *) (rate :: Nat).
(Monad m, KnownNat rate) =>
RealTime -> [(Double, Double)] -> Maybe (Audio m rate 1)
renderInput RealTime
start [(Double, Double)]
bps
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Double, Double)]
bps = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (rate :: Nat).
(Monad m, KnownNat rate) =>
Bool -> [(Double, Double)] -> Audio m rate 1
Audio.linear Bool
True forall a b. (a -> b) -> a -> b
$ forall {c}. [(Double, c)] -> [(Double, c)]
shiftBack [(Double, Double)]
bps
    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. Num a => a -> a -> a
subtract (RealTime -> Double
RealTime.to_seconds RealTime
start))

-- ** extract breakpoints

inputsBreakpoints :: InstrumentC.PatchT ptr cptr -> [Note.Note]
    -> [[(Double, Double)]]
inputsBreakpoints :: forall ptr cptr. PatchT ptr cptr -> [Note] -> [[(Double, Double)]]
inputsBreakpoints PatchT ptr cptr
patch [Note]
notes =
    [ Frames -> Bool -> Control -> [Note] -> [(Double, Double)]
controlBreakpoints Frames
1 Bool
impulseGate Control
control [Note]
notes
    | Control
control <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall ptr cptr. PatchT ptr cptr -> [(Control, ControlConfig)]
InstrumentC._inputControls PatchT ptr cptr
patch
    ]
    where
    impulseGate :: Bool
impulseGate = forall ptr cptr. PatchT ptr cptr -> Bool
InstrumentC._impulseGate PatchT ptr cptr
patch

controlsBreakpoints :: Audio.Frames -> InstrumentC.PatchT ptr cptr
    -> [Note.Note] -> Map InstrumentC.Control [(Double, Double)]
controlsBreakpoints :: forall ptr cptr.
Frames
-> PatchT ptr cptr -> [Note] -> Map Control [(Double, Double)]
controlsBreakpoints Frames
controlSize PatchT ptr cptr
patch [Note]
notes =
    Frames
-> Bool -> Set Control -> [Note] -> Map Control [(Double, Double)]
extractControls Frames
controlSize Bool
impulseGate
        (forall k a. Map k a -> Set k
Map.keysSet (forall ptr cptr.
PatchT ptr cptr -> Map Control (cptr, ControlConfig)
InstrumentC._controls PatchT ptr cptr
patch))
        (Frames -> [Note] -> [Note]
tweakNotes Frames
controlSize [Note]
notes)
    where
    impulseGate :: Bool
impulseGate = forall ptr cptr. PatchT ptr cptr -> Bool
InstrumentC._impulseGate PatchT ptr cptr
patch

extractControls :: Audio.Frames -> Bool -> Set InstrumentC.Control
    -> [Note.Note] -> Map InstrumentC.Control [(Double, Double)]
extractControls :: Frames
-> Bool -> Set Control -> [Note] -> Map Control [(Double, Double)]
extractControls Frames
controlSize Bool
impulseGate Set Control
controls [Note]
allNotes =
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map (forall {a}.
a -> [Note] -> Control -> ((a, Control), [(Double, Double)])
get Element
"" [Note]
allNotes) [Control]
withoutElement forall a. [a] -> [a] -> [a]
++ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Control -> Maybe (Control, [(Double, Double)])
getE [Control]
withElement
    where
    ([Control]
withoutElement, [Control]
withElement) = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
        forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition (Element -> Bool
Text.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set Control
controls
    get :: a -> [Note] -> Control -> ((a, Control), [(Double, Double)])
get a
element [Note]
notes Control
control =
        ( (a
element, Control
control)
        , Frames -> Bool -> Control -> [Note] -> [(Double, Double)]
controlBreakpoints Frames
controlSize Bool
impulseGate Control
control [Note]
notes
        )
    byElement :: [(Element, [Note])]
byElement = forall key a. Eq key => (a -> key) -> [a] -> [(key, [a])]
Lists.keyedGroupStable Note -> Element
Note.element [Note]
allNotes
    getE :: Control -> Maybe (Control, [(Double, Double)])
getE (Element
element, Control
control) =
        forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall {a}.
a -> [Note] -> Control -> ((a, Control), [(Double, Double)])
get Element
element) Control
control forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Element
element [(Element, [Note])]
byElement

-- | Offset notes <= 0 to controlSize.  Otherwise, since rendering starts at 0,
-- the tweak in controlBreakpoints can't move the breakpoints and the first
-- note gets initialization artifacts.  TODO implement proper <0 rendering,
-- SamplerIm does it.
tweakNotes :: Audio.Frames -> [Note.Note] -> [Note.Note]
tweakNotes :: Frames -> [Note] -> [Note]
tweakNotes Frames
controlSize [Note]
notes = forall a b. (a -> b) -> [a] -> [b]
map (\Note
n -> Note
n { start :: RealTime
Note.start = RealTime
dt }) [Note]
at0 forall a. [a] -> [a] -> [a]
++ [Note]
rest
    where
    dt :: RealTime
dt = Frames -> RealTime
AUtil.toSeconds Frames
controlSize
    ([Note]
at0, [Note]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((forall a. Ord a => a -> a -> Bool
<=RealTime
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> RealTime
Note.start) [Note]
notes

controlBreakpoints :: Audio.Frames -> Bool -> Control.Control -> [Note.Note]
    -> [(Double, Double)]
controlBreakpoints :: Frames -> Bool -> Control -> [Note] -> [(Double, Double)]
controlBreakpoints Frames
controlSize Bool
impulseGate Control
control
    | Control
control forall a. Eq a => a -> a -> Bool
== Control
Control.gate =
        forall x y. (Eq x, Eq y) => [(x, y)] -> [(x, y)]
Segment.simplify forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frames -> Bool -> [Note] -> [(Double, Double)]
gateBreakpoints Frames
controlSize Bool
impulseGate
    | Bool
otherwise = Frames
-> Control
-> [(RealTime, Map Control Signal)]
-> [(Double, Double)]
RenderUtil.controlBreakpoints Frames
controlSize Control
control
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\Note
n -> (Note -> RealTime
Note.start Note
n, Note -> Map Control Signal
Note.controls Note
n))

-- | Make a signal with a rising edge on the note attack.  The value is from
-- Control.dynamic, which means a note with dyn=0 won't get an attack at all.
--
-- If impulseGate=True, it will be a controlSize length impulse.  Otherwise, it
-- will stay positive for the duration of the note.  If the note is adjacent
-- to another with the same element, the dip to zero likely won't be
-- registered, so presumably the instrument will need some other signal if it
-- cares about attacks of notes that touch.
gateBreakpoints :: Audio.Frames -> Bool -> [Note.Note] -> [(Double, Double)]
gateBreakpoints :: Frames -> Bool -> [Note] -> [(Double, Double)]
gateBreakpoints Frames
controlSize Bool
impulseGate =
    Frames -> [(RealTime, Double)] -> [(Double, Double)]
RenderUtil.roundBreakpoints Frames
controlSize
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. if Bool
impulseGate then [Note] -> [(RealTime, Double)]
impulse else [Note] -> [(RealTime, Double)]
hold
    where
    -- An "impulse" must still be at least one control size or it might get
    -- skipped.
    impulse :: [Note] -> [(RealTime, Double)]
impulse = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a -> b) -> a -> b
$ \Note
n ->
        let s :: RealTime
s = RealTime -> RealTime -> RealTime
RenderUtil.roundTo RealTime
controlSizeS (Note -> RealTime
Note.start Note
n)
            e :: RealTime
e = RealTime
s forall a. Num a => a -> a -> a
+ RealTime
controlSizeS
            dyn :: Double
dyn = forall a. a -> Maybe a -> a
fromMaybe Double
0 forall a b. (a -> b) -> a -> b
$ Control -> Note -> Maybe Double
Note.initial Control
Control.dynamic Note
n
        in if Double
dyn forall a. Ord a => a -> a -> Bool
<= Double
0 then [] else [(RealTime
s, Double
0), (RealTime
s, Double
dyn), (RealTime
e, Double
dyn), (RealTime
e, Double
0)]
        -- Omit dyn==0 to avoid cancelling a coincident note.  dyn==0 notes are
        -- used to initialized elements.
    controlSizeS :: RealTime
controlSizeS = Frames -> RealTime
AUtil.toSeconds Frames
controlSize
    hold :: [Note] -> [(RealTime, Double)]
hold [] = []
    hold (Note
n : [Note]
ns)
        | Double
dyn forall a. Ord a => a -> a -> Bool
<= Double
0 = [Note] -> [(RealTime, Double)]
hold [Note]
ns
        | Bool
otherwise =
            (Note -> RealTime
Note.start Note
n, Double
0) forall a. a -> [a] -> [a]
: (Note -> RealTime
Note.start Note
n, Double
dyn)
            forall a. a -> [a] -> [a]
: (Note -> RealTime
Note.end Note
end, Double
dyn) forall a. a -> [a] -> [a]
: (Note -> RealTime
Note.end Note
end, Double
0)
            forall a. a -> [a] -> [a]
: [Note] -> [(RealTime, Double)]
hold [Note]
rest
        where
        dyn :: Double
dyn = forall a. a -> Maybe a -> a
fromMaybe Double
0 forall a b. (a -> b) -> a -> b
$ Control -> Note -> Maybe Double
Note.initial Control
Control.dynamic Note
n
        (Note
end : [Note]
rest) = forall a. (a -> a -> Bool) -> [a] -> [a]
dropUntil (\Note
n1 Note
n2 -> Note -> RealTime
Note.end Note
n1 forall a. Ord a => a -> a -> Bool
< Note -> RealTime
Note.start Note
n2)
            (Note
nforall a. a -> [a] -> [a]
:[Note]
ns)

-- | Drop until this element and the next one matches.
dropUntil :: (a -> a -> Bool) -> [a] -> [a]
dropUntil :: forall a. (a -> a -> Bool) -> [a] -> [a]
dropUntil a -> a -> Bool
match = [a] -> [a]
go
    where
    go :: [a] -> [a]
go [] = []
    go [a
x] = [a
x]
    go (a
x1 : xs :: [a]
xs@(a
x2 : [a]
_))
        | a -> a -> Bool
match a
x1 a
x2 = a
x1 forall a. a -> [a] -> [a]
: [a]
xs
        | Bool
otherwise = [a] -> [a]
go [a]
xs


{- NOTE [faust-controls]

    Since control signals run at a slower rate than audio, they have to be
    internally smoothed up to audio rate, which means they have a bit of
    latency.  Normally it's inaudible, but if it coincides with a note attack,
    as it frequently will, it leads to dramatic artifacts.  So I move them all
    back by one controlSize so it's settled by the time the note attacks.  This
    assumes that the faust instrument uses a smooth time equal to controlSize.

    Also, to make sure the intended values are reached in the first place, I
    round all control breakpoints to controlSize boundaries.

    TODO: This is a problem with faust's implementation of controls.  Inputs
    are naturally audio rate and don't have this problem.  But faust doesn't
    allow metadata on inputs, and (as far as I know) doesn't optimize
    constant input values.  If both those were fixed, they could probably
    get rid of controls as separate from inputs.  It's pretty unlikely to ever
    happen, though, because of backwards compatibility.  They might be ok with
    last-value memoization though.
-}