diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,9 @@ +Copyright (c) 2009-2010 Henning Thielemann +Copyright (c) 2006 Bjorn Bringert +Copyright (c) 2006 Iavor S. Diatchki + +Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,8 @@ +#!/usr/bin/env runghc + +> module Main where + +> import Distribution.Simple + +> main :: IO () +> main = defaultMain diff --git a/alsa-seq.cabal b/alsa-seq.cabal new file mode 100644 --- /dev/null +++ b/alsa-seq.cabal @@ -0,0 +1,206 @@ +Name: alsa-seq +Version: 0.5 +Copyright: Bjorn Bringert, Iavor S. Diatchki, Henning Thielemann +Maintainer: Henning Thielemann +Author: Bjorn Bringert , Iavor S. Diatchki +Category: Sound, Music +License: BSD3 +License-file: LICENSE +Homepage: http://www.haskell.org/haskellwiki/ALSA +Stability: Experimental +Build-Type: Simple +Cabal-Version: >= 1.8 + +Synopsis: Binding to the ALSA Library API (MIDI sequencer). +Description: + This package provides access to ALSA sequencer (MIDI support). + For audio support see alsa-pcm. + +Source-Repository head + type: darcs + location: http://code.haskell.org/~thielema/alsa-seq/ + +Source-Repository this + type: darcs + location: http://code.haskell.org/~thielema/alsa-seq/ + tag: 0.5 + +Flag buildExamples + description: Build example executables + default: False + +Library + Build-depends: + alsa-core >=0.5 && <0.6, + array >= 0.1 && <0.4, + extensible-exceptions >=0.1.1 && <0.2, + base >= 3 && <5 + + GHC-Options: -Wall + Extensions: + ForeignFunctionInterface + GeneralizedNewtypeDeriving + EmptyDataDecls + + Hs-Source-Dirs: src + + Exposed-Modules: + Sound.ALSA.Sequencer + Sound.ALSA.Sequencer.Address + Sound.ALSA.Sequencer.Client + Sound.ALSA.Sequencer.Client.Info + Sound.ALSA.Sequencer.Port + Sound.ALSA.Sequencer.Port.Info + Sound.ALSA.Sequencer.Event + Sound.ALSA.Sequencer.RealTime + Sound.ALSA.Sequencer.Queue + Sound.ALSA.Sequencer.Queue.Info + Sound.ALSA.Sequencer.Queue.Status + Sound.ALSA.Sequencer.Queue.Tempo + Sound.ALSA.Sequencer.Queue.Timer + + Other-modules: + Sound.ALSA.Sequencer.Marshal.Sequencer + Sound.ALSA.Sequencer.Marshal.Address + Sound.ALSA.Sequencer.Marshal.Client + Sound.ALSA.Sequencer.Marshal.Port + Sound.ALSA.Sequencer.Marshal.Queue + Sound.ALSA.Sequencer.Marshal.QueueTimer + Sound.ALSA.Sequencer.Marshal.Event + Sound.ALSA.Sequencer.Marshal.RealTime + Sound.ALSA.Sequencer.Area + Sound.ALSA.Sequencer.Sequencer + Sound.ALSA.Sequencer.Utility + + Includes: alsa/asoundlib.h + Extra-libraries: asound + +Executable test1 + Main-Is: test1.hs + If !flag(buildExamples) + Buildable: False + Hs-Source-Dirs: src, examples + GHC-Options: -Wall -threaded + Extensions: + ForeignFunctionInterface + GeneralizedNewtypeDeriving + EmptyDataDecls + Other-modules: + Sound.ALSA.Sequencer.Marshal.Sequencer + Sound.ALSA.Sequencer.Marshal.Address + Sound.ALSA.Sequencer.Marshal.Client + Sound.ALSA.Sequencer.Marshal.Port + Sound.ALSA.Sequencer.Marshal.Queue + Sound.ALSA.Sequencer.Marshal.QueueTimer + Sound.ALSA.Sequencer.Marshal.Event + Sound.ALSA.Sequencer.Marshal.RealTime + Sound.ALSA.Sequencer.Area + Sound.ALSA.Sequencer.Sequencer + Build-Depends: + alsa-core >=0.5 && <0.6, + array >= 0.1 && <0.4, + base >=3 && <5 + +Executable test2 + Main-Is: test2.hs + If !flag(buildExamples) + Buildable: False + Hs-Source-Dirs: src, examples + GHC-Options: -Wall -threaded + Extensions: + ForeignFunctionInterface + GeneralizedNewtypeDeriving + EmptyDataDecls + Other-modules: + Sound.ALSA.Sequencer.Marshal.Sequencer + Sound.ALSA.Sequencer.Marshal.Address + Sound.ALSA.Sequencer.Marshal.Client + Sound.ALSA.Sequencer.Marshal.Port + Sound.ALSA.Sequencer.Marshal.Queue + Sound.ALSA.Sequencer.Marshal.QueueTimer + Sound.ALSA.Sequencer.Marshal.Event + Sound.ALSA.Sequencer.Marshal.RealTime + Sound.ALSA.Sequencer.Area + Sound.ALSA.Sequencer.Sequencer + Build-Depends: + alsa-core >=0.5 && <0.6, + array >= 0.1 && <0.4, + base >=3 && <5 + +Executable test3 + Main-Is: test3.hs + If !flag(buildExamples) + Buildable: False + Hs-Source-Dirs: src, examples + GHC-Options: -Wall -threaded + Extensions: + ForeignFunctionInterface + GeneralizedNewtypeDeriving + EmptyDataDecls + Other-modules: + Sound.ALSA.Sequencer.Marshal.Sequencer + Sound.ALSA.Sequencer.Marshal.Address + Sound.ALSA.Sequencer.Marshal.Client + Sound.ALSA.Sequencer.Marshal.Port + Sound.ALSA.Sequencer.Marshal.Queue + Sound.ALSA.Sequencer.Marshal.QueueTimer + Sound.ALSA.Sequencer.Marshal.Event + Sound.ALSA.Sequencer.Marshal.RealTime + Sound.ALSA.Sequencer.Area + Sound.ALSA.Sequencer.Sequencer + Build-Depends: + alsa-core >=0.5 && <0.6, + array >= 0.1 && <0.4, + base >=3 && <5 + +Executable test4 + Main-Is: test4.hs + If !flag(buildExamples) + Buildable: False + Hs-Source-Dirs: src, examples + GHC-Options: -Wall -threaded + Extensions: + ForeignFunctionInterface + GeneralizedNewtypeDeriving + EmptyDataDecls + Other-modules: + Sound.ALSA.Sequencer.Marshal.Sequencer + Sound.ALSA.Sequencer.Marshal.Address + Sound.ALSA.Sequencer.Marshal.Client + Sound.ALSA.Sequencer.Marshal.Port + Sound.ALSA.Sequencer.Marshal.Queue + Sound.ALSA.Sequencer.Marshal.QueueTimer + Sound.ALSA.Sequencer.Marshal.Event + Sound.ALSA.Sequencer.Marshal.RealTime + Sound.ALSA.Sequencer.Area + Sound.ALSA.Sequencer.Sequencer + Build-Depends: + alsa-core >=0.5 && <0.6, + array >= 0.1 && <0.4, + base >=3 && <5 + +Executable test5 + Main-Is: test5.hs + If !flag(buildExamples) + Buildable: False + Hs-Source-Dirs: src, examples + GHC-Options: -Wall -threaded + Extensions: + ForeignFunctionInterface + GeneralizedNewtypeDeriving + EmptyDataDecls + Other-modules: + Sound.ALSA.Sequencer.Marshal.Sequencer + Sound.ALSA.Sequencer.Marshal.Address + Sound.ALSA.Sequencer.Marshal.Client + Sound.ALSA.Sequencer.Marshal.Port + Sound.ALSA.Sequencer.Marshal.Queue + Sound.ALSA.Sequencer.Marshal.QueueTimer + Sound.ALSA.Sequencer.Marshal.Event + Sound.ALSA.Sequencer.Marshal.RealTime + Sound.ALSA.Sequencer.Area + Sound.ALSA.Sequencer.Sequencer + Build-Depends: + alsa-core >=0.5 && <0.6, + array >= 0.1 && <0.4, + base >=3 && <5 diff --git a/examples/test1.hs b/examples/test1.hs new file mode 100644 --- /dev/null +++ b/examples/test1.hs @@ -0,0 +1,24 @@ +import qualified Sound.ALSA.Sequencer.Client as Client +import qualified Sound.ALSA.Sequencer.Port as Port +import qualified Sound.ALSA.Sequencer.Event as Event +import qualified Sound.ALSA.Sequencer as SndSeq +import qualified Sound.ALSA.Exception as AlsaExc + +main :: IO () +main = (do + putStrLn "Starting." + SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do + Client.setName (h :: SndSeq.T SndSeq.InputMode) "HS1" + putStrLn "Created sequencer." + Port.withSimple h "one" + (Port.caps [Port.capWrite, Port.capSubsWrite]) Port.typeMidiGeneric $ \ _p1 -> do + Port.withSimple h "two" + (Port.caps [Port.capWrite, Port.capSubsWrite]) Port.typeMidiGeneric $ \ _p2 -> do + putStrLn "Created ports." + let loop = do putStrLn "waiting for an event:" + e <- Event.input h + print e + loop + loop) + `AlsaExc.catch` \e -> + putStrLn $ "alsa_exception: " ++ AlsaExc.show e diff --git a/examples/test2.hs b/examples/test2.hs new file mode 100644 --- /dev/null +++ b/examples/test2.hs @@ -0,0 +1,38 @@ +import qualified Sound.ALSA.Sequencer.Address as Addr +import qualified Sound.ALSA.Sequencer.Client as Client +import qualified Sound.ALSA.Sequencer.Port as Port +import qualified Sound.ALSA.Sequencer.Event as Event +import qualified Sound.ALSA.Sequencer.Queue as Queue +import qualified Sound.ALSA.Sequencer as SndSeq +import qualified Sound.ALSA.Exception as AlsaExc + +main :: IO () +main = (do + putStrLn "Starting." + SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do + Client.setName (h :: SndSeq.T SndSeq.OutputMode) "HS test client" + putStrLn "Created sequencer." + Port.withSimple h "one" + (Port.caps [Port.capRead, Port.capSubsRead]) Port.typeMidiGeneric $ \ p -> do + putStrLn "Created port." + x <- Client.getId h + putStrLn ("My id is: " ++ show x) + let me = Addr.Cons { Addr.client = x, Addr.port = p } + getChar + Event.outputDirect h (e1 me) + getChar + return ()) + `AlsaExc.catch` \e -> + putStrLn $ "alsa_exception: " ++ AlsaExc.show e + + +e1 :: Addr.T -> Event.T +e1 me = Event.Cons + { Event.highPriority = False + , Event.tag = 0 + , Event.queue = Queue.direct + , Event.timestamp = Event.TickTime 0 + , Event.source = me + , Event.dest = Addr.subscribers + , Event.body = Event.NoteEv Event.NoteOn (Event.simpleNote 0 60 100) + } diff --git a/examples/test3.hs b/examples/test3.hs new file mode 100644 --- /dev/null +++ b/examples/test3.hs @@ -0,0 +1,38 @@ +import qualified Sound.ALSA.Sequencer.Address as Addr +import qualified Sound.ALSA.Sequencer.Client as Client +import qualified Sound.ALSA.Sequencer.Port as Port +import qualified Sound.ALSA.Sequencer.Event as Event +import qualified Sound.ALSA.Sequencer.Queue as Queue +import qualified Sound.ALSA.Sequencer as SndSeq +import qualified Sound.ALSA.Exception as AlsaExc + +main :: IO () +main = (do + putStrLn "Starting." + SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do + Client.setName (h :: SndSeq.T SndSeq.OutputMode) "HS3" + putStrLn "Created sequencer." + x <- Client.getId h + putStrLn ("My id is: " ++ show x) + let me = Addr.Cons { Addr.client = x, Addr.port = Port.unknown } + -- tgt_addr <- parse_address h "HS1:255" + let tgt_addr = Addr.Cons Client.broadcast Port.unknown + print tgt_addr + getChar + Event.outputDirect h (e1 me tgt_addr) + getChar + return ()) + `AlsaExc.catch` \e -> + putStrLn $ "alsa_exception: " ++ AlsaExc.show e + + +e1 :: Addr.T -> Addr.T -> Event.T +e1 from to = Event.Cons + { Event.highPriority = False + , Event.tag = 0 + , Event.queue = Queue.direct + , Event.timestamp = Event.TickTime 0 + , Event.source = from + , Event.dest = to + , Event.body = Event.NoteEv Event.NoteOn (Event.simpleNote 0 60 100) + } diff --git a/examples/test4.hs b/examples/test4.hs new file mode 100644 --- /dev/null +++ b/examples/test4.hs @@ -0,0 +1,13 @@ +import qualified Sound.ALSA.Sequencer.Client.Info as ClientInfo +import qualified Sound.ALSA.Sequencer as SndSeq + +import Control.Monad (when, ) + +main :: IO () +main = + SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do + i <- ClientInfo.queryFirst (h :: SndSeq.T SndSeq.OutputMode) + let loop = do putStrLn =<< ClientInfo.getName i + more <- ClientInfo.queryNext h i + when more loop + loop diff --git a/examples/test5.hs b/examples/test5.hs new file mode 100644 --- /dev/null +++ b/examples/test5.hs @@ -0,0 +1,69 @@ +import qualified Sound.ALSA.Sequencer.Address as Addr +import qualified Sound.ALSA.Sequencer.Client as Client +import qualified Sound.ALSA.Sequencer.Port as Port +import qualified Sound.ALSA.Sequencer.Event as Event +import qualified Sound.ALSA.Sequencer.Queue as Queue +import qualified Sound.ALSA.Sequencer as SndSeq +import qualified Sound.ALSA.Exception as AlsaExc + +import Control.Monad (zipWithM_, ) + + +main :: IO () +main = (do + SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do + Client.setName (h :: SndSeq.T SndSeq.DuplexMode) "HS5" + Port.withSimple h "1" + (Port.caps [Port.capRead, Port.capSubsRead, Port.capWrite]) + (Port.types [Port.typeMidiGeneric, Port.typeApplication]) $ \p -> do + c <- Client.getId h + Queue.with h $ \q -> do + let ev t e = Event.Cons + { Event.highPriority = False + , Event.tag = 0 + , Event.queue = q + , Event.timestamp = Event.TickTime t + , Event.source = Addr.Cons { Addr.client = c, Addr.port = p } + , Event.dest = Addr.subscribers + , Event.body = e + } + play t chan pitch vel = + do print =<< Event.output h (ev t $ + Event.NoteEv Event.NoteOn $ Event.simpleNote chan pitch vel) + + print =<< Event.output h (ev (t+1) $ + Event.NoteEv Event.NoteOn $ Event.simpleNote chan pitch 0) + + echo t = + print =<< Event.output h + ((ev t $ Event.CustomEv Event.Echo $ Event.Custom 0 0 0){ + Event.dest = Addr.Cons { Addr.client = c, Addr.port = p } + }) + + putStrLn "Please connect me to a synth" + getChar + Queue.control h q Event.QueueStart 0 Nothing + Queue.control h q Event.QueueTempo 10000000 Nothing + zipWithM_ (\t -> + maybe (echo t) (\n -> play t 0 n 127)) [0..] $ + (++[Nothing]) $ + concat $ concatMap (replicate 4 . map Just) $ + [57, 59, 60, 64] : + [57, 59, 60, 65] : + [57, 62, 64, 65] : + [57, 59, 60, 64] : + [] + Event.drainOutput h + print =<< Event.outputPending h + +-- threadDelay 10000000 + let waitForEcho = do + event <- Event.input h + print event + case Event.body event of + Event.CustomEv Event.Echo _d -> return () + _ -> waitForEcho + waitForEcho) + + `AlsaExc.catch` \e -> + putStrLn $ "alsa_exception: " ++ AlsaExc.show e diff --git a/src/Sound/ALSA/Sequencer.hs b/src/Sound/ALSA/Sequencer.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer.hs @@ -0,0 +1,63 @@ +------------------------------------------------------------------ +-- | +-- Module : Sound.ALSA.Sequencer +-- Copyright : (c) Henning Thielemann, 2010 +-- (c) Iavor S. Diatchki, 2007 +-- License : BSD3 +-- +-- Maintainer: Henning Thielemann +-- Stability : provisional +-- +-- Overview: +-- +-- WARNING: This whole library does not seem to be particlarly thread aware. +-- Perhaps place the sequencer handle in an MVar? + +module Sound.ALSA.Sequencer + ( -- * Sequencer + Seq.T + , OpenMode + , AllowOutput + , AllowInput + , OutputMode(..) + , InputMode(..) + , DuplexMode(..) + + , BlockMode(..) + + , open + , close + , with + , defaultName + , getName + , setBlocking + + -- ** Manage user-space buffers + , getOutputBufferSize + , setOutputBufferSize + , getInputBufferSize + , setInputBufferSize + + -- ** Manage kernel-space memory pools + , setPoolOutput + , setPoolOutputRoom + , resetPoolOutput + , setPoolInput + , resetPoolInput + + + -- ** Connections + , connectFrom + , connectTo + , disconnectFrom + , disconnectTo + ) where + +import Sound.ALSA.Sequencer.Marshal.Sequencer as Seq +import Sound.ALSA.Sequencer.Sequencer + + + +-- | This is the name that should be passed to 'open' in most cases. +defaultName :: String +defaultName = "default" diff --git a/src/Sound/ALSA/Sequencer/Address.hs b/src/Sound/ALSA/Sequencer/Address.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Address.hs @@ -0,0 +1,20 @@ +module Sound.ALSA.Sequencer.Address + ( Addr.T(Addr.Cons, Addr.client, Addr.port) + , Addr.subscribers + , parse + ) where + +import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr +import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as MSeq +import qualified Sound.ALSA.Sequencer.Sequencer as Seq + +{- | +Parse the given string into sequencer address. +The client and port are separated by either colon or period, e.g. 128:1. +The function also accepts client names. +-} +parse + :: MSeq.T mode -- ^ Sequencer handle. + -> String -- ^ String to be parsed. + -> IO Addr.T -- ^ The parsed address. +parse = Seq.parseAddress diff --git a/src/Sound/ALSA/Sequencer/Area.hsc b/src/Sound/ALSA/Sequencer/Area.hsc new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Area.hsc @@ -0,0 +1,264 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Sound.ALSA.Sequencer.Area +-- Copyright : (c) Henning Thielemann, 2010 +-- (c) Iavor S. Diatchki, 2007 +-- License : BSD3 +-- +-- Maintainer: Henning Thielemann +-- Stability : provisional +-- +-- PRIVATE MODULE. +-- +-- Here we have macros to deal with the various information +-- areas present in the library. +-------------------------------------------------------------------------------- + +module Sound.ALSA.Sequencer.Area where + +import qualified Sound.ALSA.Sequencer.Marshal.Client as Client +import qualified Sound.ALSA.Sequencer.Marshal.Port as Port +import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue +import qualified Sound.ALSA.Sequencer.Marshal.QueueTimer as QueueTimer +import qualified Sound.ALSA.Exception as Exc + +import Foreign.C.Types (CInt, ) +import Foreign.C.String (CString, peekCString, withCAString, ) +import Foreign.Storable (Storable, peek, ) +import Foreign.Marshal.Alloc (alloca, ) +import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, withForeignPtr, ) +import Foreign.Ptr (Ptr, FunPtr, ) +import Data.Word (Word, ) + + +class C area where + malloc :: IO area + copy :: area -> area -> IO () + clone :: area -> IO area + +#{let area x,y = +"data "x"_\n" +"newtype "x" = "x" (ForeignPtr "x"_)\n" +"\n" +"with_"y" :: "x" -> (Ptr "x"_ -> IO a) -> IO a\n" +"with_"y" ("x" p) f = withForeignPtr p f\n" +"\n" +"-- | Allocate an uninitialized object. (Not exported)\n" +y"_malloc :: IO "x"\n" +y"_malloc = alloca $ \\p ->\n" +" do Exc.checkResult \"Sequencer."y"\" =<< snd_seq_"y"_malloc p\n" +" "x" `fmap` (newForeignPtr snd_seq_"y"_free =<< peek p)\n" +"\n" +"foreign import ccall \"alsa/asoundlib.h snd_seq_"y"_malloc\"\n" +" snd_seq_"y"_malloc :: Ptr (Ptr "x"_) -> IO CInt\n" +"\n" +"foreign import ccall \"alsa/asoundlib.h &snd_seq_"y"_free\"\n" +" snd_seq_"y"_free :: FunPtr (Ptr "x"_ -> IO ())\n" +"\n" +"-- | Copy the content of one object into another.\n" +y"_copy\n" +" :: "x" -- ^ Destination\n" +" -> "x" -- ^ Source\n" +" -> IO ()\n" +"\n" +y"_copy to from =\n" +" with_"y" to $ \\p1 ->\n" +" with_"y" from $ \\p2 ->\n" +" snd_seq_"y"_copy p1 p2\n" +"\n" +"foreign import ccall \"alsa/asoundlib.h snd_seq_"y"_copy\"\n" +" snd_seq_"y"_copy :: Ptr "x"_ -> Ptr "x"_ -> IO ()\n" +"\n" +"-- | Copy the content of an object to a newly created object.\n" +y"_clone :: "x" -> IO "x"\n" +y"_clone from =\n" +" do to <- "y"_malloc\n" +" "y"_copy to from\n" +" return to\n" +"\n" +"instance C "x" where\n" +" malloc = "y"_malloc\n" +" copy = "y"_copy\n" +" clone = "y"_clone\n" +} + +#{let get_set_name x,y = +y"_get_name :: "x" -> IO String\n" +y"_get_name i = peekCString =<< with_"y" i snd_seq_"y"_get_name\n" +"\n" +"foreign import ccall \"alsa/asoundlib.h snd_seq_"y"_get_name\"\n" +" snd_seq_"y"_get_name :: Ptr "x"_ -> IO CString\n" +"\n" +y"_set_name :: "x" -> String -> IO ()\n" +y"_set_name i c =\n" +" withCAString c $ \\p -> with_"y" i (`snd_seq_"y"_set_name` p)\n" +"\n" +"foreign import ccall \"alsa/asoundlib.h snd_seq_"y"_set_name\"\n" +" snd_seq_"y"_set_name :: Ptr "x"_ -> CString -> IO ()\n" +} + +#{let get_set_bool x,y,z = +y"_get_"z" :: "x" -> IO Bool\n" +y"_get_"z" i =\n" +" (1 ==) `fmap` with_"y" i snd_seq_"y"_get_"z"\n" +"\n" +"foreign import ccall \"alsa/asoundlib.h snd_seq_"y"_get_"z"\"\n" +" snd_seq_"y"_get_"z" :: Ptr "x"_ -> IO CInt\n" +"\n" +y"_set_"z" :: "x" -> Bool -> IO ()\n" +y"_set_"z" i c =\n" +" let x = if c then 1 else 0\n" +" in with_"y" i (`snd_seq_"y"_set_"z"` x)\n" +"\n" +"foreign import ccall \"alsa/asoundlib.h snd_seq_"y"_set_"z"\"\n" +" snd_seq_"y"_set_"z" :: Ptr "x"_ -> CInt -> IO ()\n" +} + +#{let get_int x,y,z,t,mk = +y"_get_"z" :: "x" -> IO "t"\n" +y"_get_"z" i =\n" +" "mk"\n" +" `fmap` with_"y" i snd_seq_"y"_get_"z"\n" +"\n" +"foreign import ccall \"alsa/asoundlib.h snd_seq_"y"_get_"z"\"\n" +" snd_seq_"y"_get_"z" :: Ptr "x"_ -> IO CInt\n" +} + +#{let set_int x,y,z,t,brk = +y"_set_"z" :: "x" -> "t" -> IO ()\n" +y"_set_"z" i c =\n" +" with_"y" i (`snd_seq_"y"_set_"z"` "brk" c)\n" +"\n" +"foreign import ccall \"alsa/asoundlib.h snd_seq_"y"_set_"z"\"\n" +" snd_seq_"y"_set_"z" :: Ptr "x"_ -> CInt -> IO ()\n" +} + + + +-- Client.T Info ----------------------------------------------------------------- +#area "ClientInfo", "client_info" + +-- read/write +#get_set_name "ClientInfo", "client_info" +#get_set_bool "ClientInfo", "client_info", "broadcast_filter" +#get_set_bool "ClientInfo", "client_info", "error_bounce" +#{get_int "ClientInfo", "client_info", "client", + "Client.T", "Client.imp"} +#{set_int "ClientInfo", "client_info", "client", + "Client.T", "Client.exp"} + +-- read only +#{get_int "ClientInfo", "client_info", "type", + "Client.Type", "Client.impType"} +#{get_int "ClientInfo", "client_info", "num_ports", + "Word", "fromIntegral"} +#{get_int "ClientInfo", "client_info", "event_lost", + "Word", "fromIntegral"} + + +-- Port Info ------------------------------------------------------------------- +#area "PortInfo", "port_info" + +-- read/write +#get_set_name "PortInfo", "port_info" + +#get_set_bool "PortInfo", "port_info", "port_specified" +#get_set_bool "PortInfo", "port_info", "timestamping" +#get_set_bool "PortInfo", "port_info", "timestamp_real" + +#{get_int "PortInfo", "port_info", "port", + "Port.T", "Port.imp"} +#{set_int "PortInfo", "port_info", "port", + "Port.T", "Port.exp"} +#{get_int "PortInfo", "port_info", "client", + "Client.T","Client.imp"} +#{set_int "PortInfo", "port_info", "client", + "Client.T","Client.exp"} +#{get_int "PortInfo", "port_info", "capability", + "Port.Cap","(Port.Cap . fromIntegral)"} +#{set_int "PortInfo", "port_info", "capability", + "Port.Cap","(fromIntegral . Port.unCap)"} + +#{get_int "PortInfo", "port_info", "midi_channels", + "Word","fromIntegral"} +#{set_int "PortInfo", "port_info", "midi_channels", + "Word","fromIntegral"} +#{get_int "PortInfo", "port_info", "midi_voices", + "Word","fromIntegral"} +#{set_int "PortInfo", "port_info", "midi_voices", + "Word","fromIntegral"} +#{get_int "PortInfo", "port_info", "synth_voices", + "Word","fromIntegral"} +#{set_int "PortInfo", "port_info", "synth_voices", + "Word","fromIntegral"} + +#{get_int "PortInfo", "port_info", "timestamp_queue", + "Queue.T","Queue.imp"} +#{set_int "PortInfo", "port_info", "timestamp_queue", + "Queue.T","Queue.exp"} + +-- read only +#{get_int "PortInfo", "port_info", "read_use", + "Word","fromIntegral"} +#{get_int "PortInfo", "port_info", "write_use", + "Word","fromIntegral"} + +-- Queue.T Info ------------------------------------------------------------------ +#area "QueueInfo", "queue_info" +#get_set_name "QueueInfo", "queue_info" +#get_set_bool "QueueInfo", "queue_info", "locked" + +#{get_int "QueueInfo", "queue_info", "owner", + "Client.T", "Client.imp"} +#{set_int "QueueInfo", "queue_info", "owner", + "Client.T", "Client.exp"} +#{get_int "QueueInfo", "queue_info", "flags", + "Word", "fromIntegral"} +#{set_int "QueueInfo", "queue_info", "flags", + "Word", "fromIntegral"} + +-- RO +#{get_int "QueueInfo", "queue_info", "queue", + "Queue.T","Queue.imp"} + +-- Queue.T Status ---------------------------------------------------------------- +#area "QueueStatus", "queue_status" + +-- Queue.T Tempo ----------------------------------------------------------------- +#area "QueueTempo", "queue_tempo" + +-- RO +#{get_int "QueueTempo", "queue_tempo", "queue", + "Queue.T","Queue.imp"} + +-- RW +#{get_int "QueueTempo", "queue_tempo", "tempo", "Word", "fromIntegral"} +#{set_int "QueueTempo", "queue_tempo", "tempo", "Word", "fromIntegral"} + +#{get_int "QueueTempo", "queue_tempo", "ppq", "Int", "fromIntegral"} +#{set_int "QueueTempo", "queue_tempo", "ppq", "Int", "fromIntegral"} + +#{get_int "QueueTempo", "queue_tempo", "skew", "Word", "fromIntegral"} +#{set_int "QueueTempo", "queue_tempo", "skew", "Word", "fromIntegral"} + +#{get_int "QueueTempo", "queue_tempo", "skew_base", "Word", "fromIntegral"} +#{set_int "QueueTempo", "queue_tempo", "skew_base", "Word", "fromIntegral"} + +-- Queue.T Timer ----------------------------------------------------------------- +#area "QueueTimer", "queue_timer" + + +-- RO +#{get_int "QueueTimer", "queue_timer", "queue", + "Queue.T","Queue.imp"} + +-- RW + +#{get_int "QueueTimer", "queue_timer", "type", + "QueueTimer.Type", "QueueTimer.impType"} +#{set_int "QueueTimer", "queue_timer", "type", + "QueueTimer.Type", "QueueTimer.expType"} + +#{get_int "QueueTimer", "queue_timer", "resolution", "Word", "fromIntegral"} +#{set_int "QueueTimer", "queue_timer", "resolution", "Word", "fromIntegral"} + diff --git a/src/Sound/ALSA/Sequencer/Client.hs b/src/Sound/ALSA/Sequencer/Client.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Client.hs @@ -0,0 +1,52 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Sound.ALSA.Sequencer.Client +-- Copyright : (c) Henning Thielemann, 2010 +-- (c) Iavor S. Diatchki, 2007 +-- License : BSD3 +-- +-- Maintainer: Henning Thielemann +-- Stability : provisional +-- +-- This module contains functions for working with sequencer clients. +-- Reference: +-- +-------------------------------------------------------------------------------- + +module Sound.ALSA.Sequencer.Client + ( Client.T + , Client.unknown + , Client.system + , Client.subscribers + , Client.broadcast + + , getId + , setName + + , Client.Type(..) + ) where + +import qualified Sound.ALSA.Sequencer.Client.Info as ClientInfo + +import qualified Sound.ALSA.Sequencer.Marshal.Client as Client +import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq + + +-- XXX: Still missing the pool interface. + +-- Convinience functions ------------------------------------------------------- +-- These are part of the "middle" interface, but it seems simple to +-- define them directly in Haskell. + +-- | Get the client identifier for the sequencer. +-- A convinience function. +getId :: Seq.T mode -> IO Client.T +getId h = ClientInfo.getClient =<< ClientInfo.get h + +-- | Set the name for the sequencer client. +-- A convinience function. +setName :: Seq.T mode -> String -> IO () +setName h s = + do i <- ClientInfo.get h + ClientInfo.setName i s + ClientInfo.set h i diff --git a/src/Sound/ALSA/Sequencer/Client/Info.hs b/src/Sound/ALSA/Sequencer/Client/Info.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Client/Info.hs @@ -0,0 +1,142 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Sound.ALSA.Sequencer.Client +-- Copyright : (c) Henning Thielemann, 2010 +-- (c) Iavor S. Diatchki, 2007 +-- License : BSD3 +-- +-- Maintainer: Henning Thielemann +-- Stability : provisional +-- +-- This module contains functions for working with sequencer clients. +-- Reference: +-- +-------------------------------------------------------------------------------- + +module Sound.ALSA.Sequencer.Client.Info + ( T + + , get + , getAny + , queryFirst + , queryNext + , set + + , copy + , clone + + , getClient + , getType + , getName + , getBroadcastFilter + , getErrorBounce + , getNumPorts + , getEventLost + + , setClient + , setName + , setBroadcastFilter + , setErrorBounce + ) where + + +import qualified Sound.ALSA.Sequencer.Marshal.Client as Client +import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq +import qualified Sound.ALSA.Sequencer.Area as Area +import qualified Sound.ALSA.Exception as Exc + +import Foreign.C.Types(CInt, ) +import Foreign.Ptr(Ptr, ) +import Data.Word (Word, ) + +import Control.Monad (guard, ) + + +-------------------------------------------------------------------------------- + +type T = Area.ClientInfo +type T_ = Area.ClientInfo_ + +-- | Create a new information area filled with data about the sequencer client. +get :: Seq.T mode -> IO T +get (Seq.Cons h) = + do info <- Area.client_info_malloc + Exc.checkResult "get_client_info" =<< Area.with_client_info info (snd_seq_get_client_info h) + return info + +foreign import ccall "alsa/asoundlib.h snd_seq_get_client_info" + snd_seq_get_client_info :: Ptr Seq.Core -> Ptr T_ -> IO CInt + + +-- | Create a new information area filled with data about an arbitrary client. +getAny :: Seq.T mode -> Client.T -> IO T +getAny (Seq.Cons h) c = + do info <- Area.client_info_malloc + Exc.checkResult "get_any_client_info" =<< Area.with_client_info info + (snd_seq_get_any_client_info h (Client.exp c)) + return info + +foreign import ccall "alsa/asoundlib.h snd_seq_get_any_client_info" + snd_seq_get_any_client_info + :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt + + + +queryFirst :: Seq.T mode -> IO T +queryFirst h = + do x <- Area.client_info_malloc + Area.with_client_info x (`Area.snd_seq_client_info_set_client` (-1)) + _b <- queryNext h x + -- XXX: check that we did get the first client (should be System) + return x + + +-- | Get information about the client with the next biggest identifier. +queryNext :: Seq.T mode -> T + -> IO Bool -- ^ Was there a next client? +queryNext (Seq.Cons h) info = + Exc.checkResultMaybe "query_next_client" + (const True) (\x -> guard (x == -2) >> return False) + =<< Area.with_client_info info (snd_seq_query_next_client h) + +foreign import ccall "alsa/asoundlib.h snd_seq_query_next_client" + snd_seq_query_next_client :: Ptr Seq.Core -> Ptr T_ -> IO CInt + + +-- | Set the information for the sequencer client based on the data +-- in the given information area. +set :: Seq.T mode -> T -> IO () +set (Seq.Cons h) info = + Exc.checkResult_ "set_client_info" =<< Area.with_client_info info (snd_seq_set_client_info h) + +foreign import ccall "alsa/asoundlib.h snd_seq_set_client_info" + snd_seq_set_client_info :: Ptr Seq.Core -> Ptr T_ -> IO CInt + + +copy :: T -> T -> IO () +clone :: T -> IO T +getClient :: T -> IO Client.T +getType :: T -> IO Client.Type +getName :: T -> IO String +getBroadcastFilter :: T -> IO Bool +getErrorBounce :: T -> IO Bool +getNumPorts :: T -> IO Word +getEventLost :: T -> IO Word +setClient :: T -> Client.T -> IO () +setName :: T -> String -> IO () +setBroadcastFilter :: T -> Bool -> IO () +setErrorBounce :: T -> Bool -> IO () + +copy = Area.client_info_copy +clone = Area.client_info_clone +getClient = Area.client_info_get_client +getType = Area.client_info_get_type +getName = Area.client_info_get_name +getBroadcastFilter = Area.client_info_get_broadcast_filter +getErrorBounce = Area.client_info_get_error_bounce +getNumPorts = Area.client_info_get_num_ports +getEventLost = Area.client_info_get_event_lost +setClient = Area.client_info_set_client +setName = Area.client_info_set_name +setBroadcastFilter = Area.client_info_set_broadcast_filter +setErrorBounce = Area.client_info_set_error_bounce diff --git a/src/Sound/ALSA/Sequencer/Event.hs b/src/Sound/ALSA/Sequencer/Event.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Event.hs @@ -0,0 +1,288 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Sound.ALSA.Sequencer.Event +-- Copyright : (c) Henning Thielemann, 2010 +-- (c) Iavor S. Diatchki, 2007 +-- License : BSD3 +-- +-- Maintainer: Iavor S. Diatchki +-- Stability : provisional +-- +-- This module contains functions for working with events. +-- Reference: +-- +-------------------------------------------------------------------------------- + +module Sound.ALSA.Sequencer.Event + ( syncOutputQueue + , input + , inputPending + , output + , outputBuffer + , outputDirect + , outputPending + , extractOutput + , removeOutput + , drainOutput + , dropOutput + , dropOutputBuffer + , dropInput + , dropInputBuffer + + , volumeSame + + , TimeStamp(..) + , InstrCluster + , Instr(..) + , Sample(..) + , Cluster(..) + , Volume(..) + + , Event.T(..) + , Event.Data(..) + , NoteEv(..), Note(..), simpleNote + , CtrlEv(..), Ctrl(..) + , CustomEv(..), Custom(..) + , QueueEv(..) + , AddrEv(..) + , ConnEv(..), Connect + , EmptyEv(..) + ) where + + +import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq +import Sound.ALSA.Sequencer.Marshal.Event as Event +import qualified Sound.ALSA.Exception as Exc + +import Foreign.C.Types (CInt, ) +import Foreign.Ptr (Ptr, nullPtr, ) +import Foreign.Marshal.Alloc (alloca, ) +import Foreign.Storable (peek, ) + +import Data.Word (Word, Word8, ) +import Data.Int (Int16, ) + + +-- | Wait until all events of the client are processed. +syncOutputQueue :: Seq.T mode -> IO () +syncOutputQueue (Seq.Cons h) = + Exc.checkResult_ "syncOutputQueue" =<< snd_seq_sync_output_queue h + +foreign import ccall "alsa/asoundlib.h snd_seq_sync_output_queue" + snd_seq_sync_output_queue :: Ptr Seq.Core -> IO CInt + + +-- | Get an event from the input buffer. +-- If the input buffer is empty, then it is filled with data from the +-- sequencer queue. If there is no data in the sequencer queue, +-- then the process is either put to sleep (if the sequencer is operating +-- in blocking mode), or we throw @EAGAIN@ (if the sequence is operating +-- in non-blocking mode). +-- +-- We may also throw @ENOSPC@, which means that the sequencer queue +-- over-run and some events were lost (this clears the input buffer). +-- +input :: Seq.AllowInput mode => Seq.T mode -> IO Event.T +input (Seq.Cons h) = alloca $ \p -> + do Exc.checkResult "input" =<< snd_seq_event_input h p + peek =<< peek p + +foreign import ccall "alsa/asoundlib.h snd_seq_event_input" + snd_seq_event_input :: Ptr Seq.Core -> Ptr (Ptr Event.T) -> IO CInt + + +checkResult :: String -> CInt -> IO Word +checkResult loc n = + fmap fromIntegral $ Exc.checkResult loc n + + +-- | Returns the number of events in the input buffer. +-- If the input buffer is empty and the boolean argument is true, +-- then try to fill the input buffer with data from the sequencer queue. +-- See also: 'input'. + +inputPending + :: Seq.AllowInput mode + => Seq.T mode + -> Bool -- ^ refill if empty? + -> IO Word -- ^ number of events in buffer +inputPending (Seq.Cons h) fill = + checkResult "inputPending" =<< snd_seq_event_input_pending h (if fill then 1 else 0) + +foreign import ccall "alsa/asoundlib.h snd_seq_event_input_pending" + snd_seq_event_input_pending :: Ptr Seq.Core -> Int -> IO CInt + + + +-- | Output an event and drain the buffer, if it became full. +-- Throws exceptions. +-- See also: 'outputDirect', 'outputBuffer', +-- 'outputPending', 'drainOutput', 'dropOutput', +-- 'extractOutput', 'removeEvents' + +output :: Seq.AllowOutput mode + => Seq.T mode + -> Event.T + -> IO Word -- ^ the number of remaining events (or bytes?) +output (Seq.Cons h) e = + Event.allocaEv e $ \p -> checkResult "output" =<< snd_seq_event_output h p + +foreign import ccall "alsa/asoundlib.h snd_seq_event_output" + snd_seq_event_output :: Ptr Seq.Core -> Ptr Event.T -> IO CInt + + + +-- | Output an event without draining the buffer. +-- Throws @-EAGAIN@ if the buffer becomes full. +-- See also 'output'. + +outputBuffer :: Seq.AllowOutput mode + => Seq.T mode + -> Event.T + -> IO Word -- ^ the byte size of remaining events + +outputBuffer (Seq.Cons h) e = + Event.allocaEv e $ \p -> checkResult "outputBuffer" =<< snd_seq_event_output_buffer h p + +foreign import ccall "alsa/asoundlib.h snd_seq_event_output_buffer" + snd_seq_event_output_buffer :: Ptr Seq.Core -> Ptr Event.T -> IO CInt + + +-- | Output an event directly to the sequencer, NOT through the output buffer. +-- If an error occurs, then we throw an exception. +-- See also 'output'. + +outputDirect + :: Seq.AllowOutput mode + => Seq.T mode + -> Event.T + -> IO Word -- ^ number of bytes sent to the sequencer + +outputDirect (Seq.Cons h) e = + Event.allocaEv e $ \p -> checkResult "outputDirect" =<< snd_seq_event_output_direct h p + +foreign import ccall "alsa/asoundlib.h snd_seq_event_output_direct" + snd_seq_event_output_direct :: Ptr Seq.Core -> Ptr Event.T -> IO CInt + + +-- | Return the size (in bytes) of pending events on output buffer. +-- See also 'output'. +outputPending + :: Seq.AllowOutput mode + => Seq.T mode + -> IO Word -- ^ size of pending events (in bytes) +outputPending (Seq.Cons h) = + fromIntegral `fmap` snd_seq_event_output_pending h + +foreign import ccall "alsa/asoundlib.h snd_seq_event_output_pending" + snd_seq_event_output_pending :: Ptr Seq.Core -> IO CInt + + +-- | Extract the first event in output buffer. +-- Throws an exception on error. +-- See also 'output'. +extractOutput + :: Seq.AllowOutput mode + => Seq.T mode + -> IO Event.T -- ^ the first event in the buffer (if one was present) +extractOutput (Seq.Cons h) = + alloca $ \p -> do Exc.checkResult "extractOutput" =<< snd_seq_extract_output h p + peek =<< peek p + +-- | Remove the first event in output buffer. +-- Throws an exception on error. +-- See also 'output'. +removeOutput :: Seq.AllowOutput mode + => Seq.T mode -> IO () +removeOutput (Seq.Cons h) = Exc.checkResult_ "removeOutput" =<< snd_seq_extract_output h nullPtr + +foreign import ccall "alsa/asoundlib.h snd_seq_extract_output" + snd_seq_extract_output :: Ptr Seq.Core -> Ptr (Ptr Event.T) -> IO CInt + + +-- | Drain output buffer to sequencer. +-- This function drains all pending events on the output buffer. +-- The function returns immediately after the events are sent to the queues +-- regardless whether the events are processed or not. +-- To get synchronization with the all event processes, +-- use 'syncOutputQueue' after calling this function. +-- Throws an exception on error. +-- See also: 'output', 'syncOutputQueue'. + +drainOutput + :: Seq.AllowOutput mode + => Seq.T mode + -> IO Word -- ^ byte size of events remaining in the buffer. + +drainOutput (Seq.Cons h) = checkResult "drainOutput" =<< snd_seq_drain_output h + +foreign import ccall "alsa/asoundlib.h snd_seq_drain_output" + snd_seq_drain_output :: Ptr Seq.Core -> IO CInt + + +-- | Remove events from both the user-space output buffer, +-- and the kernel-space sequencer queue. +-- See also: 'drainOutput', 'dropOutputBuffer', 'removeEvents'. +dropOutput + :: Seq.AllowOutput mode + => Seq.T mode -> IO () +dropOutput (Seq.Cons h) = Exc.checkResult_ "dropOutput" =<< snd_seq_drop_output h + +foreign import ccall "alsa/asoundlib.h snd_seq_drop_output" + snd_seq_drop_output :: Ptr Seq.Core -> IO CInt + + +-- | Remove events from the user-space output buffer. +-- See also: 'dropOutput'. +dropOutputBuffer + :: Seq.AllowOutput mode + => Seq.T mode -> IO () +dropOutputBuffer (Seq.Cons h) = Exc.checkResult_ "dropOutputBuffer" =<< snd_seq_drop_output_buffer h + +foreign import ccall "alsa/asoundlib.h snd_seq_drop_output_buffer" + snd_seq_drop_output_buffer :: Ptr Seq.Core -> IO CInt + + +-- | Remove events from both the user-space input buffer, +-- and the kernel-space sequencer queue. +-- See also: 'dropInputBuffer', 'removeEvents'. +dropInput + :: Seq.AllowInput mode + => Seq.T mode -> IO () +dropInput (Seq.Cons h) = Exc.checkResult_ "dropInput" =<< snd_seq_drop_input h + +foreign import ccall "alsa/asoundlib.h snd_seq_drop_input" + snd_seq_drop_input :: Ptr Seq.Core -> IO CInt + + +-- | Remove events from the user-space input buffer. +-- See also: 'dropInput'. +dropInputBuffer + :: Seq.AllowInput mode + => Seq.T mode -> IO () +dropInputBuffer (Seq.Cons h) = Exc.checkResult_ "dropInputBuffer" =<< snd_seq_drop_input_buffer h + +foreign import ccall "alsa/asoundlib.h snd_seq_drop_input_buffer" + snd_seq_drop_input_buffer :: Ptr Seq.Core -> IO CInt + + + +-- | Make a note whose unspecified fields contain 0. +simpleNote + :: Word8 -- ^ Channel. + -> Word8 -- ^ Note. + -> Word8 -- ^ Velocity. + -> Event.Note +simpleNote c n v = + Event.Note { + Event.noteChannel = c, + Event.noteNote = n, + Event.noteVelocity = v, + Event.noteOffVelocity = 0, + Event.noteDuration = 0 + } + + +-- | Used for volume control: means do not change the volume. +volumeSame :: Int16 +volumeSame = -1 diff --git a/src/Sound/ALSA/Sequencer/Marshal/Address.hsc b/src/Sound/ALSA/Sequencer/Marshal/Address.hsc new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Marshal/Address.hsc @@ -0,0 +1,45 @@ +module Sound.ALSA.Sequencer.Marshal.Address where + +#include + +import qualified Sound.ALSA.Sequencer.Marshal.Client as Client +import qualified Sound.ALSA.Sequencer.Marshal.Port as Port + +import qualified Sound.ALSA.Sequencer.Utility as U + +import Foreign.C.Types (CInt, ) +import Foreign.Storable + (Storable, sizeOf, alignment, peek, poke, pokeByteOff, peekByteOff, ) + + +data T = Cons + { client :: !Client.T + , port :: !Port.T + } deriving (Eq, Ord) + +instance Show T where + showsPrec prec (Cons c p) = + U.showsRecord prec "Address" [U.showsField c, U.showsField p] + + +exp :: T -> (CInt,CInt) +exp a = (Client.exp (client a), Port.exp (port a)) + + +instance Storable T where + sizeOf _ = #size snd_seq_real_time_t + alignment _ = 4 -- XXX + peek p = do cl <- #{peek snd_seq_addr_t, client} p + po <- #{peek snd_seq_addr_t, port} p + return Cons { client = cl, port = po } + poke p v = #{poke snd_seq_addr_t, client} p (client v) + >> #{poke snd_seq_addr_t, port} p (port v) + + +-- | The address of all subscribed ports. +subscribers :: T +subscribers = + Cons { + client = Client.subscribers, + port = Port.unknown + } diff --git a/src/Sound/ALSA/Sequencer/Marshal/Client.hsc b/src/Sound/ALSA/Sequencer/Marshal/Client.hsc new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Marshal/Client.hsc @@ -0,0 +1,62 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Sound.ALSA.Sequencer.Marshal +-- Copyright : (c) Henning Thielemann, 2010 +-- (c) Iavor S. Diatchki, 2007 +-- License : BSD3 +-- +-- Maintainer: Henning Thielemann +-- Stability : provisional +-- +-- PRIVATE MODULE. +-- +-- Here we have the various types used by the library, +-- and how they are imported\/exported to C. +-- +-- NOTE: In the translations bellow we make the following assumptions +-- about the sizes of C types. +-- CChar = 8 bits +-- CShort = 16 bit +-- CInt = 32 bits +-------------------------------------------------------------------------------- + +module Sound.ALSA.Sequencer.Marshal.Client where + +#include +import qualified Sound.ALSA.Sequencer.Utility as U +import Foreign.C.Types (CInt, ) +import Foreign.Storable (Storable, ) +import Data.Word (Word8, ) + + +-- | The type of client identifiers. +newtype T = Cons Word8 deriving (Eq, Ord, Storable) + +instance Show T where + showsPrec prec (Cons x) = + U.showsRecord prec "Client" [U.showsField x] + + +#{enum T, Cons + , system = SND_SEQ_CLIENT_SYSTEM + , subscribers = SND_SEQ_ADDRESS_SUBSCRIBERS + , broadcast = SND_SEQ_ADDRESS_BROADCAST + , unknown = SND_SEQ_ADDRESS_UNKNOWN + } + + + +exp :: T -> CInt +exp (Cons c) = fromIntegral c + +imp :: CInt -> T +imp p = Cons (fromIntegral p) + +-- | The different types of clients. +data Type = User | Kernel + +impType :: CInt -> Type +impType x = + if x == #{const SND_SEQ_USER_CLIENT} + then User + else Kernel diff --git a/src/Sound/ALSA/Sequencer/Marshal/Event.hsc b/src/Sound/ALSA/Sequencer/Marshal/Event.hsc new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Marshal/Event.hsc @@ -0,0 +1,550 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Sound.ALSA.Sequencer.Marshal.Event +-- Copyright : (c) Henning Thielemann, 2010 +-- (c) Iavor S. Diatchki, 2007 +-- License : BSD3 +-- +-- Maintainer: Henning Thielemann +-- Stability : provisional +-- +-- PRIVATE MODULE. +-- +-- Here we have the various types used by the library, +-- and how they are imported\/exported to C. +-- +-- NOTE: In the translations bellow we make the following assumptions +-- about the sizes of C types. +-- CChar = 8 bits +-- CShort = 16 bit +-- CInt = 32 bits +-------------------------------------------------------------------------------- + +module Sound.ALSA.Sequencer.Marshal.Event where + +#include + +import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr +import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue +import qualified Sound.ALSA.Sequencer.Marshal.RealTime as RealTime + +import Foreign.C.Types (CUInt, ) +import Foreign.Storable + (Storable, sizeOf, alignment, peek, poke, pokeByteOff, peekByteOff, ) +import Foreign.Ptr (Ptr, castPtr, nullPtr, plusPtr, ) +import Foreign.Marshal.Alloc (alloca, ) +import Data.Bits ((.|.), (.&.), ) +import Data.Int (Int16, Int32, ) +import Data.Word (Word8, Word16, Word32, ) +import Data.Array (Array, (!), accumArray, ) + + +data Connect = Connect + { connSource :: !Addr.T + , connDest :: !Addr.T + } deriving (Show,Eq,Ord) + +instance Storable Connect where + sizeOf _ = #size snd_seq_connect_t + alignment _ = 4 -- XXX + peek p = do s <- #{peek snd_seq_connect_t, sender} p + d <- #{peek snd_seq_connect_t, dest} p + return Connect { connSource = s, connDest = d } + poke p v = #{poke snd_seq_connect_t, sender} p (connSource v) + >> #{poke snd_seq_connect_t, dest} p (connDest v) + + +data TimeStamp = TickTime !Word32 + | RealTime !RealTime.T + deriving Show + +peekTimestamp :: Word8 -> Ptr TimeStamp -> IO TimeStamp +peekTimestamp flags p = + case flags .&. #{const SND_SEQ_TIME_STAMP_MASK} of + { #{const SND_SEQ_TIME_STAMP_TICK} -> TickTime `fmap` peek (castPtr p) + ; _ -> RealTime `fmap` peek (castPtr p) + } + +pokeTimestamp :: Ptr TimeStamp -> TimeStamp -> IO Word8 +pokeTimestamp p ts = case ts of + TickTime t -> poke (castPtr p) t >> return #{const SND_SEQ_TIME_STAMP_TICK} + RealTime t -> poke (castPtr p) t >> return #{const SND_SEQ_TIME_STAMP_REAL} + + + +newtype InstrCluster = InstrCluster CUInt + deriving (Show,Eq,Ord,Num,Enum,Storable) + +data Instr = Instr + { instrCluster :: !InstrCluster + -- XXX: perhaps use Sample? + , instrStd :: !Word32 + , instrBank :: !Word16 + , instrPrg :: !Word16 + } deriving (Show) + +{- +instance Storable Instr where + sizeOf _ = #{size snd_seq_instr_t} + alignment _ = 4 -- XXX + peek p = do cl <- #{peek snd_seq_instr_t, cluster} p + st <- #{peek snd_seq_instr_t, std} p + ba <- #{peek snd_seq_instr_t, bank} p + pr <- #{peek snd_seq_instr_t, prg} p + return Instr { instr_cluster = cl + , instr_std = st + , instr_bank = ba + , instr_prg = pr + } + poke p v = #{poke snd_seq_instr_t, cluster} p (instr_cluster v) + >> #{poke snd_seq_instr_t, std} p (instr_std v) + >> #{poke snd_seq_instr_t, bank} p (instr_bank v) + >> #{poke snd_seq_instr_t, prg} p (instr_prg v) +-} + + +data Note = Note + { noteChannel :: !Word8 + , noteNote :: !Word8 + , noteVelocity :: !Word8 + , noteOffVelocity :: !Word8 + , noteDuration :: !Word32 + } deriving (Show) + + +instance Storable Note where + sizeOf _ = #{size snd_seq_ev_note_t} + alignment _ = 4 -- XXX + peek p = do c <- #{peek snd_seq_ev_note_t, channel} p + n <- #{peek snd_seq_ev_note_t, note} p + v <- #{peek snd_seq_ev_note_t, velocity} p + ov <- #{peek snd_seq_ev_note_t, off_velocity} p + d <- #{peek snd_seq_ev_note_t, duration} p + return Note { noteChannel = c + , noteNote = n + , noteVelocity = v + , noteOffVelocity = ov + , noteDuration = d + } + poke p v = #{poke snd_seq_ev_note_t, channel} p (noteChannel v) + >> #{poke snd_seq_ev_note_t, note} p (noteNote v) + >> #{poke snd_seq_ev_note_t, velocity} p (noteVelocity v) + >> #{poke snd_seq_ev_note_t, off_velocity} p (noteOffVelocity v) + >> #{poke snd_seq_ev_note_t, duration} p (noteDuration v) + + +data Ctrl = Ctrl + { ctrlChannel :: !Word8 + , ctrlParam :: !Word32 + , ctrlValue :: !Int32 + } deriving (Show) + +instance Storable Ctrl where + sizeOf _ = #{size snd_seq_ev_ctrl_t} + alignment _ = 4 -- XXX + peek p = do ct <- #{peek snd_seq_ev_ctrl_t, channel} p + pa <- #{peek snd_seq_ev_ctrl_t, param} p + va <- #{peek snd_seq_ev_ctrl_t, value} p + return Ctrl { ctrlChannel = ct + , ctrlParam = pa + , ctrlValue = va + } + poke p v = #{poke snd_seq_ev_ctrl_t, channel} p (ctrlChannel v) + >> #{poke snd_seq_ev_ctrl_t, param} p (ctrlParam v) + >> #{poke snd_seq_ev_ctrl_t, value} p (ctrlValue v) + + + +data Sample = Sample + { sampleStd :: !Word32 + , sampleBank :: !Word16 + , samplePrg :: !Word16 + } deriving (Show) + +{- +instance Storable Sample where + sizeOf _ = #{size snd_seq_ev_sample_t} + alignment _ = 4 -- XXX + peek p = do st <- #{peek snd_seq_ev_sample_t, std} p + ba <- #{peek snd_seq_ev_sample_t, bank} p + pr <- #{peek snd_seq_ev_sample_t, prg} p + return Sample { sample_std = st + , sample_bank = ba + , sample_prg = pr + } + poke p v = #{poke snd_seq_ev_sample_t, std} p (sampleStd v) + >> #{poke snd_seq_ev_sample_t, bank} p (sampleBank v) + >> #{poke snd_seq_ev_sample_t, prg} p (samplePrg v) +-} + + +newtype Cluster = Cluster + { clusterCluster :: InstrCluster + } deriving (Show, Eq, Storable) + + +-- | These are all 14 bit values. +data Volume = Volume + { volumeVolume :: !Int16 + , volumeLR :: !Int16 + , volumeFR :: !Int16 + , volumeDU :: !Int16 + } deriving (Show) + +{- +instance Storable Volume where + sizeOf _ = #{size snd_seq_ev_volume_t} + alignment _ = 4 -- XXX + peek p = do v <- #{peek snd_seq_ev_volume_t, volume} p + l <- #{peek snd_seq_ev_volume_t, lr} p + f <- #{peek snd_seq_ev_volume_t, fr} p + d <- #{peek snd_seq_ev_volume_t, du} p + return Volume { volume_volume = v + , volume_lr = l + , volume_fr = f + , volume_du = d + } + poke p v = #{poke snd_seq_ev_volume_t, volume} p (volumeVolume v) + >> #{poke snd_seq_ev_volume_t, lr} p (volumeLR v) + >> #{poke snd_seq_ev_volume_t, fr} p (volumeFR v) + >> #{poke snd_seq_ev_volume_t, du} p (volumeDU v) +-} + + +data Custom = Custom { custom0, custom1, custom2 :: !Word32 } + deriving (Show) + +instance Storable Custom where + sizeOf _ = #{size snd_seq_ev_raw32_t} + alignment _ = 4 -- XXX + peek p = do d0 <- #{peek snd_seq_ev_raw32_t, d[0]} p + d1 <- #{peek snd_seq_ev_raw32_t, d[1]} p + d2 <- #{peek snd_seq_ev_raw32_t, d[2]} p + return Custom { custom0 = d0 + , custom1 = d1 + , custom2 = d2 + } + poke p v = #{poke snd_seq_ev_raw32_t, d[0]} p (custom0 v) + >> #{poke snd_seq_ev_raw32_t, d[1]} p (custom1 v) + >> #{poke snd_seq_ev_raw32_t, d[2]} p (custom2 v) + + + +data T = Cons + { highPriority :: !Bool + , tag :: !Word8 + , queue :: !Queue.T + , timestamp :: !TimeStamp + , source :: !Addr.T + , dest :: !Addr.T + , body :: !Data + } deriving Show + +instance Storable T where + sizeOf _ = #{size snd_seq_event_t} + alignment _ = 4 -- XXX + peek p = + do ty <- #{peek snd_seq_event_t, type} p + flags <- #{peek snd_seq_event_t, flags} p + tg <- #{peek snd_seq_event_t, tag} p + q <- #{peek snd_seq_event_t, queue} p + time <- peekTimestamp flags (#{ptr snd_seq_event_t, time} p) + src <- #{peek snd_seq_event_t, source} p + dst <- #{peek snd_seq_event_t, dest} p + d <- (peekData ! ty) (#{ptr snd_seq_event_t, data} p) + return Cons + { highPriority = (flags .&. #{const SND_SEQ_PRIORITY_MASK}) /= 0 + , tag = tg + , queue = q + , timestamp = time + , source = src + , dest = dst + , body = d + } + poke p e = do + { ty <- pokeData (#{ptr snd_seq_event_t, data} p) (body e) + ; #{poke snd_seq_event_t, type} p ty + ; #{poke snd_seq_event_t, tag} p (tag e) + ; #{poke snd_seq_event_t, queue} p (queue e) + ; real <- pokeTimestamp (#{ptr snd_seq_event_t, time} p) (timestamp e) + ; #{poke snd_seq_event_t, source} p (source e) + ; #{poke snd_seq_event_t, dest} p (dest e) + ; let flags = (if highPriority e + then #{const SND_SEQ_PRIORITY_HIGH} + else #{const SND_SEQ_PRIORITY_NORMAL}) + .|. real + .|. #{const SND_SEQ_EVENT_LENGTH_FIXED} -- XXX + ; #{poke snd_seq_event_t, flags} p flags + } + +allocaEv :: T -> (Ptr T -> IO a) -> IO a +allocaEv e h = alloca (\p -> poke p e >> h p) + +allocaMaybeEv :: Maybe T -> (Ptr T -> IO a) -> IO a +allocaMaybeEv me h = + maybe (h nullPtr) (\e -> allocaEv e h) me + +pokeData :: Ptr Data -> Data -> IO Word8 +pokeData p dt = case dt of + NoteEv e d -> poke (castPtr p) d >> return (expNoteEv e) + CtrlEv e d -> poke (castPtr p) d >> return (expCtrlEv e) + AddrEv e d -> poke (castPtr p) d >> return (expAddrEv e) + ConnEv e d -> poke (castPtr p) d >> return (expConnEv e) + CustomEv e d -> poke (castPtr p) d >> return (expCustomEv e) + EmptyEv e -> return (expEmptyEv e) + + +peekData :: Array Word8 (Ptr Data -> IO Data) +peekData = accumArray (const id) unknown (0,255) + [ -- result events (2) + (#{const SND_SEQ_EVENT_SYSTEM}, unknown) + , (#{const SND_SEQ_EVENT_RESULT}, unknown) + + -- note events (4) + , (#{const SND_SEQ_EVENT_NOTE}, peekNoteEv ANote) + , (#{const SND_SEQ_EVENT_NOTEON}, peekNoteEv NoteOn) + , (#{const SND_SEQ_EVENT_NOTEOFF}, peekNoteEv NoteOff) + , (#{const SND_SEQ_EVENT_KEYPRESS}, peekNoteEv KeyPress) + + -- control events (12) + , (#{const SND_SEQ_EVENT_CONTROLLER}, peekCtrlEv Controller) + , (#{const SND_SEQ_EVENT_PGMCHANGE}, peekCtrlEv PgmChange) + , (#{const SND_SEQ_EVENT_CHANPRESS}, peekCtrlEv ChanPress) + , (#{const SND_SEQ_EVENT_PITCHBEND}, peekCtrlEv PitchBend) + , (#{const SND_SEQ_EVENT_CONTROL14}, peekCtrlEv Control14) + , (#{const SND_SEQ_EVENT_NONREGPARAM}, peekCtrlEv NonRegParam) + , (#{const SND_SEQ_EVENT_REGPARAM}, peekCtrlEv RegParam) + , (#{const SND_SEQ_EVENT_SONGPOS}, peekCtrlEv SongPos) + , (#{const SND_SEQ_EVENT_SONGSEL}, peekCtrlEv SongSel) + , (#{const SND_SEQ_EVENT_QFRAME}, peekCtrlEv QFrame) + , (#{const SND_SEQ_EVENT_TIMESIGN}, peekCtrlEv TimeSign) + , (#{const SND_SEQ_EVENT_KEYSIGN}, peekCtrlEv KeySign) + + -- queue control (10) + , (#{const SND_SEQ_EVENT_START}, unknown) + , (#{const SND_SEQ_EVENT_CONTINUE}, unknown) + , (#{const SND_SEQ_EVENT_STOP}, unknown) + , (#{const SND_SEQ_EVENT_SETPOS_TICK}, unknown) + , (#{const SND_SEQ_EVENT_SETPOS_TIME}, unknown) + , (#{const SND_SEQ_EVENT_TEMPO}, unknown) + , (#{const SND_SEQ_EVENT_CLOCK}, unknown) + , (#{const SND_SEQ_EVENT_TICK}, unknown) + , (#{const SND_SEQ_EVENT_QUEUE_SKEW}, unknown) + , (#{const SND_SEQ_EVENT_SYNC_POS}, unknown) + + -- misc (3) + , (#{const SND_SEQ_EVENT_TUNE_REQUEST}, peekEmptyEv TuneRequest) + , (#{const SND_SEQ_EVENT_RESET}, peekEmptyEv Reset) + , (#{const SND_SEQ_EVENT_SENSING}, peekEmptyEv Sensing) + + , (#{const SND_SEQ_EVENT_ECHO}, peekCustomEv Echo) + , (#{const SND_SEQ_EVENT_OSS}, peekCustomEv OSS) + + -- networking (8) + , (#{const SND_SEQ_EVENT_CLIENT_START}, peekAddrEv ClientStart) + , (#{const SND_SEQ_EVENT_CLIENT_EXIT}, peekAddrEv ClientExit) + , (#{const SND_SEQ_EVENT_CLIENT_CHANGE}, peekAddrEv ClientChange) + , (#{const SND_SEQ_EVENT_PORT_START}, peekAddrEv PortStart) + , (#{const SND_SEQ_EVENT_PORT_EXIT}, peekAddrEv PortExit) + , (#{const SND_SEQ_EVENT_PORT_CHANGE}, peekAddrEv PortChange) + , (#{const SND_SEQ_EVENT_PORT_SUBSCRIBED}, peekConnEv PortSubscribed) + , (#{const SND_SEQ_EVENT_PORT_UNSUBSCRIBED}, peekConnEv PortUnsubscribed) + +{- + , (#{const SND_SEQ_EVENT_SAMPLE}, unknown) + , (#{const SND_SEQ_EVENT_SAMPLE_CLUSTER}, unknown) + , (#{const SND_SEQ_EVENT_SAMPLE_START}, unknown) + , (#{const SND_SEQ_EVENT_SAMPLE_STOP}, unknown) + , (#{const SND_SEQ_EVENT_SAMPLE_FREQ}, unknown) + , (#{const SND_SEQ_EVENT_SAMPLE_VOLUME}, unknown) + , (#{const SND_SEQ_EVENT_SAMPLE_LOOP}, unknown) + , (#{const SND_SEQ_EVENT_SAMPLE_POSITION}, unknown) + , (#{const SND_SEQ_EVENT_SAMPLE_PRIVATE1}, unknown) +-} + , (#{const SND_SEQ_EVENT_USR0}, peekCustomEv User0) + , (#{const SND_SEQ_EVENT_USR1}, peekCustomEv User1) + , (#{const SND_SEQ_EVENT_USR2}, peekCustomEv User2) + , (#{const SND_SEQ_EVENT_USR3}, peekCustomEv User3) + , (#{const SND_SEQ_EVENT_USR4}, peekCustomEv User4) + , (#{const SND_SEQ_EVENT_USR5}, peekCustomEv User5) + , (#{const SND_SEQ_EVENT_USR6}, peekCustomEv User6) + , (#{const SND_SEQ_EVENT_USR7}, peekCustomEv User7) + , (#{const SND_SEQ_EVENT_USR8}, peekCustomEv User8) + , (#{const SND_SEQ_EVENT_USR9}, peekCustomEv User9) + +{- + , (#{const SND_SEQ_EVENT_INSTR_BEGIN}, unknown) + , (#{const SND_SEQ_EVENT_INSTR_END}, unknown) + , (#{const SND_SEQ_EVENT_INSTR_INFO}, unknown) + , (#{const SND_SEQ_EVENT_INSTR_INFO_RESULT}, unknown) + , (#{const SND_SEQ_EVENT_INSTR_FINFO}, unknown) + , (#{const SND_SEQ_EVENT_INSTR_FINFO_RESULT}, unknown) + , (#{const SND_SEQ_EVENT_INSTR_RESET}, unknown) + , (#{const SND_SEQ_EVENT_INSTR_STATUS}, unknown) + , (#{const SND_SEQ_EVENT_INSTR_STATUS_RESULT}, unknown) + , (#{const SND_SEQ_EVENT_INSTR_PUT}, unknown) + , (#{const SND_SEQ_EVENT_INSTR_GET}, unknown) + , (#{const SND_SEQ_EVENT_INSTR_GET_RESULT}, unknown) + , (#{const SND_SEQ_EVENT_INSTR_FREE}, unknown) + , (#{const SND_SEQ_EVENT_INSTR_LIST}, unknown) + , (#{const SND_SEQ_EVENT_INSTR_LIST_RESULT}, unknown) + , (#{const SND_SEQ_EVENT_INSTR_CLUSTER}, unknown) + , (#{const SND_SEQ_EVENT_INSTR_CLUSTER_GET}, unknown) + , (#{const SND_SEQ_EVENT_INSTR_CLUSTER_RESULT}, unknown) + , (#{const SND_SEQ_EVENT_INSTR_CHANGE}, unknown) +-} + + , (#{const SND_SEQ_EVENT_SYSEX}, unknown) + , (#{const SND_SEQ_EVENT_BOUNCE}, unknown) + + , (#{const SND_SEQ_EVENT_USR_VAR0}, unknown) + , (#{const SND_SEQ_EVENT_USR_VAR1}, unknown) + , (#{const SND_SEQ_EVENT_USR_VAR2}, unknown) + , (#{const SND_SEQ_EVENT_USR_VAR3}, unknown) + , (#{const SND_SEQ_EVENT_USR_VAR3}, unknown) + + , (#{const SND_SEQ_EVENT_NONE}, peekEmptyEv None) + ] + + where unknown = peekEmptyEv Unknown + + +data NoteEv = ANote | NoteOn | NoteOff | KeyPress + deriving Show + +data CtrlEv = Controller | PgmChange | ChanPress + | PitchBend | Control14 + | NonRegParam | RegParam + | SongPos | SongSel + | QFrame + | TimeSign | KeySign + deriving Show + +data QueueEv = QueueStart + | QueueContinue + | QueueStop + | QueueSetPosTick + | QueueSetPosTime + | QueueTempo + | QueueClock + | QueueTick + | QueueSkew + | QueueSyncPos + deriving Show + +data EmptyEv = TuneRequest | Reset | Sensing | None | Unknown + deriving Show + +data CustomEv = Echo | OSS + | User0 | User1 | User2 | User3 | User4 + | User5 | User6 | User7 | User8 | User9 + deriving Show + +data AddrEv = ClientStart | ClientExit | ClientChange + | PortStart | PortExit | PortChange + deriving Show + +data ConnEv = PortSubscribed | PortUnsubscribed + deriving Show + + +expNoteEv :: NoteEv -> Word8 +expNoteEv e = case e of + ANote -> #{const SND_SEQ_EVENT_NOTE} + NoteOn -> #{const SND_SEQ_EVENT_NOTEON} + NoteOff -> #{const SND_SEQ_EVENT_NOTEOFF} + KeyPress -> #{const SND_SEQ_EVENT_KEYPRESS} + +expCtrlEv :: CtrlEv -> Word8 +expCtrlEv e = case e of + Controller -> #{const SND_SEQ_EVENT_CONTROLLER} + PgmChange -> #{const SND_SEQ_EVENT_PGMCHANGE} + ChanPress -> #{const SND_SEQ_EVENT_CHANPRESS} + PitchBend -> #{const SND_SEQ_EVENT_PITCHBEND} + Control14 -> #{const SND_SEQ_EVENT_CONTROL14} + NonRegParam -> #{const SND_SEQ_EVENT_NONREGPARAM} + RegParam -> #{const SND_SEQ_EVENT_REGPARAM} + SongPos -> #{const SND_SEQ_EVENT_SONGPOS} + SongSel -> #{const SND_SEQ_EVENT_SONGSEL} + QFrame -> #{const SND_SEQ_EVENT_QFRAME} + TimeSign -> #{const SND_SEQ_EVENT_TIMESIGN} + KeySign -> #{const SND_SEQ_EVENT_KEYSIGN} + +expQueueEv :: QueueEv -> Word8 +expQueueEv e = case e of + QueueStart -> #{const SND_SEQ_EVENT_START} + QueueContinue -> #{const SND_SEQ_EVENT_CONTINUE} + QueueStop -> #{const SND_SEQ_EVENT_STOP} + QueueSetPosTick -> #{const SND_SEQ_EVENT_SETPOS_TICK} + QueueSetPosTime -> #{const SND_SEQ_EVENT_SETPOS_TIME} + QueueTempo -> #{const SND_SEQ_EVENT_TEMPO} + QueueClock -> #{const SND_SEQ_EVENT_CLOCK} + QueueTick -> #{const SND_SEQ_EVENT_TICK} + QueueSkew -> #{const SND_SEQ_EVENT_QUEUE_SKEW} + QueueSyncPos -> #{const SND_SEQ_EVENT_SYNC_POS} + +expEmptyEv :: EmptyEv -> Word8 +expEmptyEv e = case e of + TuneRequest -> #{const SND_SEQ_EVENT_TUNE_REQUEST} + Reset -> #{const SND_SEQ_EVENT_RESET} + Sensing -> #{const SND_SEQ_EVENT_SENSING} + None -> #{const SND_SEQ_EVENT_NONE} + Unknown -> #{const SND_SEQ_EVENT_NONE} + +expCustomEv :: CustomEv -> Word8 +expCustomEv e = case e of + Echo -> #{const SND_SEQ_EVENT_ECHO} + OSS -> #{const SND_SEQ_EVENT_OSS} + User0 -> #{const SND_SEQ_EVENT_USR0} + User1 -> #{const SND_SEQ_EVENT_USR1} + User2 -> #{const SND_SEQ_EVENT_USR2} + User3 -> #{const SND_SEQ_EVENT_USR3} + User4 -> #{const SND_SEQ_EVENT_USR4} + User5 -> #{const SND_SEQ_EVENT_USR5} + User6 -> #{const SND_SEQ_EVENT_USR6} + User7 -> #{const SND_SEQ_EVENT_USR7} + User8 -> #{const SND_SEQ_EVENT_USR8} + User9 -> #{const SND_SEQ_EVENT_USR9} + +expAddrEv :: AddrEv -> Word8 +expAddrEv e = case e of + ClientStart -> #{const SND_SEQ_EVENT_CLIENT_START} + ClientExit -> #{const SND_SEQ_EVENT_CLIENT_EXIT} + ClientChange -> #{const SND_SEQ_EVENT_CLIENT_CHANGE} + PortStart -> #{const SND_SEQ_EVENT_PORT_START} + PortExit -> #{const SND_SEQ_EVENT_PORT_EXIT} + PortChange -> #{const SND_SEQ_EVENT_PORT_CHANGE} + +expConnEv :: ConnEv -> Word8 +expConnEv e = case e of + PortSubscribed -> #{const SND_SEQ_EVENT_PORT_SUBSCRIBED} + PortUnsubscribed -> #{const SND_SEQ_EVENT_PORT_UNSUBSCRIBED} + + +peekNoteEv :: NoteEv -> Ptr Data -> IO Data +peekNoteEv e p = NoteEv e `fmap` peek (castPtr p) + +peekCtrlEv :: CtrlEv -> Ptr Data -> IO Data +peekCtrlEv e p = CtrlEv e `fmap` peek (castPtr p) + +peekAddrEv :: AddrEv -> Ptr Data -> IO Data +peekAddrEv e p = AddrEv e `fmap` peek (castPtr p) + +peekConnEv :: ConnEv -> Ptr Data -> IO Data +peekConnEv e p = ConnEv e `fmap` peek (castPtr p) + +peekEmptyEv :: EmptyEv -> Ptr Data -> IO Data +peekEmptyEv e _ = return (EmptyEv e) + +peekCustomEv :: CustomEv -> Ptr Data -> IO Data +peekCustomEv e p = CustomEv e `fmap` peek (castPtr p) + + +data Data + = NoteEv NoteEv Note + | CtrlEv CtrlEv Ctrl + | AddrEv AddrEv Addr.T + | ConnEv ConnEv Connect + | EmptyEv EmptyEv + | CustomEv CustomEv Custom + deriving Show diff --git a/src/Sound/ALSA/Sequencer/Marshal/Port.hsc b/src/Sound/ALSA/Sequencer/Marshal/Port.hsc new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Marshal/Port.hsc @@ -0,0 +1,96 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Sound.ALSA.Sequencer.Marshal +-- Copyright : (c) Henning Thielemann, 2010 +-- (c) Iavor S. Diatchki, 2007 +-- License : BSD3 +-- +-- Maintainer: Henning Thielemann +-- Stability : provisional +-- +-- PRIVATE MODULE. +-- +-- Here we have the various types used by the library, +-- and how they are imported\/exported to C. +-- +-- NOTE: In the translations bellow we make the following assumptions +-- about the sizes of C types. +-- CChar = 8 bits +-- CShort = 16 bit +-- CInt = 32 bits +-------------------------------------------------------------------------------- + +module Sound.ALSA.Sequencer.Marshal.Port where + +#include +import qualified Sound.ALSA.Sequencer.Utility as U +import Foreign.C.Types (CInt, CUInt, ) +import Foreign.Storable (Storable, ) +import Data.Bits ((.|.), ) +import Data.Word (Word8, ) + + + +-- The type of client ports. +newtype T = Cons Word8 deriving (Eq, Ord, Storable) + +instance Show T where + showsPrec prec (Cons x) = + U.showsRecord prec "Port" [U.showsField x] + + +exp :: T -> CInt +exp (Cons p) = fromIntegral p + +imp :: CInt -> T +imp p = Cons (fromIntegral p) + + +-- | Port capabilities. +newtype Cap = Cap { unCap :: CUInt } deriving (Eq,Ord) + +-- | Port types. +newtype Type = Type { unType :: CUInt } deriving (Eq,Ord) + +#{enum T, Cons + , systemTimer = SND_SEQ_PORT_SYSTEM_TIMER + , systemAnnounce = SND_SEQ_PORT_SYSTEM_ANNOUNCE + , unknown = SND_SEQ_ADDRESS_UNKNOWN + } + +#{enum Cap, Cap + , capRead = SND_SEQ_PORT_CAP_READ + , capWrite = SND_SEQ_PORT_CAP_WRITE + , capSyncRead = SND_SEQ_PORT_CAP_SYNC_READ + , capSyncWrite = SND_SEQ_PORT_CAP_SYNC_WRITE + , capDuplex = SND_SEQ_PORT_CAP_DUPLEX + , capSubsRead = SND_SEQ_PORT_CAP_SUBS_READ + , capSubsWrite = SND_SEQ_PORT_CAP_SUBS_WRITE + , capNoExport = SND_SEQ_PORT_CAP_NO_EXPORT + } + +caps :: [Cap] -> Cap +caps cs = Cap (foldl (.|.) 0 (map unCap cs)) + +#{enum Type, Type + , typeSpecific = SND_SEQ_PORT_TYPE_SPECIFIC + , typeMidiGeneric = SND_SEQ_PORT_TYPE_MIDI_GENERIC + , typeMidiGM = SND_SEQ_PORT_TYPE_MIDI_GM + , typeMidiGS = SND_SEQ_PORT_TYPE_MIDI_GS + , typeMidiXG = SND_SEQ_PORT_TYPE_MIDI_XG + , typeMidiMT32 = SND_SEQ_PORT_TYPE_MIDI_MT32 + , typeMidiGM2 = SND_SEQ_PORT_TYPE_MIDI_GM2 + + , typeSynth = SND_SEQ_PORT_TYPE_SYNTH + , typeDirectSample = SND_SEQ_PORT_TYPE_DIRECT_SAMPLE + , typeSample = SND_SEQ_PORT_TYPE_SAMPLE + + , typeHardware = SND_SEQ_PORT_TYPE_HARDWARE + , typeSoftware = SND_SEQ_PORT_TYPE_SOFTWARE + , typeSynthesizer = SND_SEQ_PORT_TYPE_SYNTHESIZER + , typePort = SND_SEQ_PORT_TYPE_PORT + , typeApplication = SND_SEQ_PORT_TYPE_APPLICATION + } + +types :: [Type] -> Type +types cs = Type (foldl (.|.) 0 (map unType cs)) diff --git a/src/Sound/ALSA/Sequencer/Marshal/Queue.hsc b/src/Sound/ALSA/Sequencer/Marshal/Queue.hsc new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Marshal/Queue.hsc @@ -0,0 +1,49 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Sound.ALSA.Sequencer.Marshal.Queue +-- Copyright : (c) Henning Thielemann, 2010 +-- (c) Iavor S. Diatchki, 2007 +-- License : BSD3 +-- +-- Maintainer: Henning Thielemann +-- Stability : provisional +-- +-- PRIVATE MODULE. +-- +-- Here we have the various types used by the library, +-- and how they are imported\/exported to C. +-- +-- NOTE: In the translations bellow we make the following assumptions +-- about the sizes of C types. +-- CChar = 8 bits +-- CShort = 16 bit +-- CInt = 32 bits +-------------------------------------------------------------------------------- + +module Sound.ALSA.Sequencer.Marshal.Queue where + +#include +import qualified Sound.ALSA.Sequencer.Utility as U +import Foreign.C.Types (CInt, ) +import Foreign.Storable (Storable, ) +import Data.Word (Word8, ) + + + + +-- | The type of queue identifiers. +newtype T = Cons Word8 deriving (Eq, Ord, Storable) + +instance Show T where + showsPrec prec (Cons x) = + U.showsRecord prec "Queue" [U.showsField x] + +imp :: CInt -> T +imp x = Cons (fromIntegral x) + +exp :: T -> CInt +exp (Cons x) = fromIntegral x + +#{enum T, Cons + , direct = SND_SEQ_QUEUE_DIRECT + } diff --git a/src/Sound/ALSA/Sequencer/Marshal/QueueTimer.hsc b/src/Sound/ALSA/Sequencer/Marshal/QueueTimer.hsc new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Marshal/QueueTimer.hsc @@ -0,0 +1,46 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Sound.ALSA.Sequencer.Marshal.QueueTimer +-- Copyright : (c) Henning Thielemann, 2010 +-- (c) Iavor S. Diatchki, 2007 +-- License : BSD3 +-- +-- Maintainer: Henning Thielemann +-- Stability : provisional +-- +-- PRIVATE MODULE. +-- +-- Here we have the various types used by the library, +-- and how they are imported\/exported to C. +-- +-- NOTE: In the translations bellow we make the following assumptions +-- about the sizes of C types. +-- CChar = 8 bits +-- CShort = 16 bit +-- CInt = 32 bits +-------------------------------------------------------------------------------- + +module Sound.ALSA.Sequencer.Marshal.QueueTimer where + +#include +import Foreign.C.Types (CInt, ) + + +data Type = + Alsa + | MidiClock + | MidiTick + deriving (Show, Eq, Ord, Enum) + +expType :: Type -> CInt +expType t = case t of + Alsa -> #{const SND_SEQ_TIMER_ALSA} + MidiClock -> #{const SND_SEQ_TIMER_MIDI_CLOCK} + MidiTick -> #{const SND_SEQ_TIMER_MIDI_TICK} + +impType :: CInt -> Type +impType t = case t of + #{const SND_SEQ_TIMER_ALSA} -> Alsa + #{const SND_SEQ_TIMER_MIDI_CLOCK} -> MidiClock + #{const SND_SEQ_TIMER_MIDI_TICK} -> MidiTick + _ -> error ("QueueTimer.impType: unknown timer type (" ++ show t ++ ")") diff --git a/src/Sound/ALSA/Sequencer/Marshal/RealTime.hsc b/src/Sound/ALSA/Sequencer/Marshal/RealTime.hsc new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Marshal/RealTime.hsc @@ -0,0 +1,29 @@ +module Sound.ALSA.Sequencer.Marshal.RealTime where + +#include + +import qualified Sound.ALSA.Sequencer.Utility as U + +import Foreign.Storable + (Storable, sizeOf, alignment, peek, poke, pokeByteOff, peekByteOff, ) +import Data.Word (Word32, ) + + +data T = Cons + { secs :: !Word32 + , nano :: !Word32 + } + +instance Show T where + showsPrec prec (Cons s n) = + U.showsRecord prec "RealTime" [U.showsField s, U.showsField n] + + +instance Storable T where + sizeOf _ = #{size snd_seq_real_time_t} + alignment _ = 4 -- XXX + peek p = do s <- #{peek snd_seq_real_time_t, tv_sec} p + n <- #{peek snd_seq_real_time_t, tv_nsec} p + return Cons { secs = s, nano = n } + poke p v = #{poke snd_seq_real_time_t, tv_sec} p (secs v) + >> #{poke snd_seq_real_time_t, tv_nsec} p (nano v) diff --git a/src/Sound/ALSA/Sequencer/Marshal/Sequencer.hsc b/src/Sound/ALSA/Sequencer/Marshal/Sequencer.hsc new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Marshal/Sequencer.hsc @@ -0,0 +1,65 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Sound.ALSA.Sequencer.Marshal.Sequencer +-- Copyright : (c) Henning Thielemann, 2010 +-- (c) Iavor S. Diatchki, 2007 +-- License : BSD3 +-- +-- Maintainer: Henning Thielemann +-- Stability : provisional +-- +-- PRIVATE MODULE. +-- +-- Here we have the various types used by the library, +-- and how they are imported\/exported to C. +-- +-- NOTE: In the translations bellow we make the following assumptions +-- about the sizes of C types. +-- CChar = 8 bits +-- CShort = 16 bit +-- CInt = 32 bits +-------------------------------------------------------------------------------- + +module Sound.ALSA.Sequencer.Marshal.Sequencer where + +#include +import Foreign.C.Types (CInt, ) +import Foreign.Ptr (Ptr, ) + + +-- | Read\/Write permissions for the sequencer device. +-- This way we prevent the ALSA exception 22 "Invalid argument" +-- when calling @event_output@ on an input-only sequencer. +class OpenMode mode where expOpenMode :: mode -> CInt + +class OpenMode mode => AllowInput mode where +class OpenMode mode => AllowOutput mode where + +data OutputMode = OutputMode deriving (Show) +data InputMode = InputMode deriving (Show) +data DuplexMode = DuplexMode deriving (Show) + +instance OpenMode OutputMode where expOpenMode _ = #{const SND_SEQ_OPEN_OUTPUT} +instance OpenMode InputMode where expOpenMode _ = #{const SND_SEQ_OPEN_INPUT} +instance OpenMode DuplexMode where expOpenMode _ = #{const SND_SEQ_OPEN_DUPLEX} + +instance AllowOutput OutputMode where +instance AllowOutput DuplexMode where +instance AllowInput InputMode where +instance AllowInput DuplexMode where + + +-- | Blocking behavior of the sequencer device. +data BlockMode = Block -- ^ Operations may block. + | Nonblock -- ^ Throw exceptions instead of blocking. + deriving (Show,Eq) + +expBlockMode :: BlockMode -> CInt +expBlockMode x = case x of + Block -> 0 + Nonblock -> #{const SND_SEQ_NONBLOCK} + + +-- | The type of sequencer handles. +newtype T mode = Cons (Ptr Core) deriving Eq +data Core diff --git a/src/Sound/ALSA/Sequencer/Port.hs b/src/Sound/ALSA/Sequencer/Port.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Port.hs @@ -0,0 +1,122 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Sound.ALSA.Sequencer.Port +-- Copyright : (c) Henning Thielemann, 2010 +-- (c) Iavor S. Diatchki, 2007 +-- License : BSD3 +-- +-- Maintainer: Henning Thielemann +-- Stability : provisional +-- +-- This module contains functions for working with ports. +-- Reference: +-- +-------------------------------------------------------------------------------- + +module Sound.ALSA.Sequencer.Port + ( Port.T + , create + , createSimple + , delete + , deleteSimple + + , withSimple + + , Port.systemTimer + , Port.systemAnnounce + , Port.unknown + + , Port.Cap + , Port.capRead + , Port.capWrite + , Port.capSyncRead + , Port.capSyncWrite + , Port.capDuplex + , Port.capSubsRead + , Port.capSubsWrite + , Port.capNoExport + , Port.caps + + , Port.Type + , Port.typeSpecific + , Port.typeMidiGeneric + , Port.typeMidiGM + , Port.typeMidiGS + , Port.typeMidiXG + , Port.typeMidiMT32 + , Port.typeMidiGM2 + + , Port.typeSynth + , Port.typeDirectSample + , Port.typeSample + + , Port.typeHardware + , Port.typeSoftware + , Port.typeSynthesizer + , Port.typePort + , Port.typeApplication + , Port.types + + ) where + +import qualified Sound.ALSA.Sequencer.Marshal.Port as Port +import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq +import qualified Sound.ALSA.Exception as Exc +import Sound.ALSA.Sequencer.Area + +import Foreign.C.Types (CInt, CUInt, ) +import Foreign.C.String (CString, withCAString, ) +import Foreign.Ptr (Ptr, ) + +import Control.Exception (bracket, ) + + + +-------------------------------------------------------------------------------- + +-- | Create a port - simple version. +createSimple :: Seq.T mode -> String -> Port.Cap -> Port.Type -> IO Port.T +createSimple (Seq.Cons h) s (Port.Cap c) (Port.Type t) = + withCAString s $ \a -> + Port.imp `fmap` (Exc.checkResult "create_simple_port" =<< snd_seq_create_simple_port h a c t) + +foreign import ccall "alsa/asoundlib.h snd_seq_create_simple_port" + snd_seq_create_simple_port :: Ptr Seq.Core -> CString -> CUInt -> CUInt + -> IO CInt + + +-- | Delete the port. +deleteSimple :: Seq.T mode -> Port.T -> IO () +deleteSimple (Seq.Cons h) (Port.Cons p) = + Exc.checkResult_ "delete_simple_port" =<< snd_seq_delete_simple_port h (fromIntegral p) + +foreign import ccall "alsa/asoundlib.h snd_seq_delete_simple_port" + snd_seq_delete_simple_port :: Ptr Seq.Core -> CInt -> IO CInt + + +withSimple :: + Seq.T mode -> String -> Port.Cap -> Port.Type -> + (Port.T -> IO a) -> + IO a +withSimple ss s c t = + bracket (createSimple ss s c t) (deleteSimple ss) + + + +-------------------------------------------------------------------------------- + +-- | Create a new port, as described by the info structure. +create :: Seq.T mode -> PortInfo -> IO () +create (Seq.Cons h) p = + Exc.checkResult_ "create_port" =<< with_port_info p (snd_seq_create_port h) + +foreign import ccall "alsa/asoundlib.h snd_seq_create_port" + snd_seq_create_port :: Ptr Seq.Core -> Ptr PortInfo_ -> IO CInt + +-- | Delete the port. +delete :: Seq.T mode -> Port.T -> IO () +delete (Seq.Cons h) (Port.Cons p) = + Exc.checkResult_ "delete_port" =<< snd_seq_delete_port h (fromIntegral p) + +foreign import ccall "alsa/asoundlib.h snd_seq_delete_port" + snd_seq_delete_port :: Ptr Seq.Core -> CInt -> IO CInt diff --git a/src/Sound/ALSA/Sequencer/Port/Info.hs b/src/Sound/ALSA/Sequencer/Port/Info.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Port/Info.hs @@ -0,0 +1,206 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Sound.ALSA.Sequencer.Port +-- Copyright : (c) Henning Thielemann, 2010 +-- (c) Iavor S. Diatchki, 2007 +-- License : BSD3 +-- +-- Maintainer: Henning Thielemann +-- Stability : provisional +-- +-- This module contains functions for working with ports. +-- Reference: +-- +-------------------------------------------------------------------------------- + +module Sound.ALSA.Sequencer.Port.Info + ( T + + , get + , getAny + , queryFirst + , queryNext + , set + + , copy + , clone + + , getPort + , getClient + , getAddr + , getName + , getCapability + , getMidiChannels + , getMidiVoices + , getSynthVoices + , getPortSpecified + , getTimestamping + , getTimestampReal + , getTimestampQueue + + , getReadUse + , getWriteUse + + , setPort + , setClient + , setAddr + , setName + , setCapability + , setMidiChannels + , setSynthVoices + , setMidiVoices + , setPortSpecified + , setTimestamping + , setTimestampReal + , setTimestampQueue + ) where + +import qualified Sound.ALSA.Sequencer.Marshal.Client as Client +import qualified Sound.ALSA.Sequencer.Marshal.Port as Port +import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue +import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq +import qualified Sound.ALSA.Sequencer.Area as Area +import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr +import qualified Sound.ALSA.Exception as Exc + +import Foreign.C.Types (CInt, ) +import Foreign.Ptr (Ptr, ) +import Foreign.Marshal.Alloc (alloca, ) +import Foreign.Storable (poke, peek, ) +import Data.Word (Word, ) + + +type T = Area.PortInfo +type T_ = Area.PortInfo_ + + +-- | Create a new information area filled with data about a specific +-- port on our client. +get :: Seq.T mode -> Port.T -> IO T +get (Seq.Cons h) p = + do info <- Area.port_info_malloc + Exc.checkResult "get_port_info" =<< Area.with_port_info info (snd_seq_get_port_info h (Port.exp p)) + return info + +foreign import ccall "alsa/asoundlib.h snd_seq_get_port_info" + snd_seq_get_port_info :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt + + +-- | Create a new information area filled with data about an given +-- port on a given client. +getAny :: Seq.T mode -> Client.T -> Port.T -> IO T +getAny (Seq.Cons h) c p = + do info <- Area.port_info_malloc + Exc.checkResult "get_any_port_info" =<< Area.with_port_info info + (snd_seq_get_any_port_info h (Client.exp c) (Port.exp p)) + return info + +foreign import ccall "alsa/asoundlib.h snd_seq_get_any_port_info" + snd_seq_get_any_port_info + :: Ptr Seq.Core -> CInt -> CInt -> Ptr T_ -> IO CInt + +-- | Get information about the first port on our client. +queryFirst :: Seq.T mode -> IO T +queryFirst s = + do x <- Area.port_info_malloc + Area.with_port_info x (`Area.snd_seq_port_info_set_port` (-1)) + queryNext s x + return x + + +-- | Get information about the port with the next biggest identifier. +-- If a matching port is found, then its information is stored in the +-- given area, otherwise we throw an error. +queryNext :: Seq.T mode -> T -> IO () +queryNext (Seq.Cons h) info = + Exc.checkResult_ "query_next_port" =<< Area.with_port_info info (snd_seq_query_next_port h) + +foreign import ccall "alsa/asoundlib.h snd_seq_query_next_port" + snd_seq_query_next_port :: Ptr Seq.Core -> Ptr T_ -> IO CInt + +-- | Set the information for the sequencer port based on the data +-- in the given information area. +set :: Seq.T mode -> Port.T -> T -> IO () +set (Seq.Cons h) p info = + Exc.checkResult_ "set_port_info" =<< Area.with_port_info info (snd_seq_set_port_info h (Port.exp p)) + +foreign import ccall "alsa/asoundlib.h snd_seq_set_port_info" + snd_seq_set_port_info :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt + + + +-- | Get the address of the information area. +getAddr :: T -> IO Addr.T +getAddr i = + peek =<< Area.with_port_info i snd_seq_port_info_get_addr + +foreign import ccall "alsa/asoundlib.h snd_seq_port_info_get_addr" + snd_seq_port_info_get_addr :: Ptr T_ -> IO (Ptr Addr.T) + + +-- | Set the port address. +setAddr :: T -> Addr.T -> IO () +setAddr i c = + alloca $ \p -> poke p c >> Area.with_port_info i (`snd_seq_port_info_set_addr` p) + +foreign import ccall "alsa/asoundlib.h snd_seq_port_info_set_addr" + snd_seq_port_info_set_addr :: Ptr T_ -> Ptr Addr.T -> IO () + + + +copy :: T -> T -> IO () +clone :: T -> IO T +getPort :: T -> IO Port.T +getClient :: T -> IO Client.T +getName :: T -> IO String +getCapability :: T -> IO Port.Cap +getMidiChannels :: T -> IO Word +getMidiVoices :: T -> IO Word +getSynthVoices :: T -> IO Word +getPortSpecified :: T -> IO Bool +getTimestamping :: T -> IO Bool +getTimestampReal :: T -> IO Bool +getTimestampQueue :: T -> IO Queue.T +getReadUse :: T -> IO Word +getWriteUse :: T -> IO Word +setPort :: T -> Port.T -> IO () +setClient :: T -> Client.T -> IO () +setName :: T -> String -> IO () +setCapability :: T -> Port.Cap -> IO () +setMidiChannels :: T -> Word -> IO () +setSynthVoices :: T -> Word -> IO () +setMidiVoices :: T -> Word -> IO () +setPortSpecified :: T -> Bool -> IO () +setTimestamping :: T -> Bool -> IO () +setTimestampReal :: T -> Bool -> IO () +setTimestampQueue :: T -> Queue.T -> IO () + +copy = Area.port_info_copy +clone = Area.port_info_clone + +getPort = Area.port_info_get_port +getClient = Area.port_info_get_client +getName = Area.port_info_get_name +getCapability = Area.port_info_get_capability +getMidiChannels = Area.port_info_get_midi_channels +getMidiVoices = Area.port_info_get_midi_voices +getSynthVoices = Area.port_info_get_synth_voices +getPortSpecified = Area.port_info_get_port_specified +getTimestamping = Area.port_info_get_timestamping +getTimestampReal = Area.port_info_get_timestamp_real +getTimestampQueue = Area.port_info_get_timestamp_queue + +getReadUse = Area.port_info_get_read_use +getWriteUse = Area.port_info_get_write_use + +setPort = Area.port_info_set_port +setClient = Area.port_info_set_client +setName = Area.port_info_set_name +setCapability = Area.port_info_set_capability +setMidiChannels = Area.port_info_set_midi_channels +setSynthVoices = Area.port_info_set_synth_voices +setMidiVoices = Area.port_info_set_midi_voices +setPortSpecified = Area.port_info_set_port_specified +setTimestamping = Area.port_info_set_timestamping +setTimestampReal = Area.port_info_set_timestamp_real +setTimestampQueue = Area.port_info_set_timestamp_queue diff --git a/src/Sound/ALSA/Sequencer/Queue.hs b/src/Sound/ALSA/Sequencer/Queue.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Queue.hs @@ -0,0 +1,87 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Sound.ALSA.Sequencer.Queue +-- Copyright : (c) Henning Thielemann, 2010 +-- (c) Iavor S. Diatchki, 2007 +-- License : BSD3 +-- +-- Maintainer: Henning Thielemann +-- Stability : provisional +-- +-- This module contains functions for working with sequencer queue. +-- Reference: +-- +-------------------------------------------------------------------------------- + +module Sound.ALSA.Sequencer.Queue + ( -- * General Queue Functions + Queue.T + , Queue.direct + , alloc + , allocNamed + , free + , with + , withNamed + , control + + ) where + +import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq +import qualified Sound.ALSA.Sequencer.Marshal.Event as Event +import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue +import qualified Sound.ALSA.Exception as Exc + +import Foreign.Ptr (Ptr, ) +import Foreign.C.Types (CInt, ) +import Foreign.C.String (CString, withCAString, ) + +import Control.Exception (bracket, ) + + +alloc :: Seq.T mode -> IO Queue.T -- ^ Queue.T identifier. +alloc (Seq.Cons h) = + Queue.imp `fmap` (Exc.checkResult "alloc_queue" =<< snd_seq_alloc_queue h) + +foreign import ccall "alsa/asoundlib.h snd_seq_alloc_queue" + snd_seq_alloc_queue :: Ptr Seq.Core -> IO CInt + +with :: Seq.T mode -> (Queue.T -> IO a) -> IO a +with s = bracket (alloc s) (free s) + + +allocNamed :: Seq.T mode -> String -> IO Queue.T +allocNamed (Seq.Cons h) x = withCAString x $ \s -> + Queue.imp `fmap` (Exc.checkResult "alloc_named_queue" =<< snd_seq_alloc_named_queue h s) + +foreign import ccall "alsa/asoundlib.h snd_seq_alloc_named_queue" + snd_seq_alloc_named_queue :: Ptr Seq.Core -> CString -> IO CInt + +withNamed :: Seq.T mode -> String -> (Queue.T -> IO a) -> IO a +withNamed s nm = bracket (allocNamed s nm) (free s) + + +-- | Delete the specified queue. +free + :: Seq.T mode -- ^ Sequencer handle. + -> Queue.T -- ^ Queue.T identifier. + -> IO () +free (Seq.Cons h) q = + Exc.checkResult_ "free_queue" =<< snd_seq_free_queue h (Queue.exp q) + +foreign import ccall "alsa/asoundlib.h snd_seq_free_queue" + snd_seq_free_queue :: Ptr Seq.Core -> CInt -> IO CInt + + +-- | Queue.T controls - start/stop/continue +control + :: Seq.T mode -- ^ Sequencer handle. + -> Queue.T -- ^ Queue.T identifier. + -> Event.QueueEv + -> Int + -> Maybe Event.T + -> IO () +control (Seq.Cons h) q a b me = + Event.allocaMaybeEv me $ \p -> Exc.checkResult_ "control_queue" =<< snd_seq_control_queue h (Queue.exp q) (fromIntegral $ Event.expQueueEv a) (fromIntegral b) p + +foreign import ccall "alsa/asoundlib.h snd_seq_control_queue" + snd_seq_control_queue :: Ptr Seq.Core -> CInt -> CInt -> CInt -> Ptr Event.T -> IO CInt diff --git a/src/Sound/ALSA/Sequencer/Queue/Info.hs b/src/Sound/ALSA/Sequencer/Queue/Info.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Queue/Info.hs @@ -0,0 +1,95 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Sound.ALSA.Sequencer.Queue.Info +-- Copyright : (c) Henning Thielemann, 2010 +-- (c) Iavor S. Diatchki, 2007 +-- License : BSD3 +-- +-- Maintainer: Henning Thielemann +-- Stability : provisional +-- +-- This module contains functions for working with sequencer queue. +-- Reference: +-- +-------------------------------------------------------------------------------- + +module Sound.ALSA.Sequencer.Queue.Info + ( T + , get + , set + , copy + , clone + + , getQueue + , getName + , getLocked + , getOwner + , getFlags + + , setName + , setLocked + , setOwner + , setFlags + ) where + +import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq +import qualified Sound.ALSA.Sequencer.Marshal.Client as Client +import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue +import qualified Sound.ALSA.Sequencer.Area as Area +import qualified Sound.ALSA.Exception as Exc + +import Foreign.Ptr (Ptr, ) +import Foreign.C.Types (CInt, ) +import Data.Word (Word, ) + + +type T = Area.QueueInfo +type T_ = Area.QueueInfo_ + + +-- XXX: Lots of duplication. + +get :: Seq.T mode -> Queue.T -> IO T +get (Seq.Cons h) q = + do info <- Area.queue_info_malloc + Exc.checkResult "get_queue_info" =<< Area.with_queue_info info + (snd_seq_get_queue_info h (Queue.exp q)) + return info + +foreign import ccall "alsa/asoundlib.h snd_seq_get_queue_info" + snd_seq_get_queue_info :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt + + +set :: Seq.T mode -> Queue.T -> T -> IO () +set (Seq.Cons h) p info = + Exc.checkResult_ "set_queue_info" =<< Area.with_queue_info info (snd_seq_set_queue_info h (Queue.exp p)) + +foreign import ccall "alsa/asoundlib.h snd_seq_set_queue_info" + snd_seq_set_queue_info :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt + + +copy :: T -> T -> IO () +clone :: T -> IO T +getQueue :: T -> IO Queue.T +getName :: T -> IO String +getLocked :: T -> IO Bool +getOwner :: T -> IO Client.T +getFlags :: T -> IO Word +setName :: T -> String -> IO () +setLocked :: T -> Bool -> IO () +setOwner :: T -> Client.T -> IO () +setFlags :: T -> Word -> IO () + +copy = Area.queue_info_copy +clone = Area.queue_info_clone + +getQueue = Area.queue_info_get_queue +getName = Area.queue_info_get_name +getLocked = Area.queue_info_get_locked +getOwner = Area.queue_info_get_owner +getFlags = Area.queue_info_get_flags + +setName = Area.queue_info_set_name +setLocked = Area.queue_info_set_locked +setOwner = Area.queue_info_set_owner +setFlags = Area.queue_info_set_flags diff --git a/src/Sound/ALSA/Sequencer/Queue/Status.hs b/src/Sound/ALSA/Sequencer/Queue/Status.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Queue/Status.hs @@ -0,0 +1,106 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Sound.ALSA.Sequencer.Queue.Status +-- Copyright : (c) Henning Thielemann, 2010 +-- (c) Iavor S. Diatchki, 2007 +-- License : BSD3 +-- +-- Maintainer: Henning Thielemann +-- Stability : provisional +-- +-- This module contains functions for working with sequencer queue. +-- Reference: +-- +-------------------------------------------------------------------------------- + +module Sound.ALSA.Sequencer.Queue.Status + ( T + , get + , copy + , clone + + , getQueue + , getEvents + , getTickTime + , getRealTime + ) where + +import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq +import qualified Sound.ALSA.Sequencer.Marshal.RealTime as RealTime +import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue +import qualified Sound.ALSA.Sequencer.Area as Area +import qualified Sound.ALSA.Exception as Exc + +import Foreign.Ptr (Ptr, ) +import Foreign.C.Types (CInt, CUInt, ) +import Foreign.Storable (peek, ) +import Data.Word (Word32, ) + + +type T = Area.QueueStatus +type T_ = Area.QueueStatus_ + + +get :: Seq.T mode -> Queue.T -> IO T +get (Seq.Cons h) q = + do status <- Area.queue_status_malloc + Exc.checkResult "get_queue_status" =<< Area.with_queue_status status + (snd_seq_get_queue_status h (Queue.exp q)) + return status + +foreign import ccall "alsa/asoundlib.h snd_seq_get_queue_status" + snd_seq_get_queue_status :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt + + + +copy :: T -> T -> IO () +clone :: T -> IO T + +copy = Area.queue_status_copy +clone = Area.queue_status_clone + + +foreign import ccall "alsa/asoundlib.h" + snd_seq_queue_status_get_queue + :: Ptr T_ -> IO CInt +foreign import ccall "alsa/asoundlib.h" + snd_seq_queue_status_get_events + :: Ptr T_ -> IO CInt +foreign import ccall "alsa/asoundlib.h" + snd_seq_queue_status_get_tick_time + :: Ptr T_ -> IO Word32 +foreign import ccall "alsa/asoundlib.h" + snd_seq_queue_status_get_real_time + :: Ptr T_ -> IO (Ptr RealTime.T) +foreign import ccall "alsa/asoundlib.h" + snd_seq_queue_status_get_status + :: Ptr T_ -> IO CUInt + + +getQueue :: T -> IO Queue.T +getQueue status = + fmap Queue.imp $ + Area.with_queue_status status snd_seq_queue_status_get_queue + +getEvents :: T -> IO Int +getEvents status = + fmap fromIntegral $ + Area.with_queue_status status snd_seq_queue_status_get_events + +getTickTime :: T -> IO Word32 +getTickTime status = + Area.with_queue_status status snd_seq_queue_status_get_tick_time + +getRealTime :: T -> IO RealTime.T +getRealTime status = + peek =<< + Area.with_queue_status status snd_seq_queue_status_get_real_time + +{- +This function shall return status bits of the queue, +but the ALSA headers do not define any bits. +I would prefer a data type that handles this bitfield. +-} +_getStatus :: T -> IO CUInt +_getStatus status = + Area.with_queue_status status snd_seq_queue_status_get_status diff --git a/src/Sound/ALSA/Sequencer/Queue/Tempo.hs b/src/Sound/ALSA/Sequencer/Queue/Tempo.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Queue/Tempo.hs @@ -0,0 +1,91 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Sound.ALSA.Sequencer.Queue.Tempo +-- Copyright : (c) Henning Thielemann, 2010 +-- (c) Iavor S. Diatchki, 2007 +-- License : BSD3 +-- +-- Maintainer: Henning Thielemann +-- Stability : provisional +-- +-- This module contains functions for working with sequencer queue. +-- Reference: +-- +-------------------------------------------------------------------------------- + +module Sound.ALSA.Sequencer.Queue.Tempo + ( T + , get + , set + , copy + , clone + + , getQueue + , getTempo + , getPPQ + , getSkew + , getSkewBase + + , setTempo + , setPPQ + , setSkew + , setSkewBase + ) where + +import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue +import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq +import qualified Sound.ALSA.Sequencer.Area as Area +import qualified Sound.ALSA.Exception as Exc + +import Foreign.Ptr (Ptr, ) +import Foreign.C.Types (CInt, ) +import Data.Word (Word, ) + + +type T = Area.QueueTempo +type T_ = Area.QueueTempo_ + +get :: Seq.T mode -> Queue.T -> IO T +get (Seq.Cons h) q = + do tempo <- Area.queue_tempo_malloc + Exc.checkResult "get_queue_tempo" =<< Area.with_queue_tempo tempo + (snd_seq_get_queue_tempo h (Queue.exp q)) + return tempo + +foreign import ccall "alsa/asoundlib.h snd_seq_get_queue_tempo" + snd_seq_get_queue_tempo :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt + + +set :: Seq.T mode -> Queue.T -> T -> IO () +set (Seq.Cons h) p tempo = + Exc.checkResult_ "set_queue_tempo" =<< Area.with_queue_tempo tempo (snd_seq_set_queue_tempo h (Queue.exp p)) + +foreign import ccall "alsa/asoundlib.h snd_seq_set_queue_tempo" + snd_seq_set_queue_tempo :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt + + +copy :: T -> T -> IO () +clone :: T -> IO T +getQueue :: T -> IO Queue.T +getTempo :: T -> IO Word +getPPQ :: T -> IO Int +getSkew :: T -> IO Word +getSkewBase :: T -> IO Word +setTempo :: T -> Word -> IO () +setPPQ :: T -> Int -> IO () +setSkew :: T -> Word -> IO () +setSkewBase :: T -> Word -> IO () + +copy = Area.queue_tempo_copy +clone = Area.queue_tempo_clone + +getQueue = Area.queue_tempo_get_queue +getTempo = Area.queue_tempo_get_tempo +getPPQ = Area.queue_tempo_get_ppq +getSkew = Area.queue_tempo_get_skew +getSkewBase = Area.queue_tempo_get_skew_base + +setTempo = Area.queue_tempo_set_tempo +setPPQ = Area.queue_tempo_set_ppq +setSkew = Area.queue_tempo_set_skew +setSkewBase = Area.queue_tempo_set_skew_base diff --git a/src/Sound/ALSA/Sequencer/Queue/Timer.hs b/src/Sound/ALSA/Sequencer/Queue/Timer.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Queue/Timer.hs @@ -0,0 +1,80 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Sound.ALSA.Sequencer.Queue.Timer +-- Copyright : (c) Henning Thielemann, 2010 +-- (c) Iavor S. Diatchki, 2007 +-- License : BSD3 +-- +-- Maintainer: Henning Thielemann +-- Stability : provisional +-- +-- This module contains functions for working with sequencer queue. +-- Reference: +-- +-------------------------------------------------------------------------------- + +module Sound.ALSA.Sequencer.Queue.Timer + ( T + , get + , set + , copy + , clone + + , getQueue + , getType + , getResolution + + , setType + , setResolution + + , QueueTimer.Type(..) + ) where + +import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue +import qualified Sound.ALSA.Sequencer.Marshal.QueueTimer as QueueTimer +import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq +import qualified Sound.ALSA.Sequencer.Area as Area +import qualified Sound.ALSA.Exception as Exc + +import Foreign.Ptr (Ptr, ) +import Foreign.C.Types (CInt, ) +import Data.Word (Word, ) + + +type T = Area.QueueTimer +type T_ = Area.QueueTimer_ + +get :: Seq.T mode -> Queue.T -> IO T +get (Seq.Cons h) q = + do timer <- Area.queue_timer_malloc + Exc.checkResult "get_queue_timer" =<< Area.with_queue_timer timer + (snd_seq_get_queue_timer h (Queue.exp q)) + return timer + +foreign import ccall "alsa/asoundlib.h snd_seq_get_queue_timer" + snd_seq_get_queue_timer :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt + + +set :: Seq.T mode -> Queue.T -> T -> IO () +set (Seq.Cons h) p timer = + Exc.checkResult_ "set_queue_timer" =<< Area.with_queue_timer timer (snd_seq_set_queue_timer h (Queue.exp p)) + +foreign import ccall "alsa/asoundlib.h snd_seq_set_queue_timer" + snd_seq_set_queue_timer :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt + + +copy :: T -> T -> IO () +clone :: T -> IO T +getQueue :: T -> IO Queue.T +getType :: T -> IO QueueTimer.Type +getResolution :: T -> IO Word +setType :: T -> QueueTimer.Type -> IO () +setResolution :: T -> Word -> IO () + +copy = Area.queue_timer_copy +clone = Area.queue_timer_clone +getQueue = Area.queue_timer_get_queue +getType = Area.queue_timer_get_type +getResolution = Area.queue_timer_get_resolution +setType = Area.queue_timer_set_type +setResolution = Area.queue_timer_set_resolution diff --git a/src/Sound/ALSA/Sequencer/RealTime.hs b/src/Sound/ALSA/Sequencer/RealTime.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/RealTime.hs @@ -0,0 +1,36 @@ +module Sound.ALSA.Sequencer.RealTime + ( RealTime.T(..) + , fromDouble, fromInteger + , toDouble, toInteger + ) where + +import qualified Sound.ALSA.Sequencer.Marshal.RealTime as RealTime + +import Prelude hiding (fromInteger, toInteger, ) +import qualified Prelude as P + + +nanoPerSecond :: Num a => a +nanoPerSecond = 10^(9::Int) + +-- | Convert number of nanoseconds to 'RealTime.T' +fromInteger :: Integer -> RealTime.T +fromInteger t = + let (s,n) = divMod t nanoPerSecond + in RealTime.Cons (fromIntegral s) (fromIntegral n) + +-- | Convert fractional number of seconds to 'RealTime.T' +fromDouble :: Double -> RealTime.T +fromDouble t = + let (s,n) = properFraction t + in RealTime.Cons s (floor $ n * nanoPerSecond) + +-- | Convert number of nanoseconds to 'RealTime.T' +toInteger :: RealTime.T -> Integer +toInteger (RealTime.Cons s n) = + fromIntegral s * nanoPerSecond + fromIntegral n + +-- | Convert fractional number of seconds to 'RealTime.T' +toDouble :: RealTime.T -> Double +toDouble (RealTime.Cons s n) = + fromIntegral s + fromIntegral n / nanoPerSecond diff --git a/src/Sound/ALSA/Sequencer/Sequencer.hs b/src/Sound/ALSA/Sequencer/Sequencer.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Sequencer.hs @@ -0,0 +1,297 @@ +{-| PRIVATE MODULE +Reference: + +-} + +module Sound.ALSA.Sequencer.Sequencer where + +import qualified Sound.ALSA.Sequencer.Marshal.Port as Port +import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq +import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr +import qualified Sound.ALSA.Exception as Exc + +import Foreign.C.Types (CInt, CSize, ) +import Foreign.C.String (CString, withCAString, peekCString, ) +import Foreign.Ptr (Ptr, ) +import Foreign.Marshal.Alloc (alloca, ) +import Foreign.Storable (peek, ) + +import Data.Word (Word, ) + +import Control.Exception (bracket, ) + + +-- | Creates a new handle and opens a connection to the kernel sequencer +-- interface. After a client is created successfully, +-- a 'ClientStart' event is broadcast to the announce port. +-- May throw an exception. +-- See also: 'open_lconf', 'close', 'get_seq_type', +-- 'get_seq_name', 'set_blocking', 'get_client_id'. + +open + :: Seq.OpenMode mode + -- Read\/Write permissions + => String -- ^ The sequencer's \"name\". This is not a name that you + -- make up for your own purposes; it has special significance + -- to the ALSA library. Usually you need to pass 'default_name' + -- here. + -> Seq.BlockMode -- Blocking behavior + -> IO (Seq.T mode) -- Handle to the sequencer. + +open t bm = withOpenMode $ \om -> alloca $ \p -> withCAString t $ \s -> + do Exc.checkResult_ "open" =<< snd_seq_open p s (Seq.expOpenMode om) (Seq.expBlockMode bm) + fmap Seq.Cons $ peek p + +foreign import ccall "alsa/asoundlib.h snd_seq_open" + snd_seq_open :: Ptr (Ptr Seq.Core) -> CString -> CInt -> CInt -> IO CInt + +withOpenMode :: (mode -> IO (Seq.T mode)) -> IO (Seq.T mode) +withOpenMode f = f undefined + + +-- | Close the sequencer. Closes the sequencer client and releases its +-- resources. After a client is closed, an event with 'ClientExit' is +-- broadcast to announce port. The connection between other clients are +-- disconnected. Call this just before exiting your program. +-- NOTE: we could put this in a finalizer for the handle? + +close + :: Seq.T mode -- ^ handle to the sequencer + -> IO () +close (Seq.Cons h) = Exc.checkResult_ "close" =<< snd_seq_close h + +foreign import ccall "alsa/asoundlib.h snd_seq_close" + snd_seq_close :: Ptr Seq.Core -> IO CInt + + +with + :: Seq.OpenMode mode + -- Read\/Write permissions + => String -- ^ The sequencer's \"name\". This is not a name that you + -- make up for your own purposes; it has special significance + -- to the ALSA library. Usually you need to pass 'default_name' + -- here. + -> Seq.BlockMode + -- Blocking behavior + -> (Seq.T mode -> IO a) + -- Action on the sequencer, the result must be computed strictly. + -> IO a +with t bm = + bracket (open t bm) close + + +-- | Get identifier of a sequencer handle. +-- It is the same identifier specified in the call to 'open'. +getName + :: Seq.T mode -- ^ sequencer handle + -> IO String -- ^ ALSA identifier for the handel +getName (Seq.Cons h) = peekCString =<< snd_seq_name h + +foreign import ccall "alsa/asoundlib.h snd_seq_name" + snd_seq_name :: Ptr Seq.Core -> IO CString + + +-- | Change the blocking mode of the given client. +-- In block mode, the client falls into sleep when it fills the output +-- pool with events, or when it demands events from an empty input pool. +-- memory pool with full events. Clients that are sleeping due to +-- loack of space in the output pool are woken when a certain +-- amount of free space becomes available (see 'set_output_room'). +setBlocking + :: Seq.T mode -- ^ sequencer handle + -> Seq.BlockMode -- ^ blocking mode + -> IO () +setBlocking (Seq.Cons h) m = Exc.checkResult_ "set_blocking" =<< snd_seq_nonblock h(Seq.expBlockMode m) + +foreign import ccall "alsa/asoundlib.h snd_seq_nonblock" + snd_seq_nonblock :: Ptr Seq.Core -> CInt -> IO CInt + + + +-- Buffers --------------------------------------------------------------------- + +-- | Return the byte size of the output buffer. +getOutputBufferSize + :: Seq.T mode -- ^ Sequencer handle. + -> IO Word -- ^ Size of output buffer in bytes. + +getOutputBufferSize (Seq.Cons h) = + fromIntegral `fmap` snd_seq_get_output_buffer_size h + +foreign import ccall "alsa/asoundlib.h snd_seq_get_output_buffer_size" + snd_seq_get_output_buffer_size :: Ptr Seq.Core -> IO CSize + + +-- | Resize of the output buffer. +-- This function clears all output events (see 'drop_output'). +setOutputBufferSize + :: Seq.T mode -- ^ Sequencer handle. + -> Word -- ^ New buffer size in bytes. + -> IO () + +setOutputBufferSize (Seq.Cons h) x = + Exc.checkResult_ "set_output_buffer_size" =<< snd_seq_set_output_buffer_size h (fromIntegral x) + +foreign import ccall "alsa/asoundlib.h snd_seq_set_output_buffer_size" + snd_seq_set_output_buffer_size :: Ptr Seq.Core -> CSize -> IO CInt + + +-- | Return the byte size of input buffer. +getInputBufferSize + :: Seq.T mode -- ^ Sequencer handle. + -> IO Word -- ^ Size of input buffer in bytes. + +getInputBufferSize (Seq.Cons h) = + fromIntegral `fmap` snd_seq_get_input_buffer_size h + +foreign import ccall "alsa/asoundlib.h snd_seq_get_input_buffer_size" + snd_seq_get_input_buffer_size :: Ptr Seq.Core -> IO CSize + + +-- | Resize the input buffer. +-- This function clears all input events (see 'drop_input'). +setInputBufferSize + :: Seq.T mode -- ^ Sequencer handle. + -> Word -- ^ New byffer size in bytes. + -> IO () + +setInputBufferSize (Seq.Cons h) x = + Exc.checkResult_ "set_input_buffer_size" =<< snd_seq_set_input_buffer_size h (fromIntegral x) + +foreign import ccall "alsa/asoundlib.h snd_seq_set_input_buffer_size" + snd_seq_set_input_buffer_size :: Ptr Seq.Core -> CSize -> IO CInt + + + +-- Pool management ------------------------------------------------------------- + +-- | Resize the output memory pool. +setPoolOutput + :: Seq.T mode -- ^ Sequencer handle. + -> Word -- ^ New size in bytes. + -> IO () + +setPoolOutput (Seq.Cons h) x = + Exc.checkResult_ "set_pool_output" =<< snd_seq_set_client_pool_output h (fromIntegral x) + +foreign import ccall "alsa/asoundlib.h snd_seq_set_client_pool_output" + snd_seq_set_client_pool_output :: Ptr Seq.Core -> CSize -> IO CInt + + +-- | Specify how much space should become free before waking clients +-- that are blocked due to a lack of space in the output pool. +setPoolOutputRoom + :: Seq.T mode -- ^ Sequencer handle. + -> Word -- ^ Number of bytes need to wake up. + -> IO () + +setPoolOutputRoom (Seq.Cons h) x = + Exc.checkResult_ "set_pool_output_room" =<< snd_seq_set_client_pool_output_room h (fromIntegral x) + +foreign import ccall "alsa/asoundlib.h snd_seq_set_client_pool_output_room" + snd_seq_set_client_pool_output_room :: Ptr Seq.Core -> CSize -> IO CInt + + +-- | Reset the output pool. +resetPoolOutput + :: Seq.T mode -- ^ Sequencer handle. + -> IO () + +resetPoolOutput (Seq.Cons h) = + Exc.checkResult_ "reset_pool_output" =<< snd_seq_reset_pool_output h + +foreign import ccall "alsa/asoundlib.h snd_seq_reset_pool_output" + snd_seq_reset_pool_output :: Ptr Seq.Core -> IO CInt + + + +-- | Resize the input memory pool. +setPoolInput + :: Seq.T mode -- ^ Sequencer handle. + -> Word -- ^ New size in bytes. + -> IO () + +setPoolInput (Seq.Cons h) x = + Exc.checkResult_ "set_pool_input" =<< snd_seq_set_client_pool_input h (fromIntegral x) + +foreign import ccall "alsa/asoundlib.h snd_seq_set_client_pool_input" + snd_seq_set_client_pool_input :: Ptr Seq.Core -> CSize -> IO CInt + + +-- | Reset the input pool. +resetPoolInput + :: Seq.T mode -- ^ Sequencer handle. + -> IO () + +resetPoolInput (Seq.Cons h) = + Exc.checkResult_ "reset_pool_input" =<< snd_seq_reset_pool_input h + +foreign import ccall "alsa/asoundlib.h snd_seq_reset_pool_input" + snd_seq_reset_pool_input :: Ptr Seq.Core -> IO CInt + + + + + + + + + +--Middle Level Interface ------------------------------------------------------- + + +-- | Simple subscription (w\/o exclusive & time conversion). +connectFrom :: Seq.AllowInput mode => Seq.T mode -> Port.T -> Addr.T -> IO () +connectFrom (Seq.Cons h) me a = + Exc.checkResult_ "connect_from" =<< snd_seq_connect_from h (Port.exp me) c p + where (c,p) = Addr.exp a + +foreign import ccall "alsa/asoundlib.h snd_seq_connect_from" + snd_seq_connect_from :: Ptr Seq.Core -> CInt -> CInt -> CInt -> IO CInt + + +-- | Simple subscription (w\/o exclusive & time conversion). +connectTo :: Seq.AllowOutput mode => Seq.T mode -> Port.T -> Addr.T -> IO () +connectTo (Seq.Cons h) me a = + Exc.checkResult_ "connect_to" =<< snd_seq_connect_to h (Port.exp me) c p + where (c,p) = Addr.exp a + +foreign import ccall "alsa/asoundlib.h snd_seq_connect_to" + snd_seq_connect_to :: Ptr Seq.Core -> CInt -> CInt -> CInt -> IO CInt + + +-- | Simple disconnection. +disconnectFrom :: Seq.AllowInput mode => Seq.T mode -> Port.T -> Addr.T -> IO () +disconnectFrom (Seq.Cons h) me a = + Exc.checkResult_ "disconnect_from" =<< snd_seq_disconnect_from h (Port.exp me) c p + where (c,p) = Addr.exp a + +foreign import ccall "alsa/asoundlib.h snd_seq_disconnect_from" + snd_seq_disconnect_from :: Ptr Seq.Core -> CInt -> CInt -> CInt -> IO CInt + +-- | Simple disconnection. +disconnectTo :: Seq.AllowOutput mode => Seq.T mode -> Port.T -> Addr.T -> IO () +disconnectTo (Seq.Cons h) me a = + Exc.checkResult_ "disconnect_to" =<< snd_seq_disconnect_to h (Port.exp me) c p + where (c,p) = Addr.exp a + +foreign import ccall "alsa/asoundlib.h snd_seq_disconnect_to" + snd_seq_disconnect_to :: Ptr Seq.Core -> CInt -> CInt -> CInt -> IO CInt + + +-- | Parse the given string into sequencer address. +-- The client and port are separated by either colon or period, e.g. 128:1. +-- The function also accepts client names. +parseAddress + :: Seq.T mode -- ^ Sequencer handle. + -> String -- ^ String to be parsed. + -> IO Addr.T -- ^ The parsed address. + +parseAddress (Seq.Cons h) s = + alloca $ \pa -> + withCAString s $ \ps -> + do Exc.checkResult "parse_address" =<< snd_seq_parse_address h pa ps + peek pa + +foreign import ccall "alsa/asoundlib.h snd_seq_parse_address" + snd_seq_parse_address :: Ptr Seq.Core -> Ptr Addr.T -> CString -> IO CInt diff --git a/src/Sound/ALSA/Sequencer/Utility.hs b/src/Sound/ALSA/Sequencer/Utility.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Utility.hs @@ -0,0 +1,10 @@ +module Sound.ALSA.Sequencer.Utility where + +showsField :: Show a => a -> ShowS +showsField = showsPrec 11 + +showsRecord :: Int -> String -> [ShowS] -> ShowS +showsRecord prec name fields = + showParen (prec >= 10) $ + showString name . showString ".Cons" . + foldr (.) id (map (\f -> showChar ' ' . f) fields)