diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,7 @@ +0.7.1: + +* JACK.quit, waitForBreakAndClose: + Deprecated and replaced Signal handler by getLine loop. + + These functions are simple utility functions that are not related to JACK + and the Signal handler depends on the 'unix' package. diff --git a/README b/README deleted file mode 100644 --- a/README +++ /dev/null @@ -1,25 +0,0 @@ -Jack - Bindings to the JACK Audio Connection Kit for Haskell - -http://open-projects.net/~shahn/index.php?seite=code - -It's far from being finished... - - - -INSTALLATION: - - runhaskell Setup configure - runhaskell Setup build - runhaskell Setup haddock # if you want - sudo runhaskell Setup install - - -You need JACK for this to work... -( http://jackaudio.org/ ) - -You should compile your clients with 'ghc --make -O2 -threaded ...' - -The software is licensed under GPL 2, see LICENSE. - -Any comments appreciated: shahn@cs.tu-berlin.de - diff --git a/examples/Capture.hs b/examples/Capture.hs --- a/examples/Capture.hs +++ b/examples/Capture.hs @@ -12,6 +12,8 @@ -} module Main where +import Common (mainWait) + import qualified Sound.JACK as Jack import qualified Sound.JACK.Audio as JA @@ -53,9 +55,7 @@ client <- MC.ContT $ Jack.withClientDefault name inputs <- mapM (MC.ContT . Jack.withPort client) portNames Trans.lift $ setProcess st client inputs - Trans.lift $ Jack.withActivation client $ Trans.lift $ do - putStrLn $ "started " ++ name ++ "..." - Jack.waitForBreak + Trans.lift $ mainWait client name setProcess :: (JackExc.ThrowsErrno e) => diff --git a/examples/Common.hs b/examples/Common.hs new file mode 100644 --- /dev/null +++ b/examples/Common.hs @@ -0,0 +1,16 @@ +module Common where + +import qualified Sound.JACK as Jack +import qualified Sound.JACK.Exception as JackExc + +import qualified Control.Monad.Trans.Class as Trans +import qualified Control.Monad.Exception.Synchronous as Sync + + +mainWait :: + JackExc.ThrowsErrno e => + Jack.Client -> String -> Sync.ExceptionalT e IO () +mainWait client name = + Jack.withActivation client $ Trans.lift $ do + putStrLn $ "started " ++ name ++ "..." + Jack.waitForBreak diff --git a/examples/ImpulseTrain.hs b/examples/ImpulseTrain.hs --- a/examples/ImpulseTrain.hs +++ b/examples/ImpulseTrain.hs @@ -1,5 +1,7 @@ module Main where +import Common (mainWait) + import qualified Sound.JACK.Audio as Audio import qualified Sound.JACK as JACK @@ -19,9 +21,7 @@ JACK.withClientDefault name $ \client -> JACK.withPort client "output" $ \output -> JACK.withProcess client (process output) $ - JACK.withActivation client $ Trans.lift $ do - putStrLn $ "started " ++ name ++ "..." - JACK.waitForBreak + mainWait client name process :: Audio.Port JACK.Output -> JACK.NFrames -> Sync.ExceptionalT E.Errno IO () diff --git a/examples/Melody.hs b/examples/Melody.hs new file mode 100644 --- /dev/null +++ b/examples/Melody.hs @@ -0,0 +1,66 @@ +module Main where + +import Common (mainWait) + +import qualified Sound.JACK.MIDI as JackMidi +import qualified Sound.JACK as Jack +import qualified Sound.MIDI.Message as MIDI +import qualified Sound.MIDI.Message.Channel as Channel +import qualified Sound.MIDI.Message.Channel.Voice as Voice +import qualified Sound.MIDI.Message.Class.Construct as MidiCons + +import qualified Control.Monad.Exception.Synchronous as Sync +import qualified Control.Monad.Trans.Class as Trans + +import qualified Data.EventList.Absolute.TimeBody as AbsEventList +import qualified Data.EventList.Relative.TimeBody as EventList +import qualified Data.EventList.Relative.TimeMixed as EventListTM +import qualified Numeric.NonNegative.Wrapper as NonNegW +import Data.IORef (IORef, newIORef, readIORef, writeIORef, ) + +import qualified Foreign.C.Error as E + +import System.Environment (getProgName) + + +scale :: [Channel.Pitch] +scale = map Channel.toPitch [60, 62, 64, 65, 67, 69, 71, 72] + +eventLoop :: EventList.T NonNegW.Double MIDI.T +eventLoop = + EventList.fromPairList $ + concatMap + (\p -> + let note on = + MidiCons.note (Channel.toChannel 0) + (Voice.normalVelocity, p, on) + in [(0, note True), (0.1, note False)]) + scale + +main :: IO () +main = do + name <- getProgName + Jack.handleExceptions $ + Jack.withClientDefault name $ \client -> + Jack.withPort client "output" $ \output -> do + rate <- fmap fromIntegral $ Trans.lift $ Jack.getSampleRate client + stateRef <- + Trans.lift $ + newIORef (EventList.resample rate $ EventList.cycle eventLoop) + Jack.withProcess client (process stateRef output) $ + mainWait client name + +process :: + IORef (EventList.T NonNegW.Int MIDI.T) -> + JackMidi.Port Jack.Output -> + Jack.NFrames -> + Sync.ExceptionalT E.Errno IO () +process stateRef output nframes@(Jack.NFrames nframesInt) = do + events <- Trans.lift $ readIORef stateRef + let (currentEvents, futureEvents) = + EventListTM.splitAtTime (fromIntegral nframesInt) events + Trans.lift $ writeIORef stateRef futureEvents + JackMidi.writeEventsToPort output nframes $ + AbsEventList.mapTime (Jack.NFrames . NonNegW.toNumber . fromIntegral) $ + EventList.toAbsoluteEventList 0 $ + fst $ EventListTM.viewTimeR currentEvents diff --git a/examples/Synthesizer.hs b/examples/Synthesizer.hs --- a/examples/Synthesizer.hs +++ b/examples/Synthesizer.hs @@ -1,5 +1,7 @@ module Main where +import Common (mainWait) + import qualified Synthesizer.Render as Render import qualified Sound.MIDI.Message as Msg @@ -34,9 +36,7 @@ JACK.withPort client "input" $ \input -> JACK.withPort client "output" $ \output -> JACK.withProcess client (process client stateRef input output) $ - JACK.withActivation client $ Trans.lift $ do - putStrLn $ "started " ++ name ++ "..." - JACK.waitForBreak + mainWait client name checkVoiceMsg :: Msg.T -> Maybe VoiceMsg.T checkVoiceMsg ev = diff --git a/jack.cabal b/jack.cabal --- a/jack.cabal +++ b/jack.cabal @@ -1,16 +1,18 @@ Name: jack -Version: 0.7.0.3 +Version: 0.7.1 License: GPL License-File: LICENSE Author: Henning Thielemann, Stefan Kersten, Soenke Hahn Maintainer: Henning Thielemann Synopsis: Bindings for the JACK Audio Connection Kit Description: - Bindings for the JACK Audio Connection Kit. + 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. + . + You should compile your clients with @ghc --make -O2 -threaded ...@ Homepage: http://www.haskell.org/haskellwiki/JACK Category: Sound Build-Type: Simple @@ -18,7 +20,7 @@ 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, GHC==7.6.1 Extra-Source-Files: - README + CHANGELOG INSTALL free/Sound/JACK/FFIFree.hs jackfree/Sound/JACK/FFIFree.hs @@ -30,7 +32,7 @@ Source-Repository this type: darcs location: http://code.haskell.org/jack/ - tag: 0.7.0.3 + tag: 0.7.1 Flag pkgConfig description: Use pkg-config tool for check version and presence of jack @@ -51,10 +53,9 @@ non-negative >=0.1 && <0.2, bytestring >=0.9.1.4 && <0.11, explicit-exception >=0.1.7 && <0.2, - transformers >=0.2 && <0.5, + transformers >=0.2 && <0.6, enumset >=0.0 && <0.1, array >=0.4 && <0.6, - unix >=2.3 && <2.8, base >=4.0 && <5.0 Exposed-Modules: Sound.JACK @@ -96,7 +97,7 @@ -- http://hackage.haskell.org/trac/hackage/ticket/170 Extra-Libraries: jack -Executable amplify +Executable jack-amplify If flag(buildExamples) Build-Depends: jack, @@ -108,7 +109,7 @@ Hs-Source-Dirs: examples Main-Is: Amplify.hs -Executable capture +Executable jack-capture If flag(buildExamples) Build-Depends: jack, @@ -122,8 +123,9 @@ GHC-Options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates Hs-Source-Dirs: examples Main-Is: Capture.hs + Other-Modules: Common -Executable impulse-train +Executable jack-impulse-train If flag(buildExamples) Build-Depends: jack, @@ -137,8 +139,9 @@ GHC-Options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates Hs-Source-Dirs: examples Main-Is: ImpulseTrain.hs + Other-Modules: Common -Executable midimon +Executable jack-midimon If flag(buildExamples) Build-Depends: jack, @@ -151,14 +154,32 @@ Hs-Source-Dirs: examples Main-Is: Midimon.hs -Executable synth +Executable jack-melody If flag(buildExamples) Build-Depends: jack, midi >=0.1.5.2 && <0.3, event-list >=0.1 && <0.2, + non-negative >=0.1 && <0.2, explicit-exception >=0.1.7 && <0.2, transformers, + 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: Melody.hs + Other-Modules: Common + +Executable jack-synth + If flag(buildExamples) + Build-Depends: + jack, + midi >=0.1.5.2 && <0.3, + event-list >=0.1 && <0.2, + explicit-exception >=0.1.7 && <0.2, + transformers, containers >=0.2 && <0.6, bytestring >=0.9.1 && <0.11, storablevector >=0.2.7 && <0.3, @@ -172,3 +193,4 @@ Main-Is: Synthesizer.hs Other-Modules: Synthesizer.Render + Common diff --git a/src/Sound/JACK.hs b/src/Sound/JACK.hs --- a/src/Sound/JACK.hs +++ b/src/Sound/JACK.hs @@ -25,8 +25,8 @@ use the JACK Audio Connection Kit. -} -module Sound.JACK - ( -- * general stuff +module Sound.JACK ( + -- * general stuff Client, newClient, newClientDefault, @@ -54,10 +54,12 @@ Process, connect, + disconnect, makeProcess, setProcess, withProcess, + getBufferSize, getSampleRate, lastFrameTime, @@ -78,6 +80,7 @@ portName, portShortName, + portAliases, getPorts, portGetAllConnections, @@ -95,27 +98,31 @@ -- * Exceptions handleExceptions, -) - where + ) where + import Sound.JACK.Private + (Port(Port), PortType, PortTypeString, portTypeString, Client(Client), + bracket, bracket_, liftErrno, withCString, alloca, ) 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, Input(Input), Output(Output), nframesIndices, nframesBounds, ) +import Sound.JACK.FFI (Process, Input, Output, 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 qualified Foreign.Marshal.Array as Array import qualified Foreign.C.String as CString import qualified Foreign.C.Types as C import Foreign.Storable (peek, ) -import Foreign.Ptr (Ptr, FunPtr, nullPtr, castPtr, freeHaskellFunPtr, nullFunPtr, ) +import Foreign.Ptr + (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 @@ -123,20 +130,23 @@ import Control.Concurrent (MVar, putMVar, newEmptyMVar, takeMVar, threadDelay) import qualified System.IO as IO -import System.Posix.Signals (installHandler, keyboardSignal, Handler(Catch)) import Data.Monoid (Monoid, mempty, mappend, ) class Direction dir where - dirToFlags :: dir -> JackFFI.PortFlagSet + switchDir :: f Input -> f Output -> f dir -instance Direction Input where - dirToFlags ~Input = JackFFI.portIsInput +instance Direction Input where switchDir f _ = f +instance Direction Output where switchDir _ f = f -instance Direction Output where - dirToFlags ~Output = JackFFI.portIsOutput +type DirFlagSet = Const JackFFI.PortFlagSet + +dirFlags :: Direction dir => Const JackFFI.PortFlagSet dir +dirFlags = switchDir (Const JackFFI.portIsInput) (Const JackFFI.portIsOutput) + + {- | Type argument for Jack ports where we do not know @@ -219,22 +229,18 @@ newPortByType :: (PortType typ, Direction dir, JackExc.ThrowsPortRegister e) => - JackFFI.PortFlagSet -> Client -> String -> + PortTypeString typ -> DirFlagSet dir -> Client -> String -> Sync.ExceptionalT e IO (Port typ dir) -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 name $ \cPortName -> - withCString (portTypeToCString portType) $ \pType -> do - -- putStrLn ("register..." ++ show (client, cstring, pType, inout, 0)) - port <- Trans.lift $ - JackFFI.port_register client cPortName pType (dirToFlags dir ES..|. flags) 0 - Sync.assertT JackExc.portRegister (port/=nullPtr) - return $ Port port - in aux undefined undefined +newPortByType (Const portTyp) (Const dir) (Client client) name = + withPortName name $ \cPortName -> + withCString portTyp $ \pType -> do +-- putStrLn ("register..." ++ show (client, cstring, pType, inout, 0)) + port <- + Trans.lift $ + JackFFI.port_register client cPortName + (JackFFI.PortType pType) dir 0 + Sync.assertT JackExc.portRegister (port/=nullPtr) + return $ Port port {- | Better use 'withPort' that also handles freeing the port. @@ -245,8 +251,7 @@ Client -- ^ Jack client -> String -- ^ name of the input port -> Sync.ExceptionalT e IO (Port typ dir) -newPort client name = - newPortByType ES.empty client name +newPort = newPortByType portTypeString dirFlags disposePort :: @@ -358,6 +363,16 @@ liftErrno $ JackFFI.connect (getClient client) outCString inCString +disconnect :: + (JackExc.ThrowsErrno e) => + Client -> String -> String -> + Sync.ExceptionalT e IO () +disconnect client outport inport = + withPortName outport $ \ outCString -> + withPortName inport $ \ inCString -> + liftErrno $ JackFFI.disconnect (getClient client) outCString inCString + + {- | A collection of mixed types of ports. It is mainly needed for freeing all allocated ports. @@ -382,6 +397,7 @@ +{-# DEPRECATED quit "Write your own function instead." #-} quit :: MVar () -> Client -> PortSet -> IO () quit mvar client ports = do @@ -394,25 +410,18 @@ threadDelay 1000000 putMVar mvar () +{-# DEPRECATED waitForBreakAndClose "Write your own function instead." #-} waitForBreakAndClose :: Client -> PortSet -> IO () waitForBreakAndClose client ports = do mvar <- newEmptyMVar - _ <- installHandler keyboardSignal - (Catch $ quit mvar client ports) - Nothing + Exc.finally waitForBreak (quit mvar client ports) takeMVar mvar waitForBreak :: IO () -waitForBreak = do - mvar <- newEmptyMVar - _ <- installHandler keyboardSignal - (Catch $ do - putStrLn "quitting..." - threadDelay 1000000 - putMVar mvar ()) - Nothing - takeMVar mvar +waitForBreak = + let go = getLine >> go + in go handleExceptions :: @@ -451,6 +460,16 @@ setProcess client procPtr arg = liftErrno $ JackFFI.set_process_callback (getClient client) procPtr arg +{- | +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. +-} withProcess :: (JackExc.ThrowsErrno e) => Client -> @@ -464,7 +483,9 @@ Sync.switchT return (\() -> return eOK) $ proc nframes) setProcess - +getBufferSize :: Client -> IO Int +getBufferSize (Client ptr) = + fmap fromIntegral $ JackFFI.get_buffer_size ptr getSampleRate :: Client -> IO Int getSampleRate (Client ptr) = @@ -577,12 +598,37 @@ -- | Return the full port name, including the @client_name:@ prefix. portName :: Port typ dir -> IO String -portName (Port port) = JackFFI.port_name port >>= peekCString +portName (Port port) = + peekCString . JackFFI.deconsPortName =<< JackFFI.port_name port -- | 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 +portType :: Port JackFFI.UnknownType dir -> IO String +portType (Port port) = + peekCString . JackFFI.deconsPortType =<< JackFFI.port_type port + +castPort :: Port typ0 dir0 -> Port typ1 dir1 +castPort (Port port) = Port $ castPtr port + +{- | 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@. +-} +portAliases :: Port typ dir -> IO [String] +portAliases (Port port) = do + sz <- fmap fromIntegral JackFFI.port_name_size + Array.allocaArray sz $ \s1 -> + Array.allocaArray sz $ \s2 -> do + let ss = [s1, s2] + Array.withArray ss $ \ptr -> do + cnt <- JackFFI.port_get_aliases port ptr + if cnt <= 2 + then mapM peekCString $ take (fromIntegral cnt) ss + else error $ "port_get_aliases returned " ++ show cnt ++ " aliases" + -- | Return all the port names a given port is connected to. -- -- This function must not be called from a JACK event callback. @@ -603,37 +649,17 @@ (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 +narrowPortType port = do + typ <- Trans.lift $ portType port + liftExc $ narrowPortTypeMaybe portTypeString typ port 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 +narrowPortDirection (Port port) = do + flags <- Trans.lift $ JackFFI.port_flags port + liftExc $ narrowPortDirectionMaybe dirFlags flags (Port port) switchUnknownTypePort :: (JackExc.ThrowsPortMismatch e) => @@ -641,26 +667,12 @@ (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 +switchUnknownTypePort port audio midi = do + typ <- Trans.lift $ portType port + join $ liftExc $ + altExc + (audio <$> narrowPortTypeMaybe portTypeString typ port) + (midi <$> narrowPortTypeMaybe portTypeString typ port) switchUnknownDirectionPort :: (JackExc.ThrowsPortMismatch e) => @@ -670,18 +682,31 @@ 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 + join $ liftExc $ + altExc + (input <$> narrowPortDirectionMaybe dirFlags flags (Port port)) + (output <$> narrowPortDirectionMaybe dirFlags flags (Port port)) + +narrowPortTypeMaybe :: + (PortType typ, JackExc.ThrowsPortMismatch e) => + PortTypeString typ -> String -> Port JackFFI.UnknownType dir -> + Sync.Exceptional e (Port typ dir) +narrowPortTypeMaybe (Const portTyp) typ port = + castPort port <$ + Sync.assert (JackExc.portMismatch JackExc.TypeMismatch) (portTyp == typ) + +narrowPortDirectionMaybe :: + (Direction dir, JackExc.ThrowsPortMismatch e) => + DirFlagSet dir -> JackFFI.PortFlagSet -> Port typ UnknownDirection -> + Sync.Exceptional e (Port typ dir) +narrowPortDirectionMaybe (Const dir) flags (Port port) = + Port port <$ + Sync.assert + (JackExc.portMismatch JackExc.DirectionMismatch) + (not $ ES.disjoint flags dir) + +liftExc :: (Monad m) => Sync.Exceptional e a -> Sync.ExceptionalT e m a +liftExc = Sync.ExceptionalT . return + +altExc :: Sync.Exceptional e a -> Sync.Exceptional e a -> Sync.Exceptional e a +altExc x y = Sync.switch (const y) Sync.Success x 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 @@ -118,13 +118,15 @@ newtype PortName = PortName {deconsPortName :: CString} +newtype PortType = PortType {deconsPortType :: 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 -> + port_register :: Ptr Client -> PortName -> PortType -> PortFlagSet -> C.CULong -> IO (Ptr (Port a)) @@ -206,8 +208,16 @@ foreign import ccall "static jack/jack.h jack_port_name" port_name :: - Ptr (Port typ) -> IO CString + Ptr (Port typ) -> IO PortName +foreign import ccall "static jack/jack.h jack_port_name_size" + port_name_size :: + IO C.CInt + +foreign import ccall "static jack/jack.h jack_port_get_aliases" + port_get_aliases :: + Ptr (Port typ) -> Ptr CString -> IO C.CInt + foreign import ccall "static jack/jack.h jack_port_short_name" port_short_name :: Ptr (Port typ) -> IO CString @@ -218,7 +228,7 @@ foreign import ccall "static jack/jack.h jack_port_type" port_type :: - Ptr (Port UnknownType) -> IO PortName + Ptr (Port UnknownType) -> IO PortType foreign import ccall "static jack/jack.h jack_get_ports" get_ports :: Ptr Client -> CString -> CString -> C.CULong -> IO (Ptr CString) diff --git a/src/Sound/JACK/Private.hs b/src/Sound/JACK/Private.hs --- a/src/Sound/JACK/Private.hs +++ b/src/Sound/JACK/Private.hs @@ -6,6 +6,7 @@ import qualified Control.Monad.Exception.Synchronous as Sync import qualified Control.Exception as Exc +import Control.Applicative (Const(Const)) import qualified Foreign.Marshal.Alloc as Alloc import qualified Foreign.C.String as CString @@ -21,13 +22,16 @@ -- | Jack Port Type class PortType typ where - portTypeToCString :: typ -> String + switchPortType :: f C.CFloat -> f EventBuffer -> f typ -instance PortType C.CFloat where - portTypeToCString _ = "32 bit float mono audio" +instance PortType C.CFloat where switchPortType f _ = f +instance PortType EventBuffer where switchPortType _ f = f -instance PortType EventBuffer where - portTypeToCString _ = "8 bit raw midi" +type PortTypeString typ = Const String typ + +portTypeString :: PortType typ => PortTypeString typ +portTypeString = + switchPortType (Const "32 bit float mono audio") (Const "8 bit raw midi") newtype Port typ dir = Port (Ptr (JackFFI.Port typ))