Safe Haskell | None |
---|---|
Language | Haskell98 |
The Jack module defines types and functions that allows you to use the JACK Audio Connection Kit.
Synopsis
- newtype Client = Client (Ptr Client)
- newClient :: ThrowsStatus e => String -> String -> ExceptionalT e IO Client
- newClientDefault :: ThrowsStatus e => String -> ExceptionalT e IO Client
- disposeClient :: ThrowsErrno e => Client -> ExceptionalT e IO ()
- withClient :: ThrowsStatus e => String -> String -> (Client -> ExceptionalT e IO a) -> ExceptionalT e IO a
- withClientDefault :: ThrowsStatus e => String -> (Client -> ExceptionalT e IO a) -> ExceptionalT e IO a
- clientClose :: ThrowsErrno e => Client -> PortSet -> ExceptionalT e IO ()
- activate :: ThrowsErrno e => Client -> ExceptionalT e IO ()
- deactivate :: ThrowsErrno e => Client -> ExceptionalT e IO ()
- withActivation :: ThrowsErrno e => Client -> ExceptionalT e IO () -> ExceptionalT e IO ()
- class PortType typ
- class Direction dir
- data Input
- data Output
- data UnknownType
- data UnknownDirection
- newtype Port typ dir = Port (Ptr (Port typ))
- newPort :: (PortType typ, Direction dir, ThrowsPortRegister e) => Client -> String -> ExceptionalT e IO (Port typ dir)
- disposePort :: (PortType typ, Direction dir, ThrowsErrno e) => Client -> Port typ dir -> ExceptionalT e IO ()
- withPort :: (PortType typ, Direction dir, ThrowsPortRegister e, ThrowsErrno e) => Client -> String -> (Port typ dir -> ExceptionalT e IO a) -> ExceptionalT e IO a
- data PortSet
- setOfPort :: (PortType typ, Direction dir) => Port typ dir -> PortSet
- setOfPorts :: (PortType typ, Direction dir) => [Port typ dir] -> PortSet
- type Process arg = NFrames -> Ptr arg -> IO Errno
- connect :: ThrowsErrno e => Client -> String -> String -> ExceptionalT e IO ()
- disconnect :: ThrowsErrno e => Client -> String -> String -> ExceptionalT e IO ()
- makeProcess :: Process arg -> IO (FunPtr (Process arg))
- setProcess :: ThrowsErrno e => Client -> FunPtr (Process arg) -> Ptr arg -> ExceptionalT e IO ()
- withProcess :: ThrowsErrno e => Client -> (NFrames -> ExceptionalT Errno IO ()) -> ExceptionalT e IO a -> ExceptionalT e IO a
- type Freewheel arg = CInt -> Ptr arg -> IO ()
- makeFreewheel :: Freewheel arg -> IO (FunPtr (Freewheel arg))
- setFreewheel :: ThrowsErrno e => Client -> FunPtr (Freewheel arg) -> Ptr arg -> ExceptionalT e IO ()
- withFreewheel :: ThrowsErrno e => Client -> (Bool -> IO ()) -> ExceptionalT e IO a -> ExceptionalT e IO a
- type BufferSize arg = NFrames -> Ptr arg -> IO Errno
- makeBufferSize :: BufferSize arg -> IO (FunPtr (BufferSize arg))
- setBufferSize :: ThrowsErrno e => Client -> FunPtr (BufferSize arg) -> Ptr arg -> ExceptionalT e IO ()
- withBufferSize :: ThrowsErrno e => Client -> (NFrames -> ExceptionalT Errno IO ()) -> ExceptionalT e IO a -> ExceptionalT e IO a
- type SampleRate arg = NFrames -> Ptr arg -> IO Errno
- makeSampleRate :: SampleRate arg -> IO (FunPtr (SampleRate arg))
- setSampleRate :: ThrowsErrno e => Client -> FunPtr (SampleRate arg) -> Ptr arg -> ExceptionalT e IO ()
- withSampleRate :: ThrowsErrno e => Client -> (NFrames -> ExceptionalT Errno IO ()) -> ExceptionalT e IO a -> ExceptionalT e IO a
- type PortRename arg = PortId -> PortName -> PortName -> Ptr arg -> IO ()
- makePortRename :: PortRename arg -> IO (FunPtr (PortRename arg))
- setPortRename :: ThrowsErrno e => Client -> FunPtr (PortRename arg) -> Ptr arg -> ExceptionalT e IO ()
- withPortRename :: ThrowsErrno e => Client -> (PortId -> String -> String -> IO ()) -> ExceptionalT e IO a -> ExceptionalT e IO a
- type GraphOrder arg = Ptr arg -> IO Errno
- makeGraphOrder :: GraphOrder arg -> IO (FunPtr (GraphOrder arg))
- setGraphOrder :: ThrowsErrno e => Client -> FunPtr (GraphOrder arg) -> Ptr arg -> ExceptionalT e IO ()
- withGraphOrder :: ThrowsErrno e => Client -> ExceptionalT Errno IO () -> ExceptionalT e IO a -> ExceptionalT e IO a
- type XRun arg = Ptr arg -> IO Errno
- makeXRun :: XRun arg -> IO (FunPtr (XRun arg))
- setXRun :: ThrowsErrno e => Client -> FunPtr (XRun arg) -> Ptr arg -> ExceptionalT e IO ()
- withXRun :: ThrowsErrno e => Client -> ExceptionalT Errno IO () -> ExceptionalT e IO a -> ExceptionalT e IO a
- type Latency arg = LatencyCallbackMode -> Ptr arg -> IO ()
- data LatencyCallbackMode
- makeLatency :: Latency arg -> IO (FunPtr (Latency arg))
- setLatency :: ThrowsErrno e => Client -> FunPtr (Latency arg) -> Ptr arg -> ExceptionalT e IO ()
- withLatency :: ThrowsErrno e => Client -> (LatencyCallbackMode -> IO ()) -> ExceptionalT e IO a -> ExceptionalT e IO a
- jackCaptureLatency :: LatencyCallbackMode
- jackPlaybackLatency :: LatencyCallbackMode
- data LatencyRange = LatencyRange NFrames NFrames
- getLatencyRange :: Port typ dir -> LatencyCallbackMode -> IO LatencyRange
- setLatencyRange :: Port typ dir -> LatencyCallbackMode -> LatencyRange -> IO ()
- recomputeTotalLatencies :: ThrowsErrno e => Client -> ExceptionalT e IO ()
- getBufferSize :: Client -> IO Int
- getSampleRate :: Client -> IO Int
- lastFrameTime :: Client -> IO NFrames
- type ClientRegistration arg = CString -> CInt -> Ptr arg -> IO ()
- makeClientRegistration :: ClientRegistration arg -> IO (FunPtr (ClientRegistration arg))
- setClientRegistration :: ThrowsErrno e => Client -> FunPtr (ClientRegistration arg) -> Ptr arg -> ExceptionalT e IO ()
- withClientRegistration :: ThrowsErrno e => Client -> (String -> Bool -> IO ()) -> ExceptionalT e IO a -> ExceptionalT e IO a
- data PortId
- makePortRegistration :: PortRegistration arg -> IO (FunPtr (PortRegistration arg))
- setPortRegistration :: ThrowsErrno e => Client -> FunPtr (PortRegistration arg) -> Ptr arg -> ExceptionalT e IO ()
- withPortRegistration :: ThrowsErrno e => Client -> (PortId -> Bool -> IO ()) -> ExceptionalT e IO a -> ExceptionalT e IO a
- type PortConnect arg = PortId -> PortId -> CInt -> Ptr arg -> IO ()
- makePortConnect :: PortConnect arg -> IO (FunPtr (PortConnect arg))
- setPortConnect :: ThrowsErrno e => Client -> FunPtr (PortConnect arg) -> Ptr arg -> ExceptionalT e IO ()
- withPortConnect :: ThrowsErrno e => Client -> (PortId -> PortId -> Bool -> IO ()) -> ExceptionalT e IO a -> ExceptionalT e IO a
- portById :: Client -> PortId -> IO (Port UnknownType UnknownDirection)
- portByName :: Client -> String -> IO (Port UnknownType UnknownDirection)
- portName :: Port typ dir -> IO String
- portShortName :: Port typ dir -> IO String
- portAliases :: Port typ dir -> IO [String]
- getPorts :: Client -> IO [String]
- portGetAllConnections :: Client -> Port typ dir -> IO [String]
- narrowPort :: (PortType typ, Direction dir, ThrowsPortMismatch e) => Port UnknownType UnknownDirection -> ExceptionalT e IO (Port typ dir)
- narrowPortType :: (PortType typ, ThrowsPortMismatch e) => Port UnknownType dir -> ExceptionalT e IO (Port typ dir)
- narrowPortDirection :: (Direction dir, ThrowsPortMismatch e) => Port typ UnknownDirection -> ExceptionalT e IO (Port typ dir)
- switchUnknownTypePort :: ThrowsPortMismatch e => Port UnknownType dir -> (Port CFloat dir -> ExceptionalT e IO a) -> (Port EventBuffer dir -> ExceptionalT e IO a) -> ExceptionalT e IO a
- switchUnknownDirectionPort :: ThrowsPortMismatch e => Port typ UnknownDirection -> (Port typ Input -> ExceptionalT e IO a) -> (Port typ Output -> ExceptionalT e IO a) -> ExceptionalT e IO a
- newtype NFrames = NFrames Word32
- nframesIndices :: NFrames -> [NFrames]
- nframesBounds :: NFrames -> (NFrames, NFrames)
- quit :: MVar () -> Client -> PortSet -> IO ()
- waitForBreakAndClose :: Client -> PortSet -> IO ()
- waitForBreak :: IO ()
- handleExceptions :: ExceptionalT All IO () -> IO ()
general stuff
:: ThrowsStatus e | |
=> String | name of the JACK server |
-> String | name of the client |
-> ExceptionalT e IO Client |
Constructs a new Jack client.
:: ThrowsStatus e | |
=> String | name of the client |
-> ExceptionalT e IO Client |
Creates a new JACK client with the default
server
disposeClient :: ThrowsErrno e => Client -> ExceptionalT e IO () Source #
:: ThrowsStatus e | |
=> String | name of the JACK server |
-> String | name of the client |
-> (Client -> ExceptionalT e IO a) | |
-> ExceptionalT e IO a |
Run a block of code with a newly allocated client. Do not use the client outside the block.
:: ThrowsStatus e | |
=> String | name of the client |
-> (Client -> ExceptionalT e IO a) | |
-> ExceptionalT e IO a |
clientClose :: ThrowsErrno e => Client -> PortSet -> ExceptionalT e IO () Source #
closes the given Jack client without causing any trouble (hopefully)
activate :: ThrowsErrno e => Client -> ExceptionalT e IO () Source #
activates the given Jack client
deactivate :: ThrowsErrno e => Client -> ExceptionalT e IO () Source #
withActivation :: ThrowsErrno e => Client -> ExceptionalT e IO () -> ExceptionalT e IO () Source #
Jack Port Type
switchPortType
Instances
PortType CFloat Source # | |
Defined in Sound.JACK.Private switchPortType :: f CFloat -> f EventBuffer -> f CFloat |
switchDir
Type argument for Jack input ports
Type argument for Jack output ports
data UnknownType Source #
Type argument for Jack ports where the type of samples transported by the port is unknown.
data UnknownDirection Source #
Type argument for Jack ports where we do not know whether it is an input or an output port.
:: (PortType typ, Direction dir, ThrowsPortRegister e) | |
=> Client | Jack client |
-> String | name of the input port |
-> ExceptionalT e IO (Port typ dir) |
Better use withPort
that also handles freeing the port.
disposePort :: (PortType typ, Direction dir, ThrowsErrno e) => Client -> Port typ dir -> ExceptionalT e IO () Source #
:: (PortType typ, Direction dir, ThrowsPortRegister e, ThrowsErrno e) | |
=> Client | Jack client |
-> String | name of the input port |
-> (Port typ dir -> ExceptionalT e IO a) | |
-> ExceptionalT e IO a |
Creates a new port for the given client and delete it after usage. The port manages audio or MIDI data in input or output direction depending on the Port type. Usually the required port type can be inferred from following actions that use that port.
Do not use the port outside the enclosed block.
A collection of mixed types of ports. It is mainly needed for freeing all allocated ports.
connect :: ThrowsErrno e => Client -> String -> String -> ExceptionalT e IO () Source #
disconnect :: ThrowsErrno e => Client -> String -> String -> ExceptionalT e IO () Source #
setProcess :: ThrowsErrno e => Client -> FunPtr (Process arg) -> Ptr arg -> ExceptionalT e IO () Source #
withProcess :: ThrowsErrno e => Client -> (NFrames -> ExceptionalT Errno IO ()) -> ExceptionalT e IO a -> ExceptionalT e IO a Source #
The callback function must respond in real-time, i.e. in a bounded amout of time. That is, strictly spoken it must not wait for anything, e.g. it must not wait for locks and it must not allocate memory. In Haskell this is practically impossible because even simplest operations allocate memory. If the callback needs to much time, JACK will shut down your client. The best you can do is to hope that nothing evil happens.
setFreewheel :: ThrowsErrno e => Client -> FunPtr (Freewheel arg) -> Ptr arg -> ExceptionalT e IO () Source #
withFreewheel :: ThrowsErrno e => Client -> (Bool -> IO ()) -> ExceptionalT e IO a -> ExceptionalT e IO a Source #
makeBufferSize :: BufferSize arg -> IO (FunPtr (BufferSize arg)) Source #
setBufferSize :: ThrowsErrno e => Client -> FunPtr (BufferSize arg) -> Ptr arg -> ExceptionalT e IO () Source #
withBufferSize :: ThrowsErrno e => Client -> (NFrames -> ExceptionalT Errno IO ()) -> ExceptionalT e IO a -> ExceptionalT e IO a Source #
makeSampleRate :: SampleRate arg -> IO (FunPtr (SampleRate arg)) Source #
setSampleRate :: ThrowsErrno e => Client -> FunPtr (SampleRate arg) -> Ptr arg -> ExceptionalT e IO () Source #
withSampleRate :: ThrowsErrno e => Client -> (NFrames -> ExceptionalT Errno IO ()) -> ExceptionalT e IO a -> ExceptionalT e IO a Source #
makePortRename :: PortRename arg -> IO (FunPtr (PortRename arg)) Source #
setPortRename :: ThrowsErrno e => Client -> FunPtr (PortRename arg) -> Ptr arg -> ExceptionalT e IO () Source #
withPortRename :: ThrowsErrno e => Client -> (PortId -> String -> String -> IO ()) -> ExceptionalT e IO a -> ExceptionalT e IO a Source #
makeGraphOrder :: GraphOrder arg -> IO (FunPtr (GraphOrder arg)) Source #
setGraphOrder :: ThrowsErrno e => Client -> FunPtr (GraphOrder arg) -> Ptr arg -> ExceptionalT e IO () Source #
withGraphOrder :: ThrowsErrno e => Client -> ExceptionalT Errno IO () -> ExceptionalT e IO a -> ExceptionalT e IO a Source #
setXRun :: ThrowsErrno e => Client -> FunPtr (XRun arg) -> Ptr arg -> ExceptionalT e IO () Source #
withXRun :: ThrowsErrno e => Client -> ExceptionalT Errno IO () -> ExceptionalT e IO a -> ExceptionalT e IO a Source #
data LatencyCallbackMode Source #
Instances
Eq LatencyCallbackMode Source # | |
Defined in Sound.JACK.FFI (==) :: LatencyCallbackMode -> LatencyCallbackMode -> Bool # (/=) :: LatencyCallbackMode -> LatencyCallbackMode -> Bool # | |
Ord LatencyCallbackMode Source # | |
Defined in Sound.JACK.FFI compare :: LatencyCallbackMode -> LatencyCallbackMode -> Ordering # (<) :: LatencyCallbackMode -> LatencyCallbackMode -> Bool # (<=) :: LatencyCallbackMode -> LatencyCallbackMode -> Bool # (>) :: LatencyCallbackMode -> LatencyCallbackMode -> Bool # (>=) :: LatencyCallbackMode -> LatencyCallbackMode -> Bool # max :: LatencyCallbackMode -> LatencyCallbackMode -> LatencyCallbackMode # min :: LatencyCallbackMode -> LatencyCallbackMode -> LatencyCallbackMode # | |
Show LatencyCallbackMode Source # | |
Defined in Sound.JACK.FFI showsPrec :: Int -> LatencyCallbackMode -> ShowS # show :: LatencyCallbackMode -> String # showList :: [LatencyCallbackMode] -> ShowS # |
setLatency :: ThrowsErrno e => Client -> FunPtr (Latency arg) -> Ptr arg -> ExceptionalT e IO () Source #
withLatency :: ThrowsErrno e => Client -> (LatencyCallbackMode -> IO ()) -> ExceptionalT e IO a -> ExceptionalT e IO a Source #
data LatencyRange Source #
Instances
getLatencyRange :: Port typ dir -> LatencyCallbackMode -> IO LatencyRange Source #
setLatencyRange :: Port typ dir -> LatencyCallbackMode -> LatencyRange -> IO () Source #
recomputeTotalLatencies :: ThrowsErrno e => Client -> ExceptionalT e IO () Source #
makeClientRegistration :: ClientRegistration arg -> IO (FunPtr (ClientRegistration arg)) Source #
Create a client registration callback FunPtr
.
setClientRegistration :: ThrowsErrno e => Client -> FunPtr (ClientRegistration arg) -> Ptr arg -> ExceptionalT e IO () Source #
Set the client registration callback.
withClientRegistration :: ThrowsErrno e => Client -> (String -> Bool -> IO ()) -> ExceptionalT e IO a -> ExceptionalT e IO a Source #
makePortRegistration :: PortRegistration arg -> IO (FunPtr (PortRegistration arg)) Source #
Create a port registration callback FunPtr
.
setPortRegistration :: ThrowsErrno e => Client -> FunPtr (PortRegistration arg) -> Ptr arg -> ExceptionalT e IO () Source #
Set the port registration callback.
withPortRegistration :: ThrowsErrno e => Client -> (PortId -> Bool -> IO ()) -> ExceptionalT e IO a -> ExceptionalT e IO a Source #
makePortConnect :: PortConnect arg -> IO (FunPtr (PortConnect arg)) Source #
Create a port connect callback FunPtr
.
setPortConnect :: ThrowsErrno e => Client -> FunPtr (PortConnect arg) -> Ptr arg -> ExceptionalT e IO () Source #
Set the port connect callback.
withPortConnect :: ThrowsErrno e => Client -> (PortId -> PortId -> Bool -> IO ()) -> ExceptionalT e IO a -> ExceptionalT e IO a Source #
portById :: Client -> PortId -> IO (Port UnknownType UnknownDirection) Source #
portByName :: Client -> String -> IO (Port UnknownType UnknownDirection) Source #
portName :: Port typ dir -> IO String Source #
Return the full port name, including the client_name:
prefix.
portShortName :: Port typ dir -> IO String Source #
Return the short port name, not including the client_name:
prefix.
portAliases :: Port typ dir -> IO [String] Source #
Return the port aliases, including the client_name:
prefixes.
This is especially useful for external midi devices,
as the alias names are usually more descriptive than system:midi_capture_1
.
Returns the names of all existing ports.
portGetAllConnections :: Client -> Port typ dir -> IO [String] Source #
Return all the port names a given port is connected to.
This function must not be called from a JACK event callback.
narrowPort :: (PortType typ, Direction dir, ThrowsPortMismatch e) => Port UnknownType UnknownDirection -> ExceptionalT e IO (Port typ dir) Source #
narrowPortType :: (PortType typ, ThrowsPortMismatch e) => Port UnknownType dir -> ExceptionalT e IO (Port typ dir) Source #
narrowPortDirection :: (Direction dir, ThrowsPortMismatch e) => Port typ UnknownDirection -> ExceptionalT e IO (Port typ dir) Source #
switchUnknownTypePort :: ThrowsPortMismatch e => Port UnknownType dir -> (Port CFloat dir -> ExceptionalT e IO a) -> (Port EventBuffer dir -> ExceptionalT e IO a) -> ExceptionalT e IO a Source #
switchUnknownDirectionPort :: ThrowsPortMismatch e => Port typ UnknownDirection -> (Port typ Input -> ExceptionalT e IO a) -> (Port typ Output -> ExceptionalT e IO a) -> ExceptionalT e IO a Source #
represents absolute frame time
Instances
Eq NFrames Source # | |
Ord NFrames Source # | |
Show NFrames Source # | |
Ix NFrames Source # | |
Defined in Sound.JACK.FFI | |
Semigroup NFrames Source # | |
Monoid NFrames Source # | |
Storable NFrames Source # | |
C NFrames Source # | |
nframesIndices :: NFrames -> [NFrames] Source #
waitForBreakAndClose :: Client -> PortSet -> IO () Source #
Deprecated: Write your own function instead.
waitForBreak :: IO () Source #
Exceptions
handleExceptions :: ExceptionalT All IO () -> IO () Source #