module Sound.JACK.Audio (
Sample, Port, withPort,
setProcessMono,
setProcessStereo,
getBufferArray,
mainMono,
mainStereo,
) where
import qualified Sound.JACK.Private as Priv
import qualified Sound.JACK as Jack
import Sound.JACK.Private (Client, )
import Sound.JACK (Direction, Input, Output, )
import qualified Sound.JACK.Exception as JackExc
import Sound.JACK.FFI (NFrames, nframesIndices, nframesBounds, Process, )
import qualified Control.Monad.Exception.Synchronous as Sync
import qualified Control.Monad.Trans.Class as Trans
import Foreign.ForeignPtr (newForeignPtr_, )
import Foreign.C.Error (eOK, )
import Foreign.C.Types (CFloat, )
import System.Environment (getProgName)
import Data.Array.Storable
(StorableArray, readArray, writeArray,
unsafeForeignPtrToStorableArray)
type Sample = CFloat
type Port = Priv.Port Sample
withPort ::
(Direction dir,
JackExc.ThrowsPortRegister e,
JackExc.ThrowsErrno e) =>
Client
-> String
-> (Port dir -> Sync.ExceptionalT e IO a)
-> Sync.ExceptionalT e IO a
withPort = Jack.withPort
getBufferArray ::
(Direction dir) =>
Port dir -> NFrames -> IO (StorableArray NFrames Sample)
getBufferArray port nframes = do
flip unsafeForeignPtrToStorableArray (nframesBounds nframes)
=<< newForeignPtr_
=<< Priv.portGetBuffer port nframes
mainMono :: (Sample -> IO Sample) -> IO ()
mainMono fun = do
name <- getProgName
Jack.handleExceptions $
Jack.withClientDefault name $ \client ->
Jack.withPort client "input" $ \input ->
Jack.withPort client "output" $ \output -> do
setProcessMono client input fun output
Jack.withActivation client $ Trans.lift $ do
putStrLn $ "started " ++ name ++ "..."
Jack.waitForBreak
setProcessMono ::
(JackExc.ThrowsErrno e) =>
Client ->
Port Input -> (Sample -> IO Sample) ->
Port Output ->
Sync.ExceptionalT e IO ()
setProcessMono client input fun output =
Jack.setProcess client =<<
(Trans.lift $ Jack.mkProcess $ wrapMonoFun input fun output)
wrapMonoFun ::
Port Input -> (Sample -> IO Sample) ->
Port Output -> Process
wrapMonoFun input fun output nframes _args = do
inArr <- getBufferArray input nframes
outArr <- getBufferArray output nframes
mapM_ (applyToArraysMono inArr fun outArr) (nframesIndices nframes)
return eOK
applyToArraysMono ::
StorableArray NFrames Sample -> (Sample -> IO Sample)
-> StorableArray NFrames Sample
-> NFrames -> IO ()
applyToArraysMono inArr fun outArr i =
readArray inArr i >>= fun >>= writeArray outArr i
mainStereo :: ((Sample, Sample) -> IO (Sample, Sample)) -> IO ()
mainStereo fun = do
name <- getProgName
Jack.handleExceptions $
Jack.withClientDefault name $ \client ->
Jack.withPort client "inputLeft" $ \inputLeft ->
Jack.withPort client "inputRight" $ \inputRight ->
Jack.withPort client "outputLeft" $ \outputLeft ->
Jack.withPort client "outputRight" $ \outputRight -> do
setProcessStereo client
inputLeft inputRight fun
outputLeft outputRight
Jack.withActivation client $ Trans.lift $ do
putStrLn $ "started " ++ name ++ "..."
Jack.waitForBreak
setProcessStereo ::
(JackExc.ThrowsErrno e) =>
Client ->
Port Input -> Port Input ->
((Sample, Sample) -> IO (Sample, Sample)) ->
Port Output -> Port Output ->
Sync.ExceptionalT e IO ()
setProcessStereo client inputLeft inputRight fun outputLeft outputRight =
Jack.setProcess client =<<
(Trans.lift $ Jack.mkProcess $
wrapStereoFun inputLeft inputRight fun outputLeft outputRight)
wrapStereoFun ::
Port Input -> Port Input
-> ((Sample, Sample) -> IO (Sample, Sample))
-> Port Output -> Port Output
-> Process
wrapStereoFun iL iR fun oL oR nframes _args = do
inLArr <- getBufferArray iL nframes
inRArr <- getBufferArray iR nframes
outLArr <- getBufferArray oL nframes
outRArr <- getBufferArray oR nframes
mapM_ (applyToArraysStereo inLArr inRArr fun outLArr outRArr) (nframesIndices nframes)
return eOK
applyToArraysStereo :: StorableArray NFrames Sample
-> StorableArray NFrames Sample
-> ((Sample, Sample) -> IO (Sample, Sample))
-> StorableArray NFrames Sample
-> StorableArray NFrames Sample
-> NFrames -> IO ()
applyToArraysStereo iL iR fun oL oR i = do
l <- readArray iL i
r <- readArray iR i
(l', r') <- fun (l, r)
writeArray oL i l'
writeArray oR i r'