jack 0.6.1.1 → 0.6.2
raw patch · 10 files changed
+754/−387 lines, 10 filesdep +jackdep ~basedep ~bytestring
Dependencies added: jack
Dependency ranges changed: base, bytestring
Files
- free/Sound/JACK/FFIFree.hs +9/−0
- jack.cabal +61/−29
- jackfree/Sound/JACK/FFIFree.hs +9/−0
- src/Sound/JACK.hs +221/−12
- src/Sound/JACK/Exception.hs +41/−1
- src/Sound/JACK/FFI.hs +0/−193
- src/Sound/JACK/FFI.hsc +251/−0
- src/Sound/JACK/FFI/MIDI.chs +0/−148
- src/Sound/JACK/FFI/MIDI.hsc +150/−0
- src/Sound/JACK/Private.hs +12/−4
+ free/Sound/JACK/FFIFree.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Sound.JACK.FFIFree where++import Foreign.Ptr (Ptr)+import Foreign.C.String (CString)++-- | Free an array of NULL terminated port names returned by 'get_ports' and 'port_get_all_connections'.+foreign import ccall "static stdlib.h free"+ freePortNameArray :: Ptr CString -> IO ()
jack.cabal view
@@ -1,20 +1,27 @@ Name: jack-Version: 0.6.1.1+Version: 0.6.2 License: GPL License-File: LICENSE-Author: Soenke Hahn, Henning Thielemann+Author: Soenke Hahn, Stefan Kersten, Henning Thielemann Maintainer: Henning Thielemann <haskell@henning-thielemann.de> Synopsis: Bindings for the JACK Audio Connection Kit-Description: Very basic bindings for the JACK Audio Connection Kit+Description:+ Very basic bindings for the JACK Audio Connection Kit.+ It has support both for PCM audio and MIDI handling.+ .+ In order to adapt to your system,+ you may have to disable pkgConfig or jackFree cabal flags. Homepage: http://www.haskell.org/haskellwiki/JACK Category: Sound Build-Type: Simple-Cabal-Version: >=1.6+Cabal-Version: >=1.14 Tested-With: GHC==6.8.2, GHC==6.10.4, GHC==6.12.3 Tested-With: GHC==7.0.2, GHC==7.2.1, GHC==7.4.1 Extra-Source-Files: README INSTALL+ free/Sound/JACK/FFIFree.hs+ jackfree/Sound/JACK/FFIFree.hs Source-Repository head type: darcs@@ -23,8 +30,16 @@ Source-Repository this type: darcs location: http://code.haskell.org/jack/- tag: 0.6.1.1+ tag: 0.6.2 +Flag pkgConfig+ description: Use pkg-config tool for check version and presence of jack+ default: True++Flag jackFree+ description: Use jack_free instead of free+ default: True+ Flag buildExamples description: Build example executables default: False@@ -32,7 +47,7 @@ Library Build-Depends: midi >=0.1.5.2 && <0.3,- bytestring >=0.9.1.4 && <0.10,+ bytestring >=0.9.1.4 && <0.11, explicit-exception >=0.1.5 && <0.2, transformers >=0.2 && <0.4, enumset >=0.0 && <0.1,@@ -47,8 +62,10 @@ Other-Modules: Sound.JACK.Private Sound.JACK.FFI+ Sound.JACK.FFIFree Sound.JACK.FFI.MIDI- Build-Tools: c2hs>=0.15.1+ Default-Language: Haskell98+ Build-Tools: hsc2hs >=0.66 && <1.0 Hs-Source-Dirs: src GHC-Options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates If impl(ghc >= 6.12)@@ -56,44 +73,59 @@ If os(darwin) CC-Options: -U__BLOCKS__ - Extensions: ForeignFunctionInterface- -- use extra-libraries, if pkg-config fails- -- http://hackage.haskell.org/trac/hackage/ticket/170- -- Extra-Libraries: jack- --- -- There seem to be two lines of JACK:- -- JACK1 as used by Kubuntu, e.g. jack-0.118.0- -- JACK2 as used by Suse, e.g. jack-1.9.0- -- Thus I just omit the jack version here- PkgConfig-depends: jack+ Other-Extensions: ForeignFunctionInterface Includes: jack/jack.h, jack/midiport.h + If flag(jackFree)+ Hs-Source-Dirs: jackfree+ Else+ Hs-Source-Dirs: free++ If flag(pkgConfig)+ -- There seem to be two lines of JACK:+ -- JACK1 as used by Ubuntu, e.g. jack-0.118.0+ -- JACK2 as used by Suse, e.g. jack-1.9.0+ If flag(jackFree)+ PkgConfig-depends: jack (>=0.118 && <1) || (>=1.9.8 && <2)+ Else+ PkgConfig-depends: jack (>=0.0 && <0.118) || (>=1.9.0 && <1.9.8)+ Else+ -- use extra-libraries, if pkg-config fails+ -- http://hackage.haskell.org/trac/hackage/ticket/170+ Extra-Libraries: jack+ Executable amplify If !flag(buildExamples) Buildable: False+ Default-Language: Haskell98 GHC-Options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates- Extensions: ForeignFunctionInterface- Extra-Libraries: jack- Other-Modules: Sound.JACK.FFI.MIDI- Hs-Source-Dirs: src, .+ Hs-Source-Dirs: .+ Build-Depends:+ jack,+ base >=3.0 && <5 Main-Is: examples/Amplify.hs Executable impulse-train If !flag(buildExamples) Buildable: False+ Default-Language: Haskell98 GHC-Options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates- Extensions: ForeignFunctionInterface- Extra-Libraries: jack- Other-Modules: Sound.JACK.FFI.MIDI- Hs-Source-Dirs: src, .+ Hs-Source-Dirs: .+ Build-Depends:+ jack,+ transformers >=0.2 && <0.4,+ array >=0.2 && <0.5,+ base >=3.0 && <5 Main-Is: examples/ImpulseTrain.hs Executable midimon If !flag(buildExamples) Buildable: False+ Default-Language: Haskell98 GHC-Options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates- Extensions: ForeignFunctionInterface- Extra-Libraries: jack- Other-Modules: Sound.JACK.FFI.MIDI- Hs-Source-Dirs: src, .+ Hs-Source-Dirs: .+ Build-Depends:+ jack,+ midi >=0.1.5.2 && <0.3,+ base >=3.0 && <5 Main-Is: examples/Midimon.hs
+ jackfree/Sound/JACK/FFIFree.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Sound.JACK.FFIFree where++import Foreign.Ptr (Ptr)+import Foreign.C.String (CString)++-- | Free an array of NULL terminated port names returned by 'get_ports' and 'port_get_all_connections'.+foreign import ccall "static jack/jack.h jack_free"+ freePortNameArray :: Ptr CString -> IO ()
src/Sound/JACK.hs view
@@ -34,7 +34,6 @@ withClient, withClientDefault, clientClose,- getPorts, activate, deactivate,@@ -42,6 +41,7 @@ PortType, Direction, Input, Output,+ JackFFI.UnknownType, UnknownDirection, Port, newPort,@@ -60,6 +60,30 @@ getSampleRate, + mkClientRegistration,+ setClientRegistration,++ JackFFI.PortId,+ mkPortRegistration,+ setPortRegistration,+ mkPortConnect,+ setPortConnect,++ portById,+ portByName,++ portName,+ portShortName,++ getPorts,+ portGetAllConnections,++ narrowPort,+ narrowPortType,+ narrowPortDirection,+ switchUnknownTypePort,+ switchUnknownDirectionPort,+ JackFFI.NFrames(JackFFI.NFrames), nframesIndices, nframesBounds, quit, waitForBreakAndClose,@@ -74,17 +98,20 @@ import qualified Sound.JACK.Exception as JackExc 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, nframesIndices, nframesBounds, ) import qualified Control.Monad.Exception.Synchronous as Sync import qualified Control.Monad.Trans.Class as Trans+import Control.Exception (finally, ) import qualified Foreign.Marshal.Array as Array import qualified Foreign.C.String as CString import qualified Foreign.C.Types as C import Foreign.Storable (Storable, peek, ) import Foreign.Ptr (Ptr, FunPtr, nullPtr, castPtr, )-import Foreign.C.String (peekCString, )+import Foreign.C.String (CString, peekCString, ) import Foreign.C.Error (Errno(Errno), ) import qualified Data.EnumSet as ES @@ -99,20 +126,30 @@ class Direction dir where dirToFlags :: dir -> JackFFI.PortFlagSet --- | Handles of Jack input ports+-- | Type argument for Jack input ports data Input = Input instance Direction Input where dirToFlags ~Input = JackFFI.portIsInput --- | Handles of Jack output ports+-- | Type argument for Jack output ports data Output = Output instance Direction Output where dirToFlags ~Output = JackFFI.portIsOutput +{- |+Type argument for Jack ports+where we do not know+whether it is an input or an output port.+-}+data UnknownDirection = UnknownDirection +_dummyUnknownDirection :: UnknownDirection+_dummyUnknownDirection = UnknownDirection ++ -- | Constructs a new Jack client. newClient :: (JackExc.ThrowsStatus e) =>@@ -185,13 +222,13 @@ JackExc.ThrowsPortRegister e) => JackFFI.PortFlagSet -> Client -> String -> Sync.ExceptionalT e IO (Port typ dir)-newPortByType flags (Client client) portName =+newPortByType flags (Client client) name = let aux :: (PortType typ, Direction dir, JackExc.ThrowsPortRegister e) => typ -> dir -> Sync.ExceptionalT e IO (Port typ dir) aux portType dir =- withPortName portName $ \cPortName ->+ withPortName name $ \cPortName -> withCString (portTypeToCString portType) $ \pType -> do -- putStrLn ("register..." ++ show (client, cstring, pType, inout, 0)) port <- Trans.lift $@@ -260,8 +297,8 @@ Client -> Sync.ExceptionalT e IO () -> Sync.ExceptionalT e IO ()-withActivation client act =- bracket (activate client) (\() -> deactivate client) (\() -> act)+withActivation client =+ bracket_ (activate client) (deactivate client) -- | closes the given Jack client without causing any trouble (hopefully) clientClose ::@@ -295,14 +332,21 @@ withPortName name f = withCString name $ f . JackFFI.PortName --- | returns the names of all existing ports of the given Jack client+peekPortNameArray :: Ptr CString -> IO [String]+peekPortNameArray a =+ if a == nullPtr+ then return []+ else finally+ (mapM peekCString =<< Array.peekArray0 nullPtr a)+ (JackFFIFree.freePortNameArray a)++-- | Returns the names of all existing ports. getPorts :: Client -- ^ the Jack client -> IO [String] -- ^ the names as a list of strings getPorts client = CString.withCString "" $ \empty -> do- mapM peekCString- =<< Array.peekArray0 nullPtr- =<< JackFFI.get_ports (getClient client) empty empty 0+ JackFFI.get_ports (getClient client) empty empty 0+ >>= peekPortNameArray connect ::@@ -391,3 +435,168 @@ getSampleRate :: Client -> IO Int getSampleRate (Client ptr) = fmap fromIntegral $ JackFFI.get_sample_rate ptr+++-- | Create a client registration callback 'FunPtr'.+foreign import ccall "wrapper" mkClientRegistration :: JackFFI.ClientRegistration -> IO (FunPtr JackFFI.ClientRegistration)++-- | Set the client registration callback.+setClientRegistration ::+ (JackExc.ThrowsErrno e) =>+ Client ->+ FunPtr JackFFI.ClientRegistration ->+ Sync.ExceptionalT e IO ()+setClientRegistration client procPtr =+ liftErrno $ JackFFI.set_client_registration_callback (getClient client) procPtr nullPtr+++-- | Create a port registration callback 'FunPtr'.+foreign import ccall "wrapper" mkPortRegistration :: JackFFI.PortRegistration -> IO (FunPtr JackFFI.PortRegistration)++-- | Set the port registration callback.+setPortRegistration ::+ (JackExc.ThrowsErrno e) =>+ Client ->+ FunPtr JackFFI.PortRegistration ->+ Sync.ExceptionalT e IO ()+setPortRegistration client procPtr =+ liftErrno $ JackFFI.set_port_registration_callback (getClient client) procPtr nullPtr+++-- | Create a port connect callback 'FunPtr'.+foreign import ccall "wrapper" mkPortConnect :: JackFFI.PortConnect -> IO (FunPtr JackFFI.PortConnect)++-- | Set the port connect callback.+setPortConnect ::+ (JackExc.ThrowsErrno e) =>+ Client ->+ FunPtr JackFFI.PortConnect ->+ Sync.ExceptionalT e IO ()+setPortConnect client procPtr =+ liftErrno $ JackFFI.set_port_connect_callback (getClient client) procPtr nullPtr+++portById ::+ Client -> JackFFI.PortId ->+ IO (Port JackFFI.UnknownType UnknownDirection)+portById client portId =+ fmap Port $+ JackFFI.port_by_id (getClient client) portId++portByName ::+ Client -> String ->+ IO (Port JackFFI.UnknownType UnknownDirection)+portByName client name =+ fmap Port $+ CString.withCString name $ JackFFI.port_by_name (getClient client) . JackFFI.PortName++-- | Return the full port name, including the @client_name:@ prefix.+portName :: Port typ dir -> IO String+portName (Port port) = JackFFI.port_name port >>= peekCString++-- | Return the short port name, not including the @client_name:@ prefix.+portShortName :: Port typ dir -> IO String+portShortName (Port port) = JackFFI.port_short_name port >>= peekCString++-- | Return all the port names a given port is connected to.+--+-- This function must not be called from a JACK event callback.+portGetAllConnections ::+ Client -> Port typ dir -> IO [String]+portGetAllConnections client (Port port) =+ JackFFI.port_get_all_connections (getClient client) port+ >>= peekPortNameArray++narrowPort ::+ (PortType typ, Direction dir, JackExc.ThrowsPortMismatch e) =>+ Port JackFFI.UnknownType UnknownDirection ->+ Sync.ExceptionalT e IO (Port typ dir)+narrowPort port =+ narrowPortType =<< narrowPortDirection port++narrowPortType ::+ (PortType typ, JackExc.ThrowsPortMismatch e) =>+ Port JackFFI.UnknownType dir ->+ Sync.ExceptionalT e IO (Port typ dir)+narrowPortType =+ let aux ::+ (PortType typ,+ JackExc.ThrowsPortMismatch e) =>+ typ -> Port JackFFI.UnknownType dir ->+ Sync.ExceptionalT e IO (Port typ dir)+ aux portType (Port port) = do+ typ <-+ Trans.lift $+ peekCString . JackFFI.deconsPortName =<< JackFFI.port_type port+ Sync.assertT (JackExc.portMismatch JackExc.TypeMismatch) $+ portTypeToCString portType == typ+ return $ Port $ castPtr port+ in aux undefined++narrowPortDirection ::+ (Direction dir, JackExc.ThrowsPortMismatch e) =>+ Port typ UnknownDirection ->+ Sync.ExceptionalT e IO (Port typ dir)+narrowPortDirection =+ let aux ::+ (Direction dir,+ JackExc.ThrowsPortMismatch e) =>+ dir -> Port typ UnknownDirection ->+ Sync.ExceptionalT e IO (Port typ dir)+ aux dir (Port port) = do+ flags <- Trans.lift $ JackFFI.port_flags port+ Sync.assertT (JackExc.portMismatch JackExc.DirectionMismatch) $+ not $ ES.disjoint flags $ dirToFlags dir+ return $ Port port+ in aux undefined++switchUnknownTypePort ::+ (JackExc.ThrowsPortMismatch e) =>+ Port JackFFI.UnknownType dir ->+ (Port C.CFloat dir -> Sync.ExceptionalT e IO a) ->+ (Port EventBuffer dir -> Sync.ExceptionalT e IO a) ->+ Sync.ExceptionalT e IO a+switchUnknownTypePort (Port port) audio midi = do+ typ <-+ Trans.lift $+ peekCString . JackFFI.deconsPortName+ =<< JackFFI.port_type port+ let ifMatch ::+ (PortType typ, Monad m) =>+ typ -> (Port typ dir -> m a) ->+ Port typ dir -> m a -> m a+ ifMatch portType trueAct p falseAct =+ if portTypeToCString portType == typ+ then trueAct p+ else falseAct+ case Port $ castPtr port of+ audioPort ->+ ifMatch undefined audio audioPort $+ case Port $ castPtr port of+ midiPort ->+ ifMatch undefined midi midiPort $+ Sync.throwT $ JackExc.portMismatch JackExc.TypeMismatch++switchUnknownDirectionPort ::+ (JackExc.ThrowsPortMismatch e) =>+ Port typ UnknownDirection ->+ (Port typ Input -> Sync.ExceptionalT e IO a) ->+ (Port typ Output -> Sync.ExceptionalT e IO a) ->+ Sync.ExceptionalT e IO a+switchUnknownDirectionPort (Port port) input output = do+ flags <- Trans.lift $ JackFFI.port_flags port+ let ifMatch ::+ (Direction dir, Monad m) =>+ dir -> (Port typ dir -> m a) ->+ Port typ dir -> m a -> m a+ ifMatch dir trueAct p falseAct =+ if not $ ES.disjoint flags $ dirToFlags dir+ then trueAct p+ else falseAct+ case Port port of+ inPort ->+ ifMatch undefined input inPort $+ case Port port of+ outPort ->+ ifMatch undefined output outPort $+ Sync.throwT $ JackExc.portMismatch JackExc.DirectionMismatch
src/Sound/JACK/Exception.hs view
@@ -3,6 +3,7 @@ All, ThrowsStatus (status), Status(..), ThrowsPortRegister (portRegister), PortRegister(..),+ ThrowsPortMismatch (portMismatch), PortMismatch(..), PortMismatchKind(..), ThrowsErrno (errno), Errno(..), ) where @@ -14,7 +15,7 @@ -type All = Status (PortRegister (FE.Errno))+type All = Status (PortRegister (PortMismatch FE.Errno)) toStringWithHead :: All -> String@@ -48,6 +49,9 @@ instance ThrowsPortRegister e => ThrowsPortRegister (Status e) where portRegister = NoStatus portRegister +instance ThrowsPortMismatch e => ThrowsPortMismatch (Status e) where+ portMismatch = NoStatus . portMismatch+ instance ThrowsErrno e => ThrowsErrno (Status e) where errno = NoStatus . errno @@ -76,11 +80,44 @@ instance ThrowsPortRegister (PortRegister e) where portRegister = PortRegister +instance ThrowsPortMismatch e => ThrowsPortMismatch (PortRegister e) where+ portMismatch = NoPortRegister . portMismatch+ instance ThrowsErrno e => ThrowsErrno (PortRegister e) where errno = NoPortRegister . errno +class ThrowsPortMismatch e where+ portMismatch :: PortMismatchKind -> e++data PortMismatch e =+ PortMismatch PortMismatchKind+ | NoPortMismatch e++data PortMismatchKind = TypeMismatch | DirectionMismatch++instance ToString e => ToString (PortMismatch e) where+ toString e0 =+ case e0 of+ PortMismatch TypeMismatch -> "port not of excpected type"+ PortMismatch DirectionMismatch -> "port does not support excpected direction"+ NoPortMismatch e1 -> toString e1++instance ThrowsStatus e => ThrowsStatus (PortMismatch e) where+ status = NoPortMismatch . status++instance ThrowsPortRegister e => ThrowsPortRegister (PortMismatch e) where+ portRegister = NoPortMismatch portRegister++instance ThrowsPortMismatch (PortMismatch e) where+ portMismatch = PortMismatch++instance ThrowsErrno e => ThrowsErrno (PortMismatch e) where+ errno = NoPortMismatch . errno+++ class ThrowsErrno e where errno :: FE.Errno -> e @@ -102,6 +139,9 @@ instance ThrowsPortRegister e => ThrowsPortRegister (Errno e) where portRegister = NoErrno portRegister++instance ThrowsPortMismatch e => ThrowsPortMismatch (Errno e) where+ portMismatch = NoErrno . portMismatch instance ThrowsErrno (Errno e) where errno = Errno
− src/Sound/JACK/FFI.hs
@@ -1,193 +0,0 @@--- -*-haskell-*--{-# LANGUAGE ForeignFunctionInterface #-}--{-- JACK bindings for Haskell- Copyright (C) 2011 Henning Thielemann- Copyright (C) 2007 Soenke Hahn-- This program is free software; you can redistribute it and/or modify- it under the terms of the GNU General Public License as published by- the Free Software Foundation; either version 2 of the License, or- (at your option) any later version.-- This program is distributed in the hope that it will be useful,- but WITHOUT ANY WARRANTY; without even the implied warranty of- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the- GNU General Public License for more details.-- You should have received a copy of the GNU General Public License along- with this program; if not, write to the Free Software Foundation, Inc.,- 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.--}--module Sound.JACK.FFI where--import Foreign.Ptr (Ptr, FunPtr)-import Foreign.C.String (CString)-import qualified Foreign.C.Error as E-import qualified Foreign.C.Types as C--import qualified Data.EnumSet as ES-import Data.Word (Word, )-import Data.Ix (Ix(range, inRange, rangeSize, index))-import Data.Monoid (Monoid, mempty, mappend, )---data Client = Client-data Port typ = Port--foreign import ccall "static jack/jack.h jack_client_open"- 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"- client_new :: CString -> IO (Ptr Client)--foreign import ccall "static jack/jack.h jack_get_sample_rate"- get_sample_rate :: Ptr Client -> IO C.CInt---type OpenOptionSet = ES.T C.CULong OpenOptions--data OpenOptions =- NoStartServer- | UseExactName- | ServerName- deriving (Enum, Eq, Ord, Show, Ix)--wordNullOption, wordNoStartServer, wordUseExactName, wordServerName :: OpenOptionSet-wordNullOption = ES.empty-wordNoStartServer = ES.fromEnum NoStartServer-wordUseExactName = ES.fromEnum UseExactName-wordServerName = ES.fromEnum ServerName---type StatusSet = ES.T C.CULong Status--data Status =- Failure- | InvalidOption- | NameNotUnique- | ServerStarted- | ServerFailed- | ServerError- | NoSuchClient- | LoadFailure- | InitFailure- | ShmFailure- | VersionError- deriving (Enum, Eq, Ord, Show, Ix)--wordFailure, wordInvalidOption, wordNameNotUnique, wordServerStarted,- wordServerFailed, wordServerError, wordNoSuchClient, wordLoadFailure,- wordInitFailure, wordShmFailure, wordVersionError :: StatusSet-wordFailure = ES.fromEnum Failure-wordInvalidOption = ES.fromEnum InvalidOption-wordNameNotUnique = ES.fromEnum NameNotUnique-wordServerStarted = ES.fromEnum ServerStarted-wordServerFailed = ES.fromEnum ServerFailed-wordServerError = ES.fromEnum ServerError-wordNoSuchClient = ES.fromEnum NoSuchClient-wordLoadFailure = ES.fromEnum LoadFailure-wordInitFailure = ES.fromEnum InitFailure-wordShmFailure = ES.fromEnum ShmFailure-wordVersionError = ES.fromEnum VersionError---type PortFlagSet = ES.T C.CULong PortFlag--data PortFlag =- PortIsInput- | PortIsOutput- | PortIsPhysical- | PortCanMonitor- | PortIsTerminal- deriving (Enum, Eq, Ord, Show, Ix)---newtype PortName = PortName {deconsPortName :: CString}--portIsInput, portIsOutput :: PortFlagSet-portIsInput = ES.fromEnum PortIsInput-portIsOutput = ES.fromEnum PortIsOutput---foreign import ccall "static jack/jack.h jack_port_register"- port_register :: Ptr Client -> PortName -> CString ->- PortFlagSet -> C.CULong -> IO (Ptr (Port a))----- | represents absolute frame time-newtype NFrames = NFrames C.CUInt- deriving (Show, Eq, Ord)--nframesToWord :: NFrames -> Word-nframesToWord (NFrames n) = fromIntegral n--instance Ix NFrames where- range (a,b) =- map (NFrames . fromIntegral) $- range (nframesToWord a, nframesToWord b)- index (a,b) i =- index (nframesToWord a, nframesToWord b) (nframesToWord i)- inRange (a,b) i =- inRange (nframesToWord a, nframesToWord b) (nframesToWord i)- rangeSize (a,b) =- rangeSize (nframesToWord a, nframesToWord b)--instance Monoid NFrames where- mempty = NFrames 0- mappend (NFrames x) (NFrames y) = NFrames (x+y)---nframesIndices :: NFrames -> [NFrames]-nframesIndices (NFrames n) =- take (fromIntegral n) $ map NFrames $ iterate (1+) 0--nframesBounds :: NFrames -> (NFrames,NFrames)-nframesBounds (NFrames n) =- (NFrames 0, NFrames $ n - 1)---data CallbackArg = CallbackArg---type Process = NFrames -> Ptr CallbackArg -> IO E.Errno--foreign import ccall "static jack/jack.h jack_set_process_callback"- set_process_callback ::- Ptr Client -> FunPtr Process -> Ptr CallbackArg -> IO E.Errno--foreign import ccall "static jack/jack.h jack_last_frame_time"- last_frame_time :: Ptr Client -> IO NFrames---foreign import ccall "static jack/jack.h jack_port_get_buffer"- port_get_buffer :: Ptr (Port a) -> NFrames -> IO (Ptr a)--foreign import ccall "static jack/jack.h jack_get_buffer_size"- get_buffer_size :: Ptr Client -> IO (C.CUInt)--foreign import ccall "static jack/jack.h jack_activate"- activate :: Ptr Client -> IO E.Errno--foreign import ccall "static jack/jack.h jack_client_close"- client_close :: Ptr Client -> IO E.Errno--foreign import ccall "static jack/jack.h jack_get_ports"- get_ports :: Ptr Client -> CString -> CString -> C.CULong -> IO (Ptr CString)--- get_ports :: Ptr Client -> CString -> CString -> C.CULong -> IO (Ptr PortName)---- may return eEXIST-foreign import ccall "static jack/jack.h jack_connect"- connect :: Ptr Client -> PortName -> PortName -> IO E.Errno--foreign import ccall "static jack/jack.h jack_disconnect"- disconnect :: Ptr Client -> PortName -> PortName -> IO E.Errno--foreign import ccall "static jack/jack.h jack_port_unregister"- port_unregister :: Ptr Client -> Ptr (Port a) -> IO E.Errno--foreign import ccall "static jack/jack.h jack_deactivate"- deactivate :: Ptr Client -> IO E.Errno
+ src/Sound/JACK/FFI.hsc view
@@ -0,0 +1,251 @@+-- -*-haskell-*-+{-# LANGUAGE ForeignFunctionInterface #-}++{-+ JACK bindings for Haskell+ Copyright (C) 2011 Henning Thielemann+ Copyright (C) 2007 Soenke Hahn++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License along+ with this program; if not, write to the Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.+-}++module Sound.JACK.FFI where++import Foreign.Ptr (Ptr, FunPtr)+import Foreign.C.String (CString)+import qualified Foreign.C.Error as E+import qualified Foreign.C.Types as C++import qualified Data.EnumSet as ES+import Data.Word (Word, Word32, )+import Data.Ix (Ix(range, inRange, rangeSize, index))+import Data.Monoid (Monoid, mempty, mappend, )++#include "jack/jack.h"++data Client = Client+data Port typ = Port++foreign import ccall "static jack/jack.h jack_client_open"+ 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"+ client_new :: CString -> IO (Ptr Client)++foreign import ccall "static jack/jack.h jack_get_sample_rate"+ get_sample_rate :: Ptr Client -> IO C.CInt+++type OpenOptionSet = ES.T C.CULong OpenOptions++data OpenOptions =+ NoStartServer+ | UseExactName+ | ServerName+ deriving (Enum, Eq, Ord, Show, Ix)++wordNullOption, wordNoStartServer, wordUseExactName, wordServerName :: OpenOptionSet+wordNullOption = ES.empty+wordNoStartServer = ES.fromEnum NoStartServer+wordUseExactName = ES.fromEnum UseExactName+wordServerName = ES.fromEnum ServerName+++type StatusSet = ES.T C.CULong Status++data Status =+ Failure+ | InvalidOption+ | NameNotUnique+ | ServerStarted+ | ServerFailed+ | ServerError+ | NoSuchClient+ | LoadFailure+ | InitFailure+ | ShmFailure+ | VersionError+ deriving (Enum, Eq, Ord, Show, Ix)++wordFailure, wordInvalidOption, wordNameNotUnique, wordServerStarted,+ wordServerFailed, wordServerError, wordNoSuchClient, wordLoadFailure,+ wordInitFailure, wordShmFailure, wordVersionError :: StatusSet+wordFailure = ES.fromEnum Failure+wordInvalidOption = ES.fromEnum InvalidOption+wordNameNotUnique = ES.fromEnum NameNotUnique+wordServerStarted = ES.fromEnum ServerStarted+wordServerFailed = ES.fromEnum ServerFailed+wordServerError = ES.fromEnum ServerError+wordNoSuchClient = ES.fromEnum NoSuchClient+wordLoadFailure = ES.fromEnum LoadFailure+wordInitFailure = ES.fromEnum InitFailure+wordShmFailure = ES.fromEnum ShmFailure+wordVersionError = ES.fromEnum VersionError+++type PortFlagSet = ES.T C.CULong PortFlag++data PortFlag =+ PortIsInput+ | PortIsOutput+ | PortIsPhysical+ | PortCanMonitor+ | PortIsTerminal+ deriving (Enum, Eq, Ord, Show, Ix)+++newtype PortName = PortName {deconsPortName :: CString}++portIsInput, portIsOutput :: PortFlagSet+portIsInput = ES.fromEnum PortIsInput+portIsOutput = ES.fromEnum PortIsOutput+++foreign import ccall "static jack/jack.h jack_port_register"+ port_register :: Ptr Client -> PortName -> CString ->+ PortFlagSet -> C.CULong -> IO (Ptr (Port a))+++-- | represents absolute frame time+newtype NFrames = NFrames C.CUInt+ deriving (Show, Eq, Ord)++nframesToWord :: NFrames -> Word+nframesToWord (NFrames n) = fromIntegral n++instance Ix NFrames where+ range (a,b) =+ map (NFrames . fromIntegral) $+ range (nframesToWord a, nframesToWord b)+ index (a,b) i =+ index (nframesToWord a, nframesToWord b) (nframesToWord i)+ inRange (a,b) i =+ inRange (nframesToWord a, nframesToWord b) (nframesToWord i)+ rangeSize (a,b) =+ rangeSize (nframesToWord a, nframesToWord b)++instance Monoid NFrames where+ mempty = NFrames 0+ mappend (NFrames x) (NFrames y) = NFrames (x+y)+++nframesIndices :: NFrames -> [NFrames]+nframesIndices (NFrames n) =+ take (fromIntegral n) $ map NFrames $ iterate (1+) 0++nframesBounds :: NFrames -> (NFrames,NFrames)+nframesBounds (NFrames n) =+ (NFrames 0, NFrames $ n - 1)+++data CallbackArg = CallbackArg+++type Process = NFrames -> Ptr CallbackArg -> IO E.Errno++foreign import ccall "static jack/jack.h jack_set_process_callback"+ set_process_callback ::+ Ptr Client -> FunPtr Process -> Ptr CallbackArg -> IO E.Errno++type ClientRegistration = CString -> C.CInt -> Ptr CallbackArg -> IO ()++foreign import ccall "static jack/jack.h jack_set_client_registration_callback"+ set_client_registration_callback ::+ Ptr Client -> FunPtr ClientRegistration -> Ptr CallbackArg -> IO E.Errno++newtype PortId = PortId #{type jack_port_id_t} deriving (Eq, Ord, Show)++{- |+Type argument for Jack ports where the type of samples transported by the port+is unknown.+-}+data UnknownType = UnknownType++type PortRegistration = PortId -> C.CInt -> Ptr CallbackArg -> IO ()++foreign import ccall "static jack/jack.h jack_set_port_registration_callback"+ set_port_registration_callback ::+ Ptr Client -> FunPtr PortRegistration -> Ptr CallbackArg -> IO E.Errno++type PortConnect = PortId -> PortId -> C.CInt -> Ptr CallbackArg -> IO ()++foreign import ccall "static jack/jack.h jack_set_port_connect_callback"+ set_port_connect_callback ::+ Ptr Client -> FunPtr PortConnect -> Ptr CallbackArg -> IO E.Errno+++foreign import ccall "static jack/jack.h jack_port_by_id"+ port_by_id ::+ Ptr Client -> PortId -> IO (Ptr (Port UnknownType))++foreign import ccall "static jack/jack.h jack_port_by_name"+ port_by_name ::+ Ptr Client -> PortName -> IO (Ptr (Port UnknownType))++foreign import ccall "static jack/jack.h jack_port_name"+ port_name ::+ Ptr (Port typ) -> IO CString++foreign import ccall "static jack/jack.h jack_port_short_name"+ port_short_name ::+ Ptr (Port typ) -> IO CString++foreign import ccall "static jack/jack.h jack_port_flags"+ port_flags ::+ Ptr (Port typ) -> IO PortFlagSet++foreign import ccall "static jack/jack.h jack_port_type"+ port_type ::+ Ptr (Port UnknownType) -> IO PortName++foreign import ccall "static jack/jack.h jack_get_ports"+ get_ports :: Ptr Client -> CString -> CString -> C.CULong -> IO (Ptr CString)+-- get_ports :: Ptr Client -> CString -> CString -> C.CULong -> IO (Ptr PortName)++foreign import ccall "static jack/jack.h jack_port_get_all_connections"+ port_get_all_connections ::+ Ptr Client -> Ptr (Port typ) -> IO (Ptr CString)+++foreign import ccall "static jack/jack.h jack_last_frame_time"+ last_frame_time :: Ptr Client -> IO NFrames++foreign import ccall "static jack/jack.h jack_port_get_buffer"+ port_get_buffer :: Ptr (Port a) -> NFrames -> IO (Ptr a)++foreign import ccall "static jack/jack.h jack_get_buffer_size"+ get_buffer_size :: Ptr Client -> IO (C.CUInt)++foreign import ccall "static jack/jack.h jack_activate"+ activate :: Ptr Client -> IO E.Errno++foreign import ccall "static jack/jack.h jack_client_close"+ client_close :: Ptr Client -> IO E.Errno++-- may return eEXIST+foreign import ccall "static jack/jack.h jack_connect"+ connect :: Ptr Client -> PortName -> PortName -> IO E.Errno++foreign import ccall "static jack/jack.h jack_disconnect"+ disconnect :: Ptr Client -> PortName -> PortName -> IO E.Errno++foreign import ccall "static jack/jack.h jack_port_unregister"+ port_unregister :: Ptr Client -> Ptr (Port a) -> IO E.Errno++foreign import ccall "static jack/jack.h jack_deactivate"+ deactivate :: Ptr Client -> IO E.Errno++
− src/Sound/JACK/FFI/MIDI.chs
@@ -1,148 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}--#include "jack/midiport.h"--module Sound.JACK.FFI.MIDI- (- EventBuffer(EventBuffer),-- RawEvent(RawEvent),- time,- buffer,-- toRawEventFunction,-- get_event_count,- event_get,- clear_buffer,- event_reserve,- event_write,-- -- internal- withByteStringPtr,- )--where--import Sound.JACK.FFI (NFrames(NFrames), )--import Foreign.Marshal.Array (copyArray, advancePtr, )-import Foreign.ForeignPtr (withForeignPtr, )-import Foreign.Ptr (Ptr, castPtr, )-import Foreign.Storable (Storable, peekByteOff, pokeByteOff, sizeOf, alignment, peek, poke)-import qualified Foreign.C.Error as E-import qualified Foreign.C.Types as C-import Foreign.C.Types (CUInt, CUChar, )-import Data.Word (Word8, )--import qualified Data.ByteString as B-import qualified Data.ByteString.Internal as BI-import qualified Data.ByteString.Lazy as BL-import qualified Sound.MIDI.Message as Msg-import qualified Sound.MIDI.Parser.Report as Report--import System.IO (hPutStrLn, stderr, )----- could also be an empty data declaration-data EventBuffer = EventBuffer---- | Represents a raw JACK MIDI event-data RawEvent = RawEvent {- time :: NFrames -- ^ Sample index at which event is valid (relative to cycle start)- , buffer :: B.ByteString -- ^ Raw MIDI data-} deriving (Eq, Ord)---- | Converts high level MIDI Event transformation functions into raw MIDI Event transformation functions-toRawEventFunction ::- (NFrames -> (NFrames, Msg.T) -> IO (NFrames, Msg.T))- -- ^ transforms Sound.MIDI.File.Event- ->- (NFrames -> RawEvent -> IO RawEvent)- -- ^ transforms Sound.JACK.MIDI.RawEvent-toRawEventFunction fun cycleStart rawEvent =- case Msg.maybeFromByteString $ BL.fromChunks [buffer rawEvent] of- Report.Cons warnings result -> do- mapM_ (hPutStrLn stderr) warnings- case result of- Left _ -> do- putStrLn $ "Warning: Did not understand Event: " ++ show rawEvent- return rawEvent- Right e -> do- (time_, event_) <- fun cycleStart (time rawEvent, e)- return $ RawEvent time_ $ B.concat $- BL.toChunks $ Msg.toByteString event_--instance Storable RawEvent where- sizeOf _ = {# sizeof jack_midi_event_t #}-- alignment _ = alignment (undefined :: C.CUInt)-- peek pointer = do- time_ <- {# get jack_midi_event_t-> time #} pointer- size_ <- {# get jack_midi_event_t-> size #} pointer-- bufferPtr <- {# get jack_midi_event_t-> buffer #} pointer- let sizeInt = fromIntegral size_- buffer_ <-- BI.create sizeInt $ \dest ->- copyArray dest (castPtr bufferPtr) sizeInt-- return $ RawEvent (NFrames time_) buffer_-- {- |- This implementation expects that port buffer pointer is already initialized.- This is dangerous, but currently we do not know, how to do it better.- -}- poke pointer (RawEvent (NFrames time_) buffer_) = do- {# set jack_midi_event_t-> time #} pointer time_- {# set jack_midi_event_t-> size #} pointer (fromIntegral $ B.length buffer_)-- bufferPtr <- {# get jack_midi_event_t-> buffer #} pointer- withByteStringPtr buffer_ $ \ptr len ->- copyArray (castPtr bufferPtr) ptr len-- {# set jack_midi_event_t-> buffer #} pointer bufferPtr--withByteStringPtr :: B.ByteString -> (Ptr Word8 -> Int -> IO a) -> IO a-withByteStringPtr bstr act =- case BI.toForeignPtr bstr of- (fptr, start, len) ->- withForeignPtr fptr $ \ptr ->- act (advancePtr ptr start) len---instance Show RawEvent where- show rawEvent =- "MIDIEvent @ " ++ show (time rawEvent) ++- "\t: " ++ showEvent (buffer rawEvent)--showEvent :: B.ByteString -> String-showEvent buffer_ =- case Msg.maybeFromByteString $ BL.fromChunks [buffer_] of- Report.Cons warnings result ->- unlines warnings ++- case result of- Left errMsg -> "Warning: " ++ errMsg- Right e ->- case e of- Msg.Channel b -> "MidiMsg.Channel " ++ show b- Msg.System _ -> "MidiMsg.System ..."----foreign import ccall "static jack/midiport.h jack_midi_get_event_count"- get_event_count :: Ptr EventBuffer -> IO NFrames--foreign import ccall "static jack/midiport.h jack_midi_event_get"- event_get :: Ptr RawEvent -> Ptr EventBuffer -> NFrames -> IO E.Errno--foreign import ccall "static jack/midiport.h jack_midi_clear_buffer"- clear_buffer :: Ptr EventBuffer -> IO ()---- nullPtr may be mapped to eNOBUFS exception as in event_write-foreign import ccall "static jack/midiport.h jack_midi_event_reserve"- event_reserve :: Ptr EventBuffer -> NFrames -> C.CSize -> IO (Ptr Word8)--foreign import ccall "static jack/midiport.h jack_midi_event_write"- event_write :: Ptr EventBuffer -> NFrames -> Ptr Word8 -> C.CULong -> IO E.Errno
+ src/Sound/JACK/FFI/MIDI.hsc view
@@ -0,0 +1,150 @@+{-# LANGUAGE ForeignFunctionInterface #-}++#include "jack/midiport.h"++module Sound.JACK.FFI.MIDI+ (+ EventBuffer(EventBuffer),++ RawEvent(RawEvent),+ time,+ buffer,++ toRawEventFunction,++ get_event_count,+ event_get,+ clear_buffer,+ event_reserve,+ event_write,++ -- internal+ withByteStringPtr,+ )++where++import Sound.JACK.FFI (NFrames(NFrames), )++import Foreign.Marshal.Array (copyArray, advancePtr, )+import Foreign.ForeignPtr (withForeignPtr, )+import Foreign.Ptr (Ptr, castPtr, )+import Foreign.Storable (Storable, peekByteOff, pokeByteOff, sizeOf, alignment, peek, poke)+import qualified Foreign.C.Error as E+import qualified Foreign.C.Types as C+import Data.Word (Word8, )++import qualified Data.ByteString as B+import qualified Data.ByteString.Internal as BI+import qualified Data.ByteString.Lazy as BL+import qualified Sound.MIDI.Message as Msg+import qualified Sound.MIDI.Parser.Report as Report++import System.IO (hPutStrLn, stderr, )++-- cf. FFI cookbook+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)++-- could also be an empty data declaration+data EventBuffer = EventBuffer++-- | Represents a raw JACK MIDI event+data RawEvent = RawEvent {+ time :: NFrames -- ^ Sample index at which event is valid (relative to cycle start)+ , buffer :: B.ByteString -- ^ Raw MIDI data+} deriving (Eq, Ord)++-- | Converts high level MIDI Event transformation functions into raw MIDI Event transformation functions+toRawEventFunction ::+ (NFrames -> (NFrames, Msg.T) -> IO (NFrames, Msg.T))+ -- ^ transforms Sound.MIDI.File.Event+ ->+ (NFrames -> RawEvent -> IO RawEvent)+ -- ^ transforms Sound.JACK.MIDI.RawEvent+toRawEventFunction fun cycleStart rawEvent =+ case Msg.maybeFromByteString $ BL.fromChunks [buffer rawEvent] of+ Report.Cons warnings result -> do+ mapM_ (hPutStrLn stderr) warnings+ case result of+ Left _ -> do+ putStrLn $ "Warning: Did not understand Event: " ++ show rawEvent+ return rawEvent+ Right e -> do+ (time_, event_) <- fun cycleStart (time rawEvent, e)+ return $ RawEvent time_ $ B.concat $+ BL.toChunks $ Msg.toByteString event_++instance Storable RawEvent where+ sizeOf _ = #{size jack_midi_event_t}++ alignment _ = #{alignment jack_midi_event_t}++ peek pointer = do+ time_ <- #{peek jack_midi_event_t, time} pointer+ size_ <- #{peek jack_midi_event_t, size} pointer++ bufferPtr <- #{peek jack_midi_event_t, buffer} pointer+ let sizeInt = fromIntegral (size_ :: C.CSize)+ buffer_ <-+ BI.create sizeInt $ \dest ->+ copyArray dest (castPtr bufferPtr) sizeInt++ return $ RawEvent (NFrames time_) buffer_++ {- |+ This implementation expects that port buffer pointer is already initialized.+ This is dangerous, but currently we do not know, how to do it better.+ -}+ poke pointer (RawEvent (NFrames time_) buffer_) = do+ #{poke jack_midi_event_t, time} pointer time_+ #{poke jack_midi_event_t, size} pointer+ (fromIntegral $ B.length buffer_ :: C.CSize)++ bufferPtr <- #{peek jack_midi_event_t, buffer} pointer+ withByteStringPtr buffer_ $ \ptr len ->+ copyArray (castPtr bufferPtr) ptr len++ #{poke jack_midi_event_t, buffer} pointer bufferPtr++withByteStringPtr :: B.ByteString -> (Ptr Word8 -> Int -> IO a) -> IO a+withByteStringPtr bstr act =+ case BI.toForeignPtr bstr of+ (fptr, start, len) ->+ withForeignPtr fptr $ \ptr ->+ act (advancePtr ptr start) len+++instance Show RawEvent where+ show rawEvent =+ "MIDIEvent @ " ++ show (time rawEvent) +++ "\t: " ++ showEvent (buffer rawEvent)++showEvent :: B.ByteString -> String+showEvent buffer_ =+ case Msg.maybeFromByteString $ BL.fromChunks [buffer_] of+ Report.Cons warnings result ->+ unlines warnings +++ case result of+ Left errMsg -> "Warning: " ++ errMsg+ Right e ->+ case e of+ Msg.Channel b -> "MidiMsg.Channel " ++ show b+ Msg.System _ -> "MidiMsg.System ..."++++foreign import ccall "static jack/midiport.h jack_midi_get_event_count"+ get_event_count :: Ptr EventBuffer -> IO NFrames++foreign import ccall "static jack/midiport.h jack_midi_event_get"+ event_get :: Ptr RawEvent -> Ptr EventBuffer -> NFrames -> IO E.Errno++foreign import ccall "static jack/midiport.h jack_midi_clear_buffer"+ clear_buffer :: Ptr EventBuffer -> IO ()++-- nullPtr may be mapped to eNOBUFS exception as in event_write+foreign import ccall "static jack/midiport.h jack_midi_event_reserve"+ event_reserve :: Ptr EventBuffer -> NFrames -> C.CSize -> IO (Ptr Word8)++foreign import ccall "static jack/midiport.h jack_midi_event_write"+ event_write :: Ptr EventBuffer -> NFrames -> Ptr Word8 -> C.CULong -> IO E.Errno
src/Sound/JACK/Private.hs view
@@ -63,10 +63,10 @@ like explicit-exception:SIO. -} bracket ::- Sync.ExceptionalT e IO a ->- (a -> Sync.ExceptionalT e IO ()) ->- (a -> Sync.ExceptionalT e IO b) ->- Sync.ExceptionalT e IO b+ Sync.ExceptionalT e IO handle ->+ (handle -> Sync.ExceptionalT e IO ()) ->+ (handle -> Sync.ExceptionalT e IO a) ->+ Sync.ExceptionalT e IO a bracket open close act = Sync.ExceptionalT $ Exc.bracket@@ -85,6 +85,14 @@ case r of Sync.Success a -> Sync.runExceptionalT $ act a Sync.Exception e -> return $ Sync.Exception e)++bracket_ ::+ Sync.ExceptionalT e IO () ->+ Sync.ExceptionalT e IO () ->+ Sync.ExceptionalT e IO a ->+ Sync.ExceptionalT e IO a+bracket_ open close act =+ bracket open (\() -> close) (\() -> act) liftErrno ::