diff --git a/INSTALL b/INSTALL --- a/INSTALL +++ b/INSTALL @@ -1,12 +1,10 @@ Installation: -runhaskell Setup.hs configure -runhaskell Setup.hs build -runhaskell Setup.hs install +runhaskell Setup configure +runhaskell Setup build +runhaskell Setup install More information: -runhaskell Setup.hs help - - +runhaskell Setup help diff --git a/examples/Callbacks.hs b/examples/Callbacks.hs new file mode 100644 --- /dev/null +++ b/examples/Callbacks.hs @@ -0,0 +1,73 @@ +-- This example demonstrates the use of various specialized JACK callbacks. +module Main where + +import Foreign.C.Types (CFloat) +import qualified Control.Monad.Exception.Synchronous as Sync +import qualified Control.Monad.Trans.Class as Trans +import qualified Foreign.C.Error as E +import qualified Sound.JACK.Audio as Audio +import qualified Sound.JACK as JACK +import System.Environment (getProgName, ) +import Common + +main :: IO () +main = do + name <- getProgName + JACK.handleExceptions $ + JACK.withClientDefault name $ \client -> + JACK.withPort client "input" $ \input -> + JACK.withPort client "output" $ \output -> + JACK.withFreewheel client freewheel $ + JACK.withBufferSize client bufferSize $ + JACK.withSampleRate client sampleRate $ + JACK.withPortConnect client portConnect $ + JACK.withPortRename client portRename $ + JACK.withPortRegistration client portRegistration $ + JACK.withClientRegistration client clientRegistration $ + JACK.withGraphOrder client graphOrder $ + JACK.withXRun client xRun $ + Audio.withProcessMono client input process output $ + mainWait client name + +process :: CFloat -> IO CFloat +process s = return s + +-- Signals entering freewheel mode +freewheel :: Bool -> IO () +freewheel b = putStrLn $ "Freewheel: " ++ show b + +-- Signals the change of buffer size +bufferSize :: JACK.NFrames -> Sync.ExceptionalT E.Errno IO () +bufferSize s = Trans.lift $ putStrLn $ "Buffer size: " ++ show s + +-- Signals the change of sample rate +sampleRate :: JACK.NFrames -> Sync.ExceptionalT E.Errno IO () +sampleRate s = Trans.lift $ putStrLn $ "Sample rate: " ++ show s + +-- Signals port connection +portConnect :: JACK.PortId -> JACK.PortId -> Bool -> IO () +portConnect p1 p2 True = putStrLn $ "Port connect: " ++ show p1 ++ " to " ++ show p2 +portConnect p1 p2 False = putStrLn $ "Port disconnect: " ++ show p1 ++ " to " ++ show p2 + +-- Signals the change of port name +portRename :: JACK.PortId -> String -> String -> IO () +portRename p s1 s2 = putStrLn $ "Port rename: " ++ show p ++ ", " ++ s1 ++ " to " ++ s2 + +-- Signals port registration +portRegistration :: JACK.PortId -> Bool -> IO () +portRegistration p True = putStrLn $ "Port registered: " ++ show p +portRegistration p False = putStrLn $ "Port unregistered: " ++ show p + +-- Signals client registration +clientRegistration :: String -> Bool -> IO () +clientRegistration s True = putStrLn $ "Client registered: " ++ s +clientRegistration s False = putStrLn $ "Client unregistered: " ++ s + +-- Signals reordering of the JACK graph +graphOrder :: Sync.ExceptionalT E.Errno IO () +graphOrder = Trans.lift $ putStrLn "Processing graph reordered" + +-- Signals Xruns +xRun :: Sync.ExceptionalT E.Errno IO () +xRun = Trans.lift $ putStrLn "Xrun happened" + diff --git a/examples/Latency.hs b/examples/Latency.hs new file mode 100644 --- /dev/null +++ b/examples/Latency.hs @@ -0,0 +1,50 @@ +-- This example demonstrates the use of JACK latency API +module Main where + +import Foreign.C.Types (CFloat) +import qualified Sound.JACK.Audio as Audio +import qualified Sound.JACK as JACK +import System.Environment (getProgName, ) +import Data.IORef +import Common + +main :: IO () +main = do + name <- getProgName + ref <- newIORef 0 + JACK.handleExceptions $ + JACK.withClientDefault name $ \client -> + JACK.withPort client "input" $ \input -> + JACK.withPort client "output" $ \output -> + JACK.withLatency client (latency input output) $ + Audio.withProcessMono client input (process ref) output $ + mainWait client name + +process :: IORef CFloat -> CFloat -> IO CFloat +process r v = do + v' <- readIORef r + writeIORef r v + return v' + +latency :: + Audio.Port JACK.Input -> + Audio.Port JACK.Output -> + JACK.LatencyCallbackMode -> + IO () +latency input output mode = + if mode == JACK.jackCaptureLatency + then modifyLatencyRange "Capture" input output mode + else modifyLatencyRange "Playback" output input mode + +modifyLatencyRange :: + String -> + Audio.Port from -> + Audio.Port to -> + JACK.LatencyCallbackMode -> + IO () +modifyLatencyRange name from to mode = do + JACK.LatencyRange (JACK.NFrames a) (JACK.NFrames b) <- + JACK.getLatencyRange from mode + putStrLn $ name ++ " latency recalculation: " ++ show a ++ " " ++ show b + JACK.setLatencyRange to mode $ + JACK.LatencyRange (JACK.NFrames $ a+1) (JACK.NFrames $ b+1) diff --git a/jack.cabal b/jack.cabal --- a/jack.cabal +++ b/jack.cabal @@ -1,6 +1,7 @@ +Cabal-Version: 2.2 Name: jack -Version: 0.7.1.4 -License: GPL +Version: 0.7.2 +License: GPL-2.0-only License-File: LICENSE Author: Henning Thielemann, Stefan Kersten, Soenke Hahn Maintainer: Henning Thielemann @@ -12,18 +13,19 @@ In order to adapt to your system, you may have to disable pkgConfig or jackFree cabal flags. . - You should compile your clients with @ghc --make -O2 -threaded ...@ + You must compile your clients with @-threaded@ + otherwise you will encounter segfaults. Homepage: http://www.haskell.org/haskellwiki/JACK Category: Sound Build-Type: Simple -Cabal-Version: 1.14 -Tested-With: GHC==7.0.4, GHC==7.2.2, GHC==7.4.2, GHC==7.6.3 -Tested-With: GHC==8.4.1 +Tested-With: GHC==7.4.2, GHC==7.6.3, GHC==7.8.4 +Tested-With: GHC==8.4.4, GHC==8.6.5, GHC==9.0.1 Extra-Source-Files: CHANGELOG INSTALL free/Sound/JACK/FFIFree.hs jackfree/Sound/JACK/FFIFree.hs + src/Sound/JACK/Common.h Source-Repository head type: darcs @@ -32,7 +34,7 @@ Source-Repository this type: darcs location: https://hub.darcs.net/thielema/jack/ - tag: 0.7.1.4 + tag: 0.7.2 Flag pkgConfig description: Use pkg-config tool for check version and presence of jack @@ -54,7 +56,7 @@ bytestring >=0.9.1.4 && <0.11, explicit-exception >=0.1.7 && <0.2, transformers >=0.2 && <0.6, - enumset >=0.0 && <0.1, + enumset >=0.0.5 && <0.1, array >=0.4 && <0.6, semigroups >=0.1 && <1.0, base >=4.0 && <5.0 @@ -69,8 +71,9 @@ Sound.JACK.FFIFree Sound.JACK.FFI.MIDI Default-Language: Haskell98 - Build-Tools: hsc2hs >=0.66 && <1.0 + Build-Tool-Depends: hsc2hs:hsc2hs >=0.66 && <1.0 Hs-Source-Dirs: src + Include-Dirs: src GHC-Options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates If impl(ghc >= 6.12) GHC-Options: -fwarn-unused-do-bind @@ -109,6 +112,38 @@ GHC-Options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates Hs-Source-Dirs: examples Main-Is: Amplify.hs + +Executable jack-callbacks + If flag(buildExamples) + Build-Depends: + jack, + explicit-exception >=0.1.7 && <0.2, + transformers, + array, + base >=3.0 && <5 + Else + Buildable: False + Default-Language: Haskell98 + GHC-Options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates + Hs-Source-Dirs: examples + Main-Is: Callbacks.hs + Other-Modules: Common + +Executable jack-latency + If flag(buildExamples) + Build-Depends: + jack, + explicit-exception >=0.1.7 && <0.2, + transformers, + array, + base >=3.0 && <5 + Else + Buildable: False + Default-Language: Haskell98 + GHC-Options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates + Hs-Source-Dirs: examples + Main-Is: Latency.hs + Other-Modules: Common Executable jack-capture If flag(buildExamples) diff --git a/src/Sound/JACK.hs b/src/Sound/JACK.hs --- a/src/Sound/JACK.hs +++ b/src/Sound/JACK.hs @@ -27,7 +27,7 @@ -} module Sound.JACK ( -- * general stuff - Client, + Client(..), newClient, newClientDefault, disposeClient, @@ -43,7 +43,7 @@ Direction, Input, Output, JackFFI.UnknownType, UnknownDirection, - Port, + Port(..), newPort, disposePort, withPort, @@ -59,10 +59,54 @@ setProcess, withProcess, + Freewheel, + makeFreewheel, + setFreewheel, + withFreewheel, + + BufferSize, + makeBufferSize, + setBufferSize, + withBufferSize, + + SampleRate, + makeSampleRate, + setSampleRate, + withSampleRate, + + PortRename, + makePortRename, + setPortRename, + withPortRename, + + GraphOrder, + makeGraphOrder, + setGraphOrder, + withGraphOrder, + + XRun, + makeXRun, + setXRun, + withXRun, + + Latency, + LatencyCallbackMode, + makeLatency, + setLatency, + withLatency, + JackFFI.jackCaptureLatency, + JackFFI.jackPlaybackLatency, + + JackFFI.LatencyRange(..), + getLatencyRange, + setLatencyRange, + recomputeTotalLatencies, + getBufferSize, getSampleRate, lastFrameTime, + ClientRegistration, makeClientRegistration, setClientRegistration, withClientRegistration, @@ -71,6 +115,8 @@ makePortRegistration, setPortRegistration, withPortRegistration, + + PortConnect, makePortConnect, setPortConnect, withPortConnect, @@ -109,14 +155,19 @@ import qualified Sound.JACK.FFI as JackFFI import qualified Sound.JACK.FFIFree as JackFFIFree import Sound.JACK.FFI.MIDI (EventBuffer, ) -import Sound.JACK.FFI (Process, Input, Output, nframesIndices, nframesBounds, ) +import Sound.JACK.FFI + (Process, Input, Output, Freewheel, BufferSize, SampleRate, + ClientRegistration, PortRename, PortConnect, GraphOrder, + XRun, Latency, LatencyCallbackMode, + nframesIndices, nframesBounds, ) import qualified Control.Monad.Exception.Synchronous as Sync import qualified Control.Monad.Trans.Class as Trans import qualified Control.Exception as Exc import Control.Monad (join) -import Control.Applicative (Const(Const), (<$>), (<$), ) +import Control.Applicative (Const(Const), (<$>), (<*>), (<$), ) +import Foreign.Marshal.Utils (with) import qualified Foreign.Marshal.Array as Array import qualified Foreign.C.String as CString import qualified Foreign.C.Types as C @@ -125,7 +176,7 @@ (Ptr, FunPtr, nullPtr, castPtr, freeHaskellFunPtr, nullFunPtr, ) import Foreign.C.String (CString, peekCString, ) import Foreign.C.Error (Errno(Errno), eOK) -import qualified Data.EnumSet as ES +import qualified Data.EnumBitSet as ES import Control.Concurrent (MVar, putMVar, newEmptyMVar, takeMVar, threadDelay) @@ -322,7 +373,8 @@ _dummy :: C.CInt _dummy = undefined -foreign import ccall "wrapper" makeProcess :: Process arg -> IO (FunPtr (Process arg)) +foreign import ccall "wrapper" + makeProcess :: Process arg -> IO (FunPtr (Process arg)) getClient :: Client -> Ptr JackFFI.Client @@ -487,6 +539,201 @@ Sync.switchT return (\() -> return eOK) $ proc nframes) setProcess +foreign import ccall "wrapper" + makeFreewheel :: + JackFFI.Freewheel arg -> IO (FunPtr (JackFFI.Freewheel arg)) + +setFreewheel :: + (JackExc.ThrowsErrno e) => + Client -> + FunPtr (JackFFI.Freewheel arg) -> + Ptr arg -> + Sync.ExceptionalT e IO () +setFreewheel client procPtr arg = + liftErrno $ JackFFI.set_freewheel_callback (getClient client) procPtr arg + +withFreewheel :: + (JackExc.ThrowsErrno e) => + Client -> + (Bool -> IO ()) -> + Sync.ExceptionalT e IO a -> + Sync.ExceptionalT e IO a +withFreewheel = + withCallback + (\fw -> + makeFreewheel $ \ starting _arg -> + fw (if starting == 0 then False else True)) + setFreewheel + +foreign import ccall "wrapper" + makeBufferSize :: + JackFFI.BufferSize arg -> IO (FunPtr (JackFFI.BufferSize arg)) + +setBufferSize :: + (JackExc.ThrowsErrno e) => + Client -> + FunPtr (JackFFI.BufferSize arg) -> + Ptr arg -> + Sync.ExceptionalT e IO () +setBufferSize client procPtr arg = + liftErrno $ JackFFI.set_buffer_size_callback (getClient client) procPtr arg + +withBufferSize :: + (JackExc.ThrowsErrno e) => + Client -> + (JackFFI.NFrames -> Sync.ExceptionalT Errno IO ()) -> + Sync.ExceptionalT e IO a -> + Sync.ExceptionalT e IO a +withBufferSize = + withCallback + (\bs -> + makeBufferSize $ \ nframes _arg -> + Sync.switchT return (\() -> return eOK) $ bs nframes) + setBufferSize + +foreign import ccall "wrapper" + makeSampleRate :: + JackFFI.SampleRate arg -> IO (FunPtr (JackFFI.SampleRate arg)) + +setSampleRate :: + (JackExc.ThrowsErrno e) => + Client -> + FunPtr (JackFFI.SampleRate arg) -> + Ptr arg -> + Sync.ExceptionalT e IO () +setSampleRate client procPtr arg = + liftErrno $ JackFFI.set_sample_rate_callback (getClient client) procPtr arg + +withSampleRate :: + (JackExc.ThrowsErrno e) => + Client -> + (JackFFI.NFrames -> Sync.ExceptionalT Errno IO ()) -> + Sync.ExceptionalT e IO a -> + Sync.ExceptionalT e IO a +withSampleRate = + withCallback + (\bs -> + makeSampleRate $ \ nframes _arg -> + Sync.switchT return (\() -> return eOK) $ bs nframes) + setSampleRate + +foreign import ccall "wrapper" + makePortRename :: + JackFFI.PortRename arg -> IO (FunPtr (JackFFI.PortRename arg)) + +setPortRename :: + (JackExc.ThrowsErrno e) => + Client -> + FunPtr (JackFFI.PortRename arg) -> + Ptr arg -> + Sync.ExceptionalT e IO () +setPortRename client procPtr arg = + liftErrno $ JackFFI.set_port_rename_callback (getClient client) procPtr arg + +withPortRename :: + (JackExc.ThrowsErrno e) => + Client -> + (JackFFI.PortId -> String -> String -> IO ()) -> + Sync.ExceptionalT e IO a -> + Sync.ExceptionalT e IO a +withPortRename = + withCallback + (\pr -> + makePortRename $ \ portid n1 n2 _arg -> + join $ + pr portid + <$> peekCString (JackFFI.deconsPortName n1) + <*> peekCString (JackFFI.deconsPortName n2)) + setPortRename + +foreign import ccall "wrapper" + makeGraphOrder :: + JackFFI.GraphOrder arg -> IO (FunPtr (JackFFI.GraphOrder arg)) + +setGraphOrder :: + (JackExc.ThrowsErrno e) => + Client -> + FunPtr (JackFFI.GraphOrder arg) -> + Ptr arg -> + Sync.ExceptionalT e IO () +setGraphOrder client procPtr arg = + liftErrno $ JackFFI.set_graph_order_callback (getClient client) procPtr arg + +withGraphOrder :: + (JackExc.ThrowsErrno e) => + Client -> + Sync.ExceptionalT Errno IO () -> + Sync.ExceptionalT e IO a -> + Sync.ExceptionalT e IO a +withGraphOrder = + withCallback + (\go -> makeGraphOrder $ \ _arg -> Sync.switchT return (\() -> return eOK) go) + setGraphOrder + +foreign import ccall "wrapper" + makeXRun :: JackFFI.XRun arg -> IO (FunPtr (JackFFI.XRun arg)) + +setXRun :: + (JackExc.ThrowsErrno e) => + Client -> + FunPtr (JackFFI.XRun arg) -> + Ptr arg -> + Sync.ExceptionalT e IO () +setXRun client procPtr arg = + liftErrno $ JackFFI.set_xrun_callback (getClient client) procPtr arg + +withXRun :: + (JackExc.ThrowsErrno e) => + Client -> + Sync.ExceptionalT Errno IO () -> + Sync.ExceptionalT e IO a -> + Sync.ExceptionalT e IO a +withXRun = + withCallback + (\go -> makeXRun $ \ _arg -> Sync.switchT return (\() -> return eOK) go) + setXRun + +foreign import ccall "wrapper" + makeLatency :: JackFFI.Latency arg -> IO (FunPtr (JackFFI.Latency arg)) + +setLatency :: + (JackExc.ThrowsErrno e) => + Client -> + FunPtr (JackFFI.Latency arg) -> + Ptr arg -> + Sync.ExceptionalT e IO () +setLatency client procPtr arg = + liftErrno $ JackFFI.set_latency_callback (getClient client) procPtr arg + +withLatency :: + (JackExc.ThrowsErrno e) => + Client -> + (LatencyCallbackMode -> IO ()) -> + Sync.ExceptionalT e IO a -> + Sync.ExceptionalT e IO a +withLatency = + withCallback + (\lc -> + makeLatency $ \ mode _arg -> + lc mode) + setLatency + +getLatencyRange :: + Port typ dir -> LatencyCallbackMode -> IO JackFFI.LatencyRange +getLatencyRange (Port ptr) mode = + with (JackFFI.LatencyRange (JackFFI.NFrames 0) (JackFFI.NFrames 0)) $ + \rptr -> JackFFI.port_get_latency_range ptr mode rptr >> peek rptr + +setLatencyRange :: + Port typ dir -> LatencyCallbackMode -> JackFFI.LatencyRange -> IO () +setLatencyRange (Port ptr) mode range = + with range $ JackFFI.port_set_latency_range ptr mode + +recomputeTotalLatencies :: + JackExc.ThrowsErrno e => Client -> Sync.ExceptionalT e IO () +recomputeTotalLatencies (Client ptr) = + liftErrno $ JackFFI.recompute_total_latencies ptr + getBufferSize :: Client -> IO Int getBufferSize (Client ptr) = fmap fromIntegral $ JackFFI.get_buffer_size ptr @@ -504,7 +751,10 @@ JackFFI.last_frame_time client -- | Create a client registration callback 'FunPtr'. -foreign import ccall "wrapper" makeClientRegistration :: JackFFI.ClientRegistration arg -> IO (FunPtr (JackFFI.ClientRegistration arg)) +foreign import ccall "wrapper" + makeClientRegistration :: + JackFFI.ClientRegistration arg -> + IO (FunPtr (JackFFI.ClientRegistration arg)) -- | Set the client registration callback. setClientRegistration :: @@ -533,7 +783,10 @@ -- | Create a port registration callback 'FunPtr'. -foreign import ccall "wrapper" makePortRegistration :: JackFFI.PortRegistration arg -> IO (FunPtr (JackFFI.PortRegistration arg)) +foreign import ccall "wrapper" + makePortRegistration :: + JackFFI.PortRegistration arg -> + IO (FunPtr (JackFFI.PortRegistration arg)) -- | Set the port registration callback. setPortRegistration :: @@ -560,7 +813,9 @@ -- | Create a port connect callback 'FunPtr'. -foreign import ccall "wrapper" makePortConnect :: JackFFI.PortConnect arg -> IO (FunPtr (JackFFI.PortConnect arg)) +foreign import ccall "wrapper" + makePortConnect :: + JackFFI.PortConnect arg -> IO (FunPtr (JackFFI.PortConnect arg)) -- | Set the port connect callback. setPortConnect :: diff --git a/src/Sound/JACK/Common.h b/src/Sound/JACK/Common.h new file mode 100644 --- /dev/null +++ b/src/Sound/JACK/Common.h @@ -0,0 +1,7 @@ +#include + +/* cf. FFI cookbook */ +#if __GLASGOW_HASKELL__ < 800 +#define hsc_alignment(t) \ + printf("(%lu)", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)); +#endif diff --git a/src/Sound/JACK/Exception.hs b/src/Sound/JACK/Exception.hs --- a/src/Sound/JACK/Exception.hs +++ b/src/Sound/JACK/Exception.hs @@ -10,7 +10,7 @@ import qualified Sound.JACK.FFI as JackFFI import qualified Foreign.C.Error as FE -import qualified Data.EnumSet as ES +import qualified Data.EnumBitSet as ES import Data.Bits (Bits, ) diff --git a/src/Sound/JACK/FFI.hsc b/src/Sound/JACK/FFI.hsc --- a/src/Sound/JACK/FFI.hsc +++ b/src/Sound/JACK/FFI.hsc @@ -25,19 +25,25 @@ import Foreign.Ptr (Ptr, FunPtr) import Foreign.C.String (CString) +import Foreign.Storable (Storable, pokeByteOff, peekByteOff) +import qualified Foreign.Storable as St import qualified Foreign.C.Error as E import qualified Foreign.C.Types as C -import qualified Data.EnumSet as ES +import Control.Applicative (liftA2) + +import qualified Data.EnumBitSet as ES import Data.Word (Word, Word32, Word64, ) import Data.Ix (Ix(range, inRange, rangeSize, index)) import Data.Monoid (Monoid, mempty, mappend, ) import Data.Semigroup (Semigroup, (<>), ) -import Numeric.NonNegative.Class as NonNeg +import qualified Numeric.NonNegative.Class as NonNeg #include "jack/types.h" +#include + data Client = Client data Port typ = Port @@ -49,7 +55,8 @@ foreign import ccall "static jack/jack.h jack_client_open" - client_open :: CString -> OpenOptionSet -> Ptr StatusSet -> CString -> IO (Ptr Client) + client_open :: + CString -> OpenOptionSet -> Ptr StatusSet -> CString -> IO (Ptr Client) {-# DEPRECATED client_new "use client_open instead" #-} foreign import ccall "static jack/jack.h jack_client_new" @@ -67,7 +74,8 @@ | ServerName deriving (Enum, Eq, Ord, Show, Ix) -wordNullOption, wordNoStartServer, wordUseExactName, wordServerName :: OpenOptionSet +wordNullOption, wordNoStartServer, wordUseExactName, wordServerName :: + OpenOptionSet wordNullOption = ES.empty wordNoStartServer = ES.fromEnum NoStartServer wordUseExactName = ES.fromEnum UseExactName @@ -135,6 +143,12 @@ newtype NFrames = NFrames #{type jack_nframes_t} deriving (Show, Eq, Ord) +instance Storable NFrames where + alignment _ = #{alignment jack_nframes_t} + sizeOf _ = #{size jack_nframes_t} + peek p = fmap NFrames $ peekByteOff p 0 + poke p (NFrames n) = pokeByteOff p 0 n + nframesToWord :: NFrames -> Word nframesToWord (NFrames n) = fromIntegral n @@ -175,6 +189,24 @@ set_process_callback :: Ptr Client -> FunPtr (Process arg) -> Ptr arg -> IO E.Errno +type Freewheel arg = C.CInt -> Ptr arg -> IO () + +foreign import ccall "static jack/jack.h jack_set_freewheel_callback" + set_freewheel_callback :: + Ptr Client -> FunPtr (Freewheel arg) -> Ptr arg -> IO E.Errno + +type BufferSize arg = NFrames -> Ptr arg -> IO E.Errno + +foreign import ccall "static jack/jack.h jack_set_buffer_size_callback" + set_buffer_size_callback :: + Ptr Client -> FunPtr (BufferSize arg) -> Ptr arg -> IO E.Errno + +type SampleRate arg = NFrames -> Ptr arg -> IO E.Errno + +foreign import ccall "static jack/jack.h jack_set_sample_rate_callback" + set_sample_rate_callback :: + Ptr Client -> FunPtr (SampleRate arg) -> Ptr arg -> IO E.Errno + type ClientRegistration arg = CString -> C.CInt -> Ptr arg -> IO () foreign import ccall "static jack/jack.h jack_set_client_registration_callback" @@ -195,13 +227,47 @@ set_port_registration_callback :: Ptr Client -> FunPtr (PortRegistration arg) -> Ptr arg -> IO E.Errno +type PortRename arg = PortId -> PortName -> PortName -> Ptr arg -> IO () + +foreign import ccall "static jack/jack.h jack_set_port_rename_callback" + set_port_rename_callback :: + Ptr Client -> FunPtr (PortRename arg) -> Ptr arg -> IO E.Errno + type PortConnect arg = PortId -> PortId -> C.CInt -> Ptr arg -> IO () foreign import ccall "static jack/jack.h jack_set_port_connect_callback" set_port_connect_callback :: Ptr Client -> FunPtr (PortConnect arg) -> Ptr arg -> IO E.Errno +type GraphOrder arg = Ptr arg -> IO E.Errno +foreign import ccall "static jack/jack.h jack_set_graph_order_callback" + set_graph_order_callback :: + Ptr Client -> FunPtr (GraphOrder arg) -> Ptr arg -> IO E.Errno + +type XRun arg = Ptr arg -> IO E.Errno + +foreign import ccall "static jack/jack.h jack_set_xrun_callback" + set_xrun_callback :: + Ptr Client -> FunPtr (XRun arg) -> Ptr arg -> IO E.Errno + +newtype + LatencyCallbackMode = + LatencyCallbackMode #{type jack_latency_callback_mode_t} + deriving (Eq, Ord, Show) + +jackCaptureLatency :: LatencyCallbackMode +jackCaptureLatency = LatencyCallbackMode #const JackCaptureLatency + +jackPlaybackLatency :: LatencyCallbackMode +jackPlaybackLatency = LatencyCallbackMode #const JackPlaybackLatency + +type Latency arg = LatencyCallbackMode -> Ptr arg -> IO () + +foreign import ccall "static jack/jack.h jack_set_latency_callback" + set_latency_callback :: + Ptr Client -> FunPtr (Latency arg) -> Ptr arg -> IO E.Errno + foreign import ccall "static jack/jack.h jack_port_by_id" port_by_id :: Ptr Client -> PortId -> IO (Ptr (Port UnknownType)) @@ -242,6 +308,30 @@ port_get_all_connections :: Ptr Client -> Ptr (Port typ) -> IO (Ptr CString) +data LatencyRange = LatencyRange NFrames NFrames deriving (Show, Eq, Ord) + +instance Storable LatencyRange where + alignment _ = #{alignment jack_latency_range_t} + sizeOf _ = #{size jack_latency_range_t} + peek p = + liftA2 LatencyRange + (#{peek jack_latency_range_t, min} p) + (#{peek jack_latency_range_t, max} p) + poke p (LatencyRange a b) = do + #{poke jack_latency_range_t, min} p a + #{poke jack_latency_range_t, max} p b + +foreign import ccall "static jack/jack.h jack_port_get_latency_range" + port_get_latency_range :: + Ptr (Port a) -> LatencyCallbackMode -> Ptr LatencyRange -> IO () + +foreign import ccall "static jack/jack.h jack_port_set_latency_range" + port_set_latency_range :: + Ptr (Port a) -> LatencyCallbackMode -> Ptr LatencyRange -> IO () + +foreign import ccall "static jack/jack.h jack_recompute_total_latencies" + recompute_total_latencies :: + Ptr Client -> IO E.Errno foreign import ccall "static jack/jack.h jack_last_frame_time" last_frame_time :: Ptr Client -> IO NFrames diff --git a/src/Sound/JACK/FFI/MIDI.hsc b/src/Sound/JACK/FFI/MIDI.hsc --- a/src/Sound/JACK/FFI/MIDI.hsc +++ b/src/Sound/JACK/FFI/MIDI.hsc @@ -1,6 +1,7 @@ {-# LANGUAGE ForeignFunctionInterface #-} #include "jack/midiport.h" +#include module Sound.JACK.FFI.MIDI ( @@ -43,10 +44,6 @@ import System.IO (hPutStrLn, stderr, ) --- cf. FFI cookbook -#if __GLASGOW_HASKELL__ < 800 -#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) -#endif -- could also be an empty data declaration data EventBuffer = EventBuffer