-- 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 #-}
-- | Low level binding to patch_c.cc and the Patch c++ object, which represents
-- any faust dsp, both instruments and effects processors.
module Synth.Faust.PatchC where
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Unsafe as ByteString.Unsafe
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Vector.Storable as V

import qualified Foreign

import qualified Util.Audio.Audio as Audio
import qualified Util.FFI as FFI
import qualified Synth.Shared.Config as Config
import qualified Synth.Shared.Control as Control

import           ForeignC
import           Global


type PatchP = Ptr CConstPatchP
data CConstPatchP

-- | An allocated patch.
type InstrumentP = Ptr CPatchP
data CPatchP


patches :: IO [(Text, PatchP)]
patches :: IO [(Text, PatchP)]
patches = forall a b. CStorable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr PatchP)
patchpp -> do
    Int
count <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (Ptr PatchP) -> IO CInt
c_faust_patches Ptr (Ptr PatchP)
patchpp
    [PatchP]
patches <- forall a. CStorable a => Int -> Ptr a -> IO [a]
peekArray Int
count forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. CStorable a => Ptr a -> IO a
peek Ptr (Ptr PatchP)
patchpp
    [Text]
names <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Ptr CChar -> IO Text
FFI.peekCString forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchP -> Ptr CChar
c_faust_name) [PatchP]
patches
    -- I use hyphens, but C doesn't allow them in names.
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map (Stack => Text -> Text -> Text -> Text
Text.replace Text
"_" Text
"-") [Text]
names) [PatchP]
patches

-- int faust_patches(const Patch ***patches);
foreign import ccall "faust_patches"
    c_faust_patches :: Ptr (Ptr PatchP) -> IO CInt

foreign import ccall "faust_name" c_faust_name :: PatchP -> CString

patchInputs, patchOutputs :: PatchP -> Int
patchInputs :: PatchP -> Int
patchInputs = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchP -> CInt
c_faust_num_inputs
patchOutputs :: PatchP -> Int
patchOutputs = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchP -> CInt
c_faust_num_outputs

instInputs, instOutputs :: InstrumentP -> Int
instInputs :: InstrumentP -> Int
instInputs = PatchP -> Int
patchInputs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr
instOutputs :: InstrumentP -> Int
instOutputs = PatchP -> Int
patchOutputs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr

foreign import ccall unsafe "faust_num_inputs"
    c_faust_num_inputs :: PatchP -> CInt
foreign import ccall unsafe "faust_num_outputs"
    c_faust_num_outputs :: PatchP -> CInt

getMetadata :: PatchP -> IO (Map Text Text)
getMetadata :: PatchP -> IO (Map Text Text)
getMetadata PatchP
patch = forall a b. CStorable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr (Ptr CChar))
keyspp -> forall a b. CStorable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr (Ptr CChar))
valuespp -> do
    Int
count <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PatchP -> Ptr (Ptr (Ptr CChar)) -> Ptr (Ptr (Ptr CChar)) -> IO CInt
c_faust_metadata PatchP
patch Ptr (Ptr (Ptr CChar))
keyspp Ptr (Ptr (Ptr CChar))
valuespp
    [(Text, Text)]
kvs <- forall a b. [a] -> [b] -> [(a, b)]
zip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Ptr (Ptr CChar) -> IO [Text]
peekTexts Int
count forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. CStorable a => Ptr a -> IO a
peek Ptr (Ptr (Ptr CChar))
keyspp)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Ptr (Ptr CChar) -> IO [Text]
peekTexts Int
count forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. CStorable a => Ptr a -> IO a
peek Ptr (Ptr (Ptr CChar))
valuespp)
    forall a. Ptr a -> IO ()
free forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. CStorable a => Ptr a -> IO a
peek Ptr (Ptr (Ptr CChar))
keyspp
    forall a. Ptr a -> IO ()
free forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. CStorable a => Ptr a -> IO a
peek Ptr (Ptr (Ptr CChar))
valuespp
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Text)]
kvs

parseDescription :: Map Text Text -> Text
parseDescription :: Map Text Text -> Text
parseDescription Map Text Text
meta = Text -> [Text] -> Text
Text.intercalate Text
"\n" forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Text
"") forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Text
"" Text
"description" Map Text Text
meta
    forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (\Text
k -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
k forall a. Semigroup a => a -> a -> a
<> Text
": ")<>) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
k Map Text Text
meta)
        [Text
"author", Text
"copyright", Text
"version", Text
"license"]

-- int faust_metadata(
--     const Patch *patch, const char ***keys, const char ***values);
foreign import ccall "faust_metadata"
    c_faust_metadata :: PatchP -> Ptr (Ptr CString) -> Ptr (Ptr CString)
        -> IO CInt

getUiControls :: PatchP -> IO [(([Text], Control.Control), Text)]
getUiControls :: PatchP -> IO [(([Text], Control), Text)]
getUiControls PatchP
patch = do
    (Int
count, Ptr (Ptr (Ptr CChar))
pathspp, Ptr (Ptr CChar)
controlsp, Ptr (Ptr CChar)
docsp) <-
        forall a b. CStorable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr (Ptr (Ptr CChar)))
pathsppp -> forall a b. CStorable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr (Ptr CChar))
controlspp -> forall a b. CStorable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr (Ptr CChar))
docspp -> do
            CInt
count <- PatchP
-> Ptr (Ptr (Ptr (Ptr CChar)))
-> Ptr (Ptr (Ptr CChar))
-> Ptr (Ptr (Ptr CChar))
-> IO CInt
c_faust_controls PatchP
patch Ptr (Ptr (Ptr (Ptr CChar)))
pathsppp Ptr (Ptr (Ptr CChar))
controlspp Ptr (Ptr (Ptr CChar))
docspp
            (,,,) (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
count)
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. CStorable a => Ptr a -> IO a
peek Ptr (Ptr (Ptr (Ptr CChar)))
pathsppp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. CStorable a => Ptr a -> IO a
peek Ptr (Ptr (Ptr CChar))
controlspp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. CStorable a => Ptr a -> IO a
peek Ptr (Ptr (Ptr CChar))
docspp
    -- pathsp is a null-terminated list of char*
    [Ptr (Ptr CChar)]
pathsp <- forall a. CStorable a => Int -> Ptr a -> IO [a]
peekArray Int
count Ptr (Ptr (Ptr CChar))
pathspp
    [[Text]]
paths <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Ptr (Ptr CChar) -> IO [Text]
peekTexts0 [Ptr (Ptr CChar)]
pathsp
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. Ptr a -> IO ()
free [Ptr (Ptr CChar)]
pathsp
    forall a. Ptr a -> IO ()
free Ptr (Ptr (Ptr CChar))
pathspp

    -- Faust likes underscores, but I use hyphens for control names.
    [Control]
controls <- forall a b. (a -> b) -> [a] -> [b]
map (Text -> Control
Control.Control forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack => Text -> Text -> Text -> Text
Text.replace Text
"_" Text
"-") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Int -> Ptr (Ptr CChar) -> IO [Text]
peekTexts Int
count Ptr (Ptr CChar)
controlsp
    forall a. Ptr a -> IO ()
free Ptr (Ptr CChar)
controlsp
    [Text]
docs <- Int -> Ptr (Ptr CChar) -> IO [Text]
peekTexts Int
count Ptr (Ptr CChar)
docsp
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. Ptr a -> IO ()
free forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. CStorable a => Int -> Ptr a -> IO [a]
peekArray Int
count Ptr (Ptr CChar)
docsp
    forall a. Ptr a -> IO ()
free Ptr (Ptr CChar)
docsp

    -- Lead with "_" to suppress the whole control.  But "_" was turned to "-".
    forall (m :: * -> *) a. Monad m => a -> m a
return 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
. (Text
"-" `Text.isPrefixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Text
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd 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 b. [a] -> [b] -> [(a, b)]
zip (forall a b. [a] -> [b] -> [(a, b)]
zip [[Text]]
paths [Control]
controls) [Text]
docs


-- int faust_controls(Patch patch, const char ****out_paths,
--     const char ***out_controls, char ***out_docs)
foreign import ccall "faust_controls"
    c_faust_controls :: PatchP -> Ptr (Ptr (Ptr CString)) -> Ptr (Ptr CString)
        -> Ptr (Ptr CString) -> IO CInt

-- * Instrument

allocate :: PatchP -> IO (InstrumentP, [(([Text], Control.Control), Ptr Float)])
allocate :: PatchP -> IO (InstrumentP, [(([Text], Control), Ptr Float)])
allocate PatchP
patch = do
    InstrumentP
ptr <- PatchP -> CInt -> IO InstrumentP
c_faust_allocate PatchP
patch (Int -> CInt
FFI.c_int Int
Config.samplingRate)
    [Ptr Float]
cptrs <- forall a b. CStorable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr (Ptr Float))
cptrspp -> do
        CInt
count <- InstrumentP -> Ptr (Ptr (Ptr Float)) -> IO CInt
c_faust_control_ptrs InstrumentP
ptr Ptr (Ptr (Ptr Float))
cptrspp
        Ptr (Ptr Float)
cptrsp <- forall a. CStorable a => Ptr a -> IO a
peek Ptr (Ptr (Ptr Float))
cptrspp
        [Ptr Float]
cptrs <- forall a. CStorable a => Int -> Ptr a -> IO [a]
peekArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
count) Ptr (Ptr Float)
cptrsp
        forall a. Ptr a -> IO ()
free Ptr (Ptr Float)
cptrsp
        forall (m :: * -> *) a. Monad m => a -> m a
return [Ptr Float]
cptrs
    -- I need an allocated instrument to get valid control pointers.  But since
    -- I already changed their order to put them in a Map, I have to get the
    -- control names again, which is inefficient but easy to do.
    [(([Text], Control), Text)]
uis <- PatchP -> IO [(([Text], Control), Text)]
getUiControls PatchP
patch
    forall (m :: * -> *) a. Monad m => a -> m a
return (InstrumentP
ptr, forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(([Text], Control), Text)]
uis) [Ptr Float]
cptrs)

-- Patch *faust_allocate(const Patch *patch, int srate);
foreign import ccall "faust_allocate"
    c_faust_allocate :: PatchP -> CInt -> IO InstrumentP

-- int faust_control_ptrs(Patch *inst, FAUSTFLOAT ***out_vals)
foreign import ccall "faust_control_ptrs"
    c_faust_control_ptrs :: InstrumentP -> Ptr (Ptr (Ptr Float)) -> IO CInt

-- void faust_destroy(Patch *patch) { delete patch; }
foreign import ccall "faust_destroy" c_faust_destroy :: InstrumentP -> IO ()

-- | Render chunk of time and return samples.
render :: Audio.Frames -> Audio.Frames -> InstrumentP
    -> [(Ptr Float, Audio.Block)]
    -> [V.Vector Float] -- ^ Input signals.  The length must be equal to the
    -- the patchInputs, and each vector must have the same length.
    -> IO [V.Vector Float] -- ^ one block of samples for each output channel
render :: Frames
-> Frames
-> InstrumentP
-> [(Ptr Float, Block)]
-> [Vector Float]
-> IO [Vector Float]
render Frames
controlSize Frames
controlsPerBlock InstrumentP
inst [(Ptr Float, Block)]
controls [Vector Float]
inputs = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Vector Float]
inputs forall a. Eq a => a -> a -> Bool
== InstrumentP -> Int
instInputs InstrumentP
inst) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. (Stack, MonadIO m) => Text -> m a
errorIO forall a b. (a -> b) -> a -> b
$ Text
"instrument expects " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt (InstrumentP -> Int
instInputs InstrumentP
inst)
            forall a. Semigroup a => a -> a -> a
<> Text
" inputs, but was given " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Vector Float]
inputs)
    let inputSizes :: [Frames]
inputSizes = forall a b. (a -> b) -> [a] -> [b]
map (forall (chan :: Nat).
KnownNat chan =>
Proxy chan -> Vector Float -> Frames
Audio.vectorFrames (forall {k} (t :: k). Proxy t
Proxy @1)) [Vector Float]
inputs
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
==Frames
blockSize) [Frames]
inputSizes) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. (Stack, MonadIO m) => Text -> m a
errorIO forall a b. (a -> b) -> a -> b
$ Text
"all inputs should be block size " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty Frames
blockSize
            forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty [Frames]
inputSizes
    let controlSizes :: [Frames]
controlSizes = forall a b. (a -> b) -> [a] -> [b]
map (forall (chan :: Nat).
KnownNat chan =>
Proxy chan -> Block -> Frames
Audio.blockFrames (forall {k} (t :: k). Proxy t
Proxy @1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Ptr Float, Block)]
controls
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
==Frames
controlsPerBlock) [Frames]
controlSizes) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. (Stack, MonadIO m) => Text -> m a
errorIO forall a b. (a -> b) -> a -> b
$ Text
"all controls should have size " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty Frames
controlsPerBlock
            forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty [Frames]
controlSizes

    -- Debug.tracepM "controls" controls
    -- Debug.tracepM "inputs" inputs
    -- Debug.tracepM "blockSize" blockSize
    -- Use ForeignPtr to keep the output arrays alive until I can stuff them
    -- into a V.Vector.
    [ForeignPtr Float]
outputFptrs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Storable a => Int -> IO (ForeignPtr a)
Foreign.mallocForeignPtrArray
        (forall a. Int -> a -> [a]
replicate (InstrumentP -> Int
instOutputs InstrumentP
inst) (Frames -> Int
unframe Frames
blockSize))
    -- Holy manual memory management, Batman.
    forall a b. [ForeignPtr a] -> ([Ptr a] -> IO b) -> IO b
FFI.withForeignPtrs [ForeignPtr Float]
outputFptrs forall a b. (a -> b) -> a -> b
$ \[Ptr Float]
outputPtrs ->
        forall a. [Vector Float] -> (Ptr (Ptr Float) -> IO a) -> IO a
withVectors [Vector Float]
inputs forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr Float)
inputsP ->
        forall a b. CStorable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Ptr Float]
outputPtrs forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr Float)
outputsP ->
        forall a.
[(Ptr Float, Block)]
-> (CInt -> Ptr (Ptr Float) -> Ptr (Ptr Float) -> IO a) -> IO a
withControls [(Ptr Float, Block)]
controls forall a b. (a -> b) -> a -> b
$ \CInt
controlCount Ptr (Ptr Float)
controlPtrs Ptr (Ptr Float)
controlValsP ->
            InstrumentP
-> CInt
-> CInt
-> CInt
-> Ptr (Ptr Float)
-> Ptr (Ptr Float)
-> Ptr (Ptr Float)
-> Ptr (Ptr Float)
-> IO ()
c_faust_render InstrumentP
inst
                (Frames -> CInt
c_frames Frames
controlSize) (Frames -> CInt
c_frames Frames
controlsPerBlock)
                CInt
controlCount Ptr (Ptr Float)
controlPtrs Ptr (Ptr Float)
controlValsP
                Ptr (Ptr Float)
inputsP Ptr (Ptr Float)
outputsP
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\ForeignPtr Float
fptr -> forall a. ForeignPtr a -> Int -> Vector a
V.unsafeFromForeignPtr0 ForeignPtr Float
fptr (Frames -> Int
unframe Frames
blockSize))
        [ForeignPtr Float]
outputFptrs
    where
    blockSize :: Frames
blockSize = Frames
controlSize forall a. Num a => a -> a -> a
* Frames
controlsPerBlock
    c_frames :: Frames -> CInt
c_frames = Int -> CInt
FFI.c_int forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frames -> Int
unframe
    unframe :: Frames -> Int
unframe (Audio.Frames Int
f) = Int
f

withControls :: [(Ptr Float, Audio.Block)]
    -> (CInt -> Ptr (Ptr Float) -> Ptr (Ptr Float) -> IO a) -> IO a
withControls :: forall a.
[(Ptr Float, Block)]
-> (CInt -> Ptr (Ptr Float) -> Ptr (Ptr Float) -> IO a) -> IO a
withControls [(Ptr Float, Block)]
controls CInt -> Ptr (Ptr Float) -> Ptr (Ptr Float) -> IO a
action = do
    -- Avoid allocating an array if it's constant.
    forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [forall a. Storable a => Ptr a -> a -> IO ()
Foreign.poke Ptr Float
ptr Float
val | (Ptr Float
ptr, Audio.Constant Int
_ Float
val) <- [(Ptr Float, Block)]
controls]
    forall a b. CStorable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Ptr Float]
ptrs forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr Float)
controlPtrs ->
        forall a. [Vector Float] -> (Ptr (Ptr Float) -> IO a) -> IO a
withVectors [Vector Float]
vecs forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr Float)
controlValsP ->
        CInt -> Ptr (Ptr Float) -> Ptr (Ptr Float) -> IO a
action (Int -> CInt
FFI.c_int (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ptr Float]
ptrs)) Ptr (Ptr Float)
controlPtrs Ptr (Ptr Float)
controlValsP
    where ([Ptr Float]
ptrs, [Vector Float]
vecs) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Ptr Float
ptr, Vector Float
vec) | (Ptr Float
ptr, Audio.Block Vector Float
vec) <- [(Ptr Float, Block)]
controls]

-- void faust_render(
--     Patch *patch,
--     int control_size, int controls_per_block,
--     int control_count, float **control_ptrs, const float **controls,
--     const float **inputs, float **outputs);
foreign import ccall "faust_render"
    c_faust_render :: InstrumentP
        -- control_size -> controls_per_block
        -> CInt -> CInt
        -- control_count -> control_ptrs -> controls
        -> CInt -> Ptr (Ptr Float) -> Ptr (Ptr Float)
        -- inputs -> outputs
        -> Ptr (Ptr Float) -> Ptr (Ptr Float)
        -> IO ()

-- ** state

getState :: InstrumentP -> IO ByteString.ByteString
getState :: InstrumentP -> IO ByteString
getState InstrumentP
inst = forall a b. CStorable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
statepp -> do
    InstrumentP -> Ptr (Ptr CChar) -> IO ()
c_faust_get_state InstrumentP
inst Ptr (Ptr CChar)
statepp
    Ptr CChar
statep <- forall a. CStorable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
statepp
    CStringLen -> IO ByteString
ByteString.packCStringLen
        (Ptr CChar
statep, forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ InstrumentP -> CSize
c_faust_get_state_size InstrumentP
inst)

-- | 'getState', but without copying, if you promise to finish with the State
-- before you call 'render', which will change it.
unsafeGetState :: InstrumentP -> IO ByteString.ByteString
unsafeGetState :: InstrumentP -> IO ByteString
unsafeGetState InstrumentP
inst = forall a b. CStorable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
statepp -> do
    InstrumentP -> Ptr (Ptr CChar) -> IO ()
c_faust_get_state InstrumentP
inst Ptr (Ptr CChar)
statepp
    Ptr CChar
statep <- forall a. CStorable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
statepp
    CStringLen -> IO ByteString
ByteString.Unsafe.unsafePackCStringLen
        (Ptr CChar
statep, forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ InstrumentP -> CSize
c_faust_get_state_size InstrumentP
inst)

putState :: ByteString.ByteString -> Text -> InstrumentP -> IO ()
putState :: ByteString -> Text -> InstrumentP -> IO ()
putState ByteString
state Text
name InstrumentP
inst =
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
ByteString.Unsafe.unsafeUseAsCStringLen ByteString
state forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
statep, Int
size) -> do
        let psize :: CSize
psize = InstrumentP -> CSize
c_faust_get_state_size InstrumentP
inst
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size forall a. Eq a => a -> a -> Bool
== CSize
psize) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. (Stack, MonadIO m) => Text -> m a
errorIO forall a b. (a -> b) -> a -> b
$ Text
"inst " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt Text
name forall a. Semigroup a => a -> a -> a
<> Text
" expects state size "
                forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt CSize
psize forall a. Semigroup a => a -> a -> a
<> Text
" but got " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt Int
size
        InstrumentP -> Ptr CChar -> IO ()
c_faust_put_state InstrumentP
inst Ptr CChar
statep

-- size_t faust_get_state_size(const Patch *patch) { return patch->size; }
foreign import ccall "faust_get_state_size"
    c_faust_get_state_size :: InstrumentP -> CSize

-- size_t faust_get_state(const Patch *patch, const char **state);
foreign import ccall "faust_get_state"
    c_faust_get_state :: InstrumentP -> Ptr CString -> IO ()

-- void faust_put_state(Patch *patch, const char *state);
foreign import ccall "faust_put_state"
    c_faust_put_state :: InstrumentP -> CString -> IO ()

-- * util

peekTexts :: Int -> Ptr CString -> IO [Text]
peekTexts :: Int -> Ptr (Ptr CChar) -> IO [Text]
peekTexts Int
count Ptr (Ptr CChar)
textp = do
    [Ptr CChar]
texts <- forall a. CStorable a => Int -> Ptr a -> IO [a]
peekArray Int
count Ptr (Ptr CChar)
textp
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Ptr CChar -> IO Text
FFI.peekCString [Ptr CChar]
texts

peekTexts0 :: Ptr CString -> IO [Text]
peekTexts0 :: Ptr (Ptr CChar) -> IO [Text]
peekTexts0 Ptr (Ptr CChar)
textp = do
    [Ptr CChar]
texts <- forall a. (Storable a, Eq a) => a -> Ptr a -> IO [a]
Foreign.peekArray0 forall a. Ptr a
nullPtr Ptr (Ptr CChar)
textp
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Ptr CChar -> IO Text
FFI.peekCString [Ptr CChar]
texts

-- | Allocate a list of vectors as **float.  Pass nullptr for [], to avoid
-- allocation.
withVectors :: [V.Vector Float] -> (Ptr (Ptr Float) -> IO a) -> IO a
withVectors :: forall a. [Vector Float] -> (Ptr (Ptr Float) -> IO a) -> IO a
withVectors [] Ptr (Ptr Float) -> IO a
f = Ptr (Ptr Float) -> IO a
f forall a. Ptr a
nullPtr
withVectors [Vector Float]
vs Ptr (Ptr Float) -> IO a
f = forall a. [Vector Float] -> ([Ptr Float] -> IO a) -> IO a
withPtrs [Vector Float]
vs forall a b. (a -> b) -> a -> b
$ \[Ptr Float]
ps -> forall a b. CStorable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Ptr Float]
ps Ptr (Ptr Float) -> IO a
f

-- | Convert a list of vectors to a list of pointers, with no copying.
withPtrs :: [V.Vector Float] -> ([Ptr Float] -> IO a) -> IO a
withPtrs :: forall a. [Vector Float] -> ([Ptr Float] -> IO a) -> IO a
withPtrs = forall a b res.
(a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
Foreign.withMany forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
V.unsafeWith