diff --git a/alsa-seq.cabal b/alsa-seq.cabal --- a/alsa-seq.cabal +++ b/alsa-seq.cabal @@ -1,20 +1,28 @@ -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). +Name: alsa-seq +Version: 0.5.1 +Copyright: Bjorn Bringert, Iavor S. Diatchki, Henning Thielemann +Maintainer: Henning Thielemann +Author: + Henning Thielemann , + Dylan Simon , + 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. + Included are some simple example programs. + For more example programs including a GUI, see the alsa-gui programs. +Extra-Source-Files: + filter/modify/Sound/ALSA/Sequencer/Client/Info/EventFilter.hs + filter/setget/Sound/ALSA/Sequencer/Client/Info/EventFilter.hs Source-Repository head type: darcs @@ -23,16 +31,23 @@ Source-Repository this type: darcs location: http://code.haskell.org/~thielema/alsa-seq/ - tag: 0.5 + tag: 0.5.1 Flag buildExamples description: Build example executables default: False +Flag modifyFilter + description: Use native event filter functions that are provided by newer ALSA versions + default: True + Library Build-depends: alsa-core >=0.5 && <0.6, + enumset >= 0.0.2 && <0.1, array >= 0.1 && <0.4, + data-accessor >=0.2.1 && <0.3, + utility-ht >= 0.0.7 && <0.1, extensible-exceptions >=0.1.1 && <0.2, base >= 3 && <5 @@ -43,6 +58,12 @@ EmptyDataDecls Hs-Source-Dirs: src + If flag(modifyFilter) + PkgConfig-Depends: alsa >= 1.0.17 + Hs-Source-Dirs: filter/modify + Else + PkgConfig-Depends: alsa >= 1.0.14 + Hs-Source-Dirs: filter/setget Exposed-Modules: Sound.ALSA.Sequencer @@ -52,12 +73,15 @@ Sound.ALSA.Sequencer.Port Sound.ALSA.Sequencer.Port.Info Sound.ALSA.Sequencer.Event + Sound.ALSA.Sequencer.Event.Accessor 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 + Sound.ALSA.Sequencer.Subscribe + Sound.ALSA.Sequencer.Subscribe.Query Other-modules: Sound.ALSA.Sequencer.Marshal.Sequencer @@ -68,18 +92,23 @@ Sound.ALSA.Sequencer.Marshal.QueueTimer Sound.ALSA.Sequencer.Marshal.Event Sound.ALSA.Sequencer.Marshal.RealTime + Sound.ALSA.Sequencer.Marshal.QuerySubscribe + Sound.ALSA.Sequencer.Client.Info.EventFilter 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 +Executable alsa-seq-dump + Main-Is: dump.hs If !flag(buildExamples) Buildable: False Hs-Source-Dirs: src, examples + If flag(modifyFilter) + Hs-Source-Dirs: filter/modify + Else + Hs-Source-Dirs: filter/setget GHC-Options: -Wall -threaded Extensions: ForeignFunctionInterface @@ -94,18 +123,25 @@ Sound.ALSA.Sequencer.Marshal.QueueTimer Sound.ALSA.Sequencer.Marshal.Event Sound.ALSA.Sequencer.Marshal.RealTime + Sound.ALSA.Sequencer.Marshal.QuerySubscribe Sound.ALSA.Sequencer.Area Sound.ALSA.Sequencer.Sequencer Build-Depends: alsa-core >=0.5 && <0.6, + enumset >= 0.0.2 && <0.1, array >= 0.1 && <0.4, + utility-ht >= 0.0.7 && <0.1, base >=3 && <5 -Executable test2 - Main-Is: test2.hs +Executable alsa-seq-send-note + Main-Is: send-note.hs If !flag(buildExamples) Buildable: False Hs-Source-Dirs: src, examples + If flag(modifyFilter) + Hs-Source-Dirs: filter/modify + Else + Hs-Source-Dirs: filter/setget GHC-Options: -Wall -threaded Extensions: ForeignFunctionInterface @@ -120,18 +156,25 @@ Sound.ALSA.Sequencer.Marshal.QueueTimer Sound.ALSA.Sequencer.Marshal.Event Sound.ALSA.Sequencer.Marshal.RealTime + Sound.ALSA.Sequencer.Marshal.QuerySubscribe Sound.ALSA.Sequencer.Area Sound.ALSA.Sequencer.Sequencer Build-Depends: alsa-core >=0.5 && <0.6, + enumset >= 0.0.2 && <0.1, array >= 0.1 && <0.4, + utility-ht >= 0.0.7 && <0.1, base >=3 && <5 -Executable test3 - Main-Is: test3.hs +Executable alsa-seq-broadcast + Main-Is: broadcast.hs If !flag(buildExamples) Buildable: False Hs-Source-Dirs: src, examples + If flag(modifyFilter) + Hs-Source-Dirs: filter/modify + Else + Hs-Source-Dirs: filter/setget GHC-Options: -Wall -threaded Extensions: ForeignFunctionInterface @@ -146,18 +189,25 @@ Sound.ALSA.Sequencer.Marshal.QueueTimer Sound.ALSA.Sequencer.Marshal.Event Sound.ALSA.Sequencer.Marshal.RealTime + Sound.ALSA.Sequencer.Marshal.QuerySubscribe Sound.ALSA.Sequencer.Area Sound.ALSA.Sequencer.Sequencer Build-Depends: alsa-core >=0.5 && <0.6, + enumset >= 0.0.2 && <0.1, array >= 0.1 && <0.4, + utility-ht >= 0.0.7 && <0.1, base >=3 && <5 -Executable test4 - Main-Is: test4.hs +Executable alsa-seq-list-clients + Main-Is: list-clients.hs If !flag(buildExamples) Buildable: False Hs-Source-Dirs: src, examples + If flag(modifyFilter) + Hs-Source-Dirs: filter/modify + Else + Hs-Source-Dirs: filter/setget GHC-Options: -Wall -threaded Extensions: ForeignFunctionInterface @@ -172,18 +222,25 @@ Sound.ALSA.Sequencer.Marshal.QueueTimer Sound.ALSA.Sequencer.Marshal.Event Sound.ALSA.Sequencer.Marshal.RealTime + Sound.ALSA.Sequencer.Marshal.QuerySubscribe Sound.ALSA.Sequencer.Area Sound.ALSA.Sequencer.Sequencer Build-Depends: alsa-core >=0.5 && <0.6, + enumset >= 0.0.2 && <0.1, array >= 0.1 && <0.4, + utility-ht >= 0.0.7 && <0.1, base >=3 && <5 -Executable test5 - Main-Is: test5.hs +Executable alsa-seq-melody + Main-Is: melody.hs If !flag(buildExamples) Buildable: False Hs-Source-Dirs: src, examples + If flag(modifyFilter) + Hs-Source-Dirs: filter/modify + Else + Hs-Source-Dirs: filter/setget GHC-Options: -Wall -threaded Extensions: ForeignFunctionInterface @@ -198,9 +255,45 @@ Sound.ALSA.Sequencer.Marshal.QueueTimer Sound.ALSA.Sequencer.Marshal.Event Sound.ALSA.Sequencer.Marshal.RealTime + Sound.ALSA.Sequencer.Marshal.QuerySubscribe Sound.ALSA.Sequencer.Area Sound.ALSA.Sequencer.Sequencer Build-Depends: alsa-core >=0.5 && <0.6, + enumset >= 0.0.2 && <0.1, array >= 0.1 && <0.4, + utility-ht >= 0.0.7 && <0.1, + base >=3 && <5 + +Executable alsa-seq-list-subscribers + Main-Is: list-subscribers.hs + If !flag(buildExamples) + Buildable: False + Hs-Source-Dirs: src, examples + If flag(modifyFilter) + Hs-Source-Dirs: filter/modify + Else + Hs-Source-Dirs: filter/setget + 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.Marshal.QuerySubscribe + Sound.ALSA.Sequencer.Area + Sound.ALSA.Sequencer.Sequencer + Build-Depends: + alsa-core >=0.5 && <0.6, + enumset >= 0.0.2 && <0.1, + array >= 0.1 && <0.4, + utility-ht >= 0.0.7 && <0.1, base >=3 && <5 diff --git a/examples/broadcast.hs b/examples/broadcast.hs new file mode 100644 --- /dev/null +++ b/examples/broadcast.hs @@ -0,0 +1,28 @@ +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 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) "Haskell-Broadcast" + c <- Client.getId h + putStrLn ("Created sequencer with id: " ++ show c) + -- tgt_addr <- Addr.parse h "HS1:255" + let tgt_addr = Addr.Cons Client.broadcast Port.unknown + print tgt_addr + let ev n = + (Event.simple + (Addr.Cons c Port.unknown) + (Event.NoteEv n $ Event.simpleNote 0 60 64)) + {Event.dest = tgt_addr} + _ <- Event.outputDirect h $ ev Event.NoteOn + _ <- getChar + _ <- Event.outputDirect h $ ev Event.NoteOff + return ()) + `AlsaExc.catch` \e -> + putStrLn $ "alsa_exception: " ++ AlsaExc.show e diff --git a/examples/dump.hs b/examples/dump.hs new file mode 100644 --- /dev/null +++ b/examples/dump.hs @@ -0,0 +1,23 @@ +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 +import Control.Monad (forever, ) + +main :: IO () +main = (do + putStrLn "Starting." + SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do + Client.setName (h :: SndSeq.T SndSeq.InputMode) "Haskell-Dump" + putStrLn "Created sequencer." + Port.withSimple h "primary" + (Port.caps [Port.capWrite, Port.capSubsWrite]) Port.typeMidiGeneric $ \ _p1 -> do + Port.withSimple h "secondary" + (Port.caps [Port.capWrite, Port.capSubsWrite]) Port.typeMidiGeneric $ \ _p2 -> do + putStrLn "Created ports." + forever $ do + putStrLn "waiting for an event:" + print =<< Event.input h) + `AlsaExc.catch` \e -> + putStrLn $ "alsa_exception: " ++ AlsaExc.show e diff --git a/examples/list-clients.hs b/examples/list-clients.hs new file mode 100644 --- /dev/null +++ b/examples/list-clients.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/list-subscribers.hs b/examples/list-subscribers.hs new file mode 100644 --- /dev/null +++ b/examples/list-subscribers.hs @@ -0,0 +1,28 @@ +import qualified Sound.ALSA.Sequencer.Address as Addr +import qualified Sound.ALSA.Sequencer.Subscribe.Query as Query +import qualified Sound.ALSA.Sequencer as SndSeq +import qualified Sound.ALSA.Exception as AlsaExc +import System.Environment (getArgs, ) +import Control.Monad ((<=<), forM_, ) + +main :: IO () +main = (do + args <- getArgs + SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> forM_ args $ \arg -> do + a <- Addr.parse (h :: SndSeq.T SndSeq.InputMode) arg + let showQ q = do + ad <- Query.getAddr q + qq <- Query.getQueue q + ex <- Query.getExclusive q + tu <- Query.getTimeUpdate q + tr <- Query.getTimeReal q + return (show ad ++ ":" ++ show qq + ++ (if tu then " update" else "") + ++ (if tr then " realtime" else "") + ++ (if ex then " exclusive" else "")) + list t = do + putStrLn ("subscribers of " ++ show a ++ " for " ++ show t ++ ":") + mapM_ (putStrLn . (' ':) <=< showQ) =<< Query.queryAll h a t + mapM_ list [Query.Read, Query.Write]) + `AlsaExc.catch` \e -> + putStrLn $ "alsa_exception: " ++ AlsaExc.show e diff --git a/examples/melody.hs b/examples/melody.hs new file mode 100644 --- /dev/null +++ b/examples/melody.hs @@ -0,0 +1,103 @@ +{- | +Play a melody. +Demonstrate how to wait on the end of a performance of events, +by sending an Echo message to ourselves. +-} +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 qualified System.Exit as Exit +import qualified System.IO as IO +import System.Environment (getArgs, ) + +import Control.Monad (zipWithM_, ) + + +parseAndConnect :: + (SndSeq.AllowOutput mode) => + SndSeq.T mode -> Port.T -> String -> IO Addr.T +parseAndConnect h p destStr = do + dest <- Addr.parse h destStr + SndSeq.connectTo h p dest + return dest + +main :: IO () +main = (do + SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do + Client.setName (h :: SndSeq.T SndSeq.DuplexMode) "Haskell-Melody" + Port.withSimple h "out" + (Port.caps [Port.capRead, Port.capSubsRead, Port.capWrite]) + (Port.types [Port.typeMidiGeneric, Port.typeApplication]) $ \p -> do + Queue.with h $ \q -> do + args <- getArgs + dest <- + case args of + [] -> do + putStrLn "Enter destination or connect to a synthesizer and hit ENTER" + destStr <- getLine + if null destStr + then return Addr.subscribers + else parseAndConnect h p destStr + [destStr] -> + parseAndConnect h p destStr + _ -> + IO.hPutStrLn IO.stderr "too many arguments" + >> + Exit.exitFailure + + c <- Client.getId h + let me = Addr.Cons c p + ev t e = + (Event.simple me e) { + Event.queue = q, + Event.dest = dest, + Event.timestamp = Event.TickTime t + } + play t chan pitch vel = + Event.output h (ev t $ + Event.NoteEv Event.NoteOn $ Event.simpleNote chan pitch vel) + >> + Event.output h (ev (t+1) $ + Event.NoteEv Event.NoteOn $ Event.simpleNote chan pitch 0) + >> + return () + + echo t = + fmap (const ()) $ Event.output h + ((ev t $ Event.CustomEv Event.Echo $ Event.Custom 0 0 0){ + Event.dest = me + }) + + 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 64)) [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 + _ <- Event.outputPending h + +-- threadDelay 10000000 + let waitForEcho = do + event <- Event.input h + print event + case Event.body event of + Event.CustomEv Event.Echo _d -> + if Event.source event == me + then return () + else waitForEcho + _ -> waitForEcho + waitForEcho) + + `AlsaExc.catch` \e -> + putStrLn $ "alsa_exception: " ++ AlsaExc.show e diff --git a/examples/send-note.hs b/examples/send-note.hs new file mode 100644 --- /dev/null +++ b/examples/send-note.hs @@ -0,0 +1,56 @@ +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 as SndSeq +import qualified Sound.ALSA.Exception as AlsaExc + +import qualified System.Exit as Exit +import qualified System.IO as IO +import System.Environment (getArgs, ) + +parseAndConnect :: + (SndSeq.AllowOutput mode) => + SndSeq.T mode -> Port.T -> String -> IO Addr.T +parseAndConnect h p destStr = do + dest <- Addr.parse h destStr + SndSeq.connectTo h p dest + return dest + +main :: IO () +main = (do + putStrLn "Starting." + SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do + Client.setName (h :: SndSeq.T SndSeq.OutputMode) "Haskell-Send-Note" + c <- Client.getId h + putStrLn ("Created sequencer with id: " ++ show c) + Port.withSimple h "out" + (Port.caps [Port.capRead, Port.capSubsRead]) Port.typeMidiGeneric $ \ p -> do + putStrLn "Created port." + args <- getArgs + dest <- + case args of + [] -> do + putStrLn "Enter destination or connect to a synthesizer and hit ENTER" + destStr <- getLine + if null destStr + then return Addr.subscribers + else parseAndConnect h p destStr + [destStr] -> + parseAndConnect h p destStr + _ -> + IO.hPutStrLn IO.stderr "too many arguments" + >> + Exit.exitFailure + + let ev n = + (Event.simple (Addr.Cons c p) $ + Event.NoteEv n $ Event.simpleNote 0 60 64) + {Event.dest = dest} + _ <- Event.outputDirect h $ ev Event.NoteOn + putStrLn "press Enter for stopping the note" + _ <- getChar + _ <- Event.outputDirect h $ ev Event.NoteOff + return ()) + `AlsaExc.catch` \e -> + putStrLn $ "alsa_exception: " ++ AlsaExc.show e diff --git a/examples/test1.hs b/examples/test1.hs deleted file mode 100644 --- a/examples/test1.hs +++ /dev/null @@ -1,24 +0,0 @@ -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 deleted file mode 100644 --- a/examples/test2.hs +++ /dev/null @@ -1,38 +0,0 @@ -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 deleted file mode 100644 --- a/examples/test3.hs +++ /dev/null @@ -1,38 +0,0 @@ -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 deleted file mode 100644 --- a/examples/test4.hs +++ /dev/null @@ -1,13 +0,0 @@ -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 deleted file mode 100644 --- a/examples/test5.hs +++ /dev/null @@ -1,69 +0,0 @@ -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/filter/modify/Sound/ALSA/Sequencer/Client/Info/EventFilter.hs b/filter/modify/Sound/ALSA/Sequencer/Client/Info/EventFilter.hs new file mode 100644 --- /dev/null +++ b/filter/modify/Sound/ALSA/Sequencer/Client/Info/EventFilter.hs @@ -0,0 +1,42 @@ +module Sound.ALSA.Sequencer.Client.Info.EventFilter where + +import qualified Sound.ALSA.Sequencer.Area as Area +import qualified Sound.ALSA.Sequencer.Marshal.Event as Event + +import Foreign.C.Types(CInt, ) +import Foreign.Ptr(Ptr, ) + + +type T = Area.ClientInfo +type T_ = Area.ClientInfo_ + + +clear :: T -> IO () +add :: Event.Type e => T -> e -> IO () +delete :: Event.Type e => T -> e -> IO () +check :: Event.Type e => T -> e -> IO Bool + + +clear i = + Area.with_client_info i snd_seq_client_info_event_filter_clear + +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_client_info_event_filter_clear" + snd_seq_client_info_event_filter_clear :: Ptr T_ -> IO () + +add i e = + Area.with_client_info i (`snd_seq_client_info_event_filter_add` fromIntegral (Event.expEv e)) + +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_client_info_event_filter_add" + snd_seq_client_info_event_filter_add :: Ptr T_ -> CInt -> IO () + +delete i e = + Area.with_client_info i (`snd_seq_client_info_event_filter_del` fromIntegral (Event.expEv e)) + +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_client_info_event_filter_del" + snd_seq_client_info_event_filter_del :: Ptr T_ -> CInt -> IO () + +check i e = + fmap (/= 0) $ Area.with_client_info i (`snd_seq_client_info_event_filter_check` fromIntegral (Event.expEv e)) + +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_client_info_event_filter_check" + snd_seq_client_info_event_filter_check :: Ptr T_ -> CInt -> IO CInt diff --git a/filter/setget/Sound/ALSA/Sequencer/Client/Info/EventFilter.hs b/filter/setget/Sound/ALSA/Sequencer/Client/Info/EventFilter.hs new file mode 100644 --- /dev/null +++ b/filter/setget/Sound/ALSA/Sequencer/Client/Info/EventFilter.hs @@ -0,0 +1,80 @@ +-- | Emulate new api using the old functions +module Sound.ALSA.Sequencer.Client.Info.EventFilter where + +import qualified Sound.ALSA.Sequencer.Area as Area +import qualified Sound.ALSA.Sequencer.Marshal.Event as Event + +import Foreign.C.Types (CUInt, ) +import Foreign.Ptr (Ptr, nullPtr, ) +import Foreign.Marshal.Array (allocaArray, copyArray, ) +import Foreign.Storable (sizeOf, peekElemOff, pokeElemOff, ) +import Data.Bits (testBit, setBit, clearBit, ) + + +type T = Area.ClientInfo +type T_ = Area.ClientInfo_ + +{- | +Although alsa/seq.h says CUChar, that's not true, +because internally it uses CUInt and +that makes a difference between little and big endian memory access. +-} +type EventTypeSubset = CUInt +type EventTypeSet = Ptr EventTypeSubset + + +clear :: T -> IO () +add :: Event.Type e => T -> e -> IO () +delete :: Event.Type e => T -> e -> IO () +check :: Event.Type e => T -> e -> IO Bool + +clear i = + Area.with_client_info i (`snd_seq_client_info_set_event_filter` nullPtr) + +bit :: Event.Type e => e -> (Int, Int) +bit e = + divMod + (fromIntegral $ Event.expEv e) + (8 * sizeOf (undefined :: EventTypeSubset)) + +size :: Int +size = div 32 (sizeOf (undefined :: EventTypeSubset)) + -- succ $ fst $ bit Event.maxEventType + +get :: T -> IO EventTypeSet +get i = Area.with_client_info i snd_seq_client_info_get_event_filter + +check i e = do + ef <- get i + let (o,b) = bit e + w <- peekElemOff ef o + return $ testBit w b + +set :: T -> EventTypeSet -> IO () +set i ef = + Area.with_client_info i (`snd_seq_client_info_set_event_filter` ef) + +modify :: T -> (EventTypeSet -> IO ()) -> IO () +modify i f = + allocaArray size $ \ef' -> do + ef <- get i + copyArray ef' ef size + f ef' + set i ef' + +modifyByte :: + (Event.Type e) => + (EventTypeSubset -> Int -> EventTypeSubset) -> T -> e -> IO () +modifyByte f i e = + modify i $ \ef -> + let (o,b) = bit e + in pokeElemOff ef o . flip f b =<< peekElemOff ef o + +add = modifyByte setBit +delete = modifyByte clearBit + +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_client_info_get_event_filter" + snd_seq_client_info_get_event_filter :: Ptr T_ -> IO EventTypeSet + +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_client_info_set_event_filter" + snd_seq_client_info_set_event_filter :: Ptr T_ -> EventTypeSet -> IO () diff --git a/src/Sound/ALSA/Sequencer/Area.hsc b/src/Sound/ALSA/Sequencer/Area.hsc --- a/src/Sound/ALSA/Sequencer/Area.hsc +++ b/src/Sound/ALSA/Sequencer/Area.hsc @@ -20,8 +20,10 @@ 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.Sequencer.Marshal.QuerySubscribe as QuerySubscribe import qualified Sound.ALSA.Exception as Exc +import qualified Data.EnumSet as EnumSet import Foreign.C.Types (CInt, ) import Foreign.C.String (CString, peekCString, withCAString, ) import Foreign.Storable (Storable, peek, ) @@ -46,13 +48,13 @@ "-- | 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" +" 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" +"foreign import ccall unsafe \"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" +"foreign import ccall unsafe \"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" @@ -66,7 +68,7 @@ " with_"y" from $ \\p2 ->\n" " snd_seq_"y"_copy p1 p2\n" "\n" -"foreign import ccall \"alsa/asoundlib.h snd_seq_"y"_copy\"\n" +"foreign import ccall unsafe \"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" @@ -86,23 +88,32 @@ 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" +"foreign import ccall unsafe \"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" +"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_set_name\"\n" " snd_seq_"y"_set_name :: Ptr "x"_ -> CString -> IO ()\n" } +#{let get_bool x,y,z = +y"_get_"z" :: "x" -> IO Bool\n" +y"_get_"z" i =\n" +" (0 /=) `fmap` with_"y" i snd_seq_"y"_get_"z"\n" +"\n" +"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_get_"z"\"\n" +" snd_seq_"y"_get_"z" :: Ptr "x"_ -> IO CInt\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" +" (0 /=) `fmap` with_"y" i snd_seq_"y"_get_"z"\n" "\n" -"foreign import ccall \"alsa/asoundlib.h snd_seq_"y"_get_"z"\"\n" +"foreign import ccall unsafe \"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" @@ -110,7 +121,7 @@ " 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" +"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_set_"z"\"\n" " snd_seq_"y"_set_"z" :: Ptr "x"_ -> CInt -> IO ()\n" } @@ -120,7 +131,7 @@ " "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" +"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_get_"z"\"\n" " snd_seq_"y"_get_"z" :: Ptr "x"_ -> IO CInt\n" } @@ -129,7 +140,7 @@ 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" +"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_set_"z"\"\n" " snd_seq_"y"_set_"z" :: Ptr "x"_ -> CInt -> IO ()\n" } @@ -175,9 +186,9 @@ #{set_int "PortInfo", "port_info", "client", "Client.T","Client.exp"} #{get_int "PortInfo", "port_info", "capability", - "Port.Cap","(Port.Cap . fromIntegral)"} + "Port.Cap","(EnumSet.Cons . fromIntegral)"} #{set_int "PortInfo", "port_info", "capability", - "Port.Cap","(fromIntegral . Port.unCap)"} + "Port.Cap","(fromIntegral . EnumSet.decons)"} #{get_int "PortInfo", "port_info", "midi_channels", "Word","fromIntegral"} @@ -202,6 +213,46 @@ "Word","fromIntegral"} #{get_int "PortInfo", "port_info", "write_use", "Word","fromIntegral"} + +-- Subscribe Port ---------------------------------------------------------------- +#area "PortSubscribe", "port_subscribe" + +#{get_int "PortSubscribe", "port_subscribe", "queue", + "Queue.T","Queue.imp"} +#{set_int "PortSubscribe", "port_subscribe", "queue", + "Queue.T","Queue.exp"} +#get_set_bool "PortSubscribe", "port_subscribe", "exclusive" +#get_set_bool "PortSubscribe", "port_subscribe", "time_update" +#get_set_bool "PortSubscribe", "port_subscribe", "time_real" + +-- Subscribe Query --------------------------------------------------------------- +#area "QuerySubscribe", "query_subscribe" + +#{get_int "QuerySubscribe", "query_subscribe", "client", + "Client.T", "Client.imp"} +#{set_int "QuerySubscribe", "query_subscribe", "client", + "Client.T", "Client.exp"} +#{get_int "QuerySubscribe", "query_subscribe", "port", + "Port.T", "Port.imp"} +#{set_int "QuerySubscribe", "query_subscribe", "port", + "Port.T", "Port.exp"} +#{get_int "QuerySubscribe", "query_subscribe", "type", + "QuerySubscribe.Type", "QuerySubscribe.impType"} +#{set_int "QuerySubscribe", "query_subscribe", "type", + "QuerySubscribe.Type", "QuerySubscribe.expType"} +#{get_int "QuerySubscribe", "query_subscribe", "index", + "Word", "fromIntegral"} +#{set_int "QuerySubscribe", "query_subscribe", "index", + "Word", "fromIntegral"} + +-- RO +#{get_int "QuerySubscribe", "query_subscribe", "num_subs", + "Word", "fromIntegral"} +#{get_int "QuerySubscribe", "query_subscribe", "queue", + "Queue.T", "Queue.imp"} +#get_bool "QuerySubscribe", "query_subscribe", "exclusive" +#get_bool "QuerySubscribe", "query_subscribe", "time_update" +#get_bool "QuerySubscribe", "query_subscribe", "time_real" -- Queue.T Info ------------------------------------------------------------------ #area "QueueInfo", "queue_info" diff --git a/src/Sound/ALSA/Sequencer/Client/Info.hs b/src/Sound/ALSA/Sequencer/Client/Info.hs --- a/src/Sound/ALSA/Sequencer/Client/Info.hs +++ b/src/Sound/ALSA/Sequencer/Client/Info.hs @@ -21,6 +21,7 @@ , queryFirst , queryNext , set + , modify , copy , clone @@ -37,12 +38,19 @@ , setName , setBroadcastFilter , setErrorBounce + + , filterClear + , filterAdd + , filterDel + , filterCheck ) where +import qualified Sound.ALSA.Sequencer.Client.Info.EventFilter as Filter 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.Sequencer.Marshal.Event as Event import qualified Sound.ALSA.Exception as Exc import Foreign.C.Types(CInt, ) @@ -61,10 +69,10 @@ 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) + 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_client_info" snd_seq_get_client_info :: Ptr Seq.Core -> Ptr T_ -> IO CInt @@ -72,11 +80,11 @@ 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 + 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_any_client_info" snd_seq_get_any_client_info :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt @@ -99,7 +107,7 @@ (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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_next_client" snd_seq_query_next_client :: Ptr Seq.Core -> Ptr T_ -> IO CInt @@ -109,8 +117,23 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_client_info" snd_seq_set_client_info :: Ptr Seq.Core -> Ptr T_ -> IO CInt + + +modify :: Seq.T mode -> (T -> IO T) -> IO () +modify ss f = set ss =<< f =<< get ss + + +filterClear :: T -> IO () +filterAdd :: Event.Type e => T -> e -> IO () +filterDel :: Event.Type e => T -> e -> IO () +filterCheck :: Event.Type e => T -> e -> IO Bool + +filterClear = Filter.clear +filterAdd = Filter.add +filterDel = Filter.delete +filterCheck = Filter.check copy :: T -> T -> IO () diff --git a/src/Sound/ALSA/Sequencer/Event.hs b/src/Sound/ALSA/Sequencer/Event.hs --- a/src/Sound/ALSA/Sequencer/Event.hs +++ b/src/Sound/ALSA/Sequencer/Event.hs @@ -29,16 +29,14 @@ , dropInput , dropInputBuffer - , volumeSame - , TimeStamp(..) , InstrCluster , Instr(..) , Sample(..) , Cluster(..) - , Volume(..) + , Volume(..), volumeSame - , Event.T(..) + , Event.T(..), simple , Event.Data(..) , NoteEv(..), Note(..), simpleNote , CtrlEv(..), Ctrl(..) @@ -50,6 +48,8 @@ ) where +import qualified Sound.ALSA.Sequencer.Address as Addr +import qualified Sound.ALSA.Sequencer.Queue as Queue import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq import Sound.ALSA.Sequencer.Marshal.Event as Event import qualified Sound.ALSA.Exception as Exc @@ -68,7 +68,7 @@ syncOutputQueue (Seq.Cons h) = Exc.checkResult_ "syncOutputQueue" =<< snd_seq_sync_output_queue h -foreign import ccall "alsa/asoundlib.h snd_seq_sync_output_queue" +foreign import ccall safe "alsa/asoundlib.h snd_seq_sync_output_queue" snd_seq_sync_output_queue :: Ptr Seq.Core -> IO CInt @@ -84,10 +84,10 @@ -- 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 + do Exc.checkResult_ "input" =<< snd_seq_event_input h p peek =<< peek p -foreign import ccall "alsa/asoundlib.h snd_seq_event_input" +foreign import ccall safe "alsa/asoundlib.h snd_seq_event_input" snd_seq_event_input :: Ptr Seq.Core -> Ptr (Ptr Event.T) -> IO CInt @@ -109,7 +109,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_event_input_pending" snd_seq_event_input_pending :: Ptr Seq.Core -> Int -> IO CInt @@ -127,7 +127,7 @@ 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" +foreign import ccall safe "alsa/asoundlib.h snd_seq_event_output" snd_seq_event_output :: Ptr Seq.Core -> Ptr Event.T -> IO CInt @@ -144,7 +144,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_event_output_buffer" snd_seq_event_output_buffer :: Ptr Seq.Core -> Ptr Event.T -> IO CInt @@ -161,7 +161,7 @@ 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" +foreign import ccall safe "alsa/asoundlib.h snd_seq_event_output_direct" snd_seq_event_output_direct :: Ptr Seq.Core -> Ptr Event.T -> IO CInt @@ -174,7 +174,7 @@ outputPending (Seq.Cons h) = fromIntegral `fmap` snd_seq_event_output_pending h -foreign import ccall "alsa/asoundlib.h snd_seq_event_output_pending" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_event_output_pending" snd_seq_event_output_pending :: Ptr Seq.Core -> IO CInt @@ -186,7 +186,7 @@ => 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 + alloca $ \p -> do Exc.checkResult_ "extractOutput" =<< snd_seq_extract_output h p peek =<< peek p -- | Remove the first event in output buffer. @@ -196,7 +196,7 @@ => 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_extract_output" snd_seq_extract_output :: Ptr Seq.Core -> Ptr (Ptr Event.T) -> IO CInt @@ -216,7 +216,7 @@ drainOutput (Seq.Cons h) = checkResult "drainOutput" =<< snd_seq_drain_output h -foreign import ccall "alsa/asoundlib.h snd_seq_drain_output" +foreign import ccall safe "alsa/asoundlib.h snd_seq_drain_output" snd_seq_drain_output :: Ptr Seq.Core -> IO CInt @@ -228,7 +228,7 @@ => 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_drop_output" snd_seq_drop_output :: Ptr Seq.Core -> IO CInt @@ -239,7 +239,7 @@ => 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_drop_output_buffer" snd_seq_drop_output_buffer :: Ptr Seq.Core -> IO CInt @@ -251,7 +251,7 @@ => 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_drop_input" snd_seq_drop_input :: Ptr Seq.Core -> IO CInt @@ -262,7 +262,7 @@ => 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_drop_input_buffer" snd_seq_drop_input_buffer :: Ptr Seq.Core -> IO CInt @@ -282,6 +282,23 @@ Event.noteDuration = 0 } +{- | +Construct an ALSA sequencer event from very few information. +Most fields are initialized with sensible defaults. +You may use this as a start and alter its fields for your special needs. + +> (Event.simple myAddr (Event.simpleNote 0 60 64)) {Event.dest = destAddr} +-} +simple :: Addr.T -> Event.Data -> Event.T +simple src bdy = Cons + { Event.highPriority = False + , Event.tag = 0 + , Event.queue = Queue.direct + , Event.timestamp = Event.TickTime 0 + , Event.source = src + , Event.dest = Addr.subscribers + , Event.body = bdy + } -- | Used for volume control: means do not change the volume. volumeSame :: Int16 diff --git a/src/Sound/ALSA/Sequencer/Event/Accessor.hs b/src/Sound/ALSA/Sequencer/Event/Accessor.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Event/Accessor.hs @@ -0,0 +1,47 @@ +module Sound.ALSA.Sequencer.Event.Accessor ( + highPriority, + tag, + queue, + timestamp, + source, + dest, + connect, + body, + ) where + +import qualified Sound.ALSA.Sequencer.Address as Addr +import qualified Sound.ALSA.Sequencer.Queue as Queue +import qualified Sound.ALSA.Sequencer.Marshal.Event as Event + +import qualified Data.Accessor.Basic as Acc + +import Data.Word (Word8, ) + + +highPriority :: Acc.T Event.T Bool +tag :: Acc.T Event.T Word8 +queue :: Acc.T Event.T Queue.T +timestamp :: Acc.T Event.T Event.TimeStamp +source :: Acc.T Event.T Addr.T +dest :: Acc.T Event.T Addr.T +connect :: Acc.T Event.T Event.Connect +body :: Acc.T Event.T Event.Data + +highPriority = + Acc.fromSetGet (\x ev -> ev{Event.highPriority = x}) Event.highPriority +tag = + Acc.fromSetGet (\x ev -> ev{Event.tag = x}) Event.tag +queue = + Acc.fromSetGet (\x ev -> ev{Event.queue = x}) Event.queue +timestamp = + Acc.fromSetGet (\x ev -> ev{Event.timestamp = x}) Event.timestamp +source = + Acc.fromSetGet (\x ev -> ev{Event.source = x}) Event.source +dest = + Acc.fromSetGet (\x ev -> ev{Event.dest = x}) Event.dest +connect = + Acc.fromSetGet + (\(Event.Connect src dst) ev -> ev{Event.source = src, Event.dest = dst}) + (\ev -> Event.Connect (Event.source ev) (Event.dest ev)) +body = + Acc.fromSetGet (\x ev -> ev{Event.body = x}) Event.body diff --git a/src/Sound/ALSA/Sequencer/Marshal/Event.hsc b/src/Sound/ALSA/Sequencer/Marshal/Event.hsc --- a/src/Sound/ALSA/Sequencer/Marshal/Event.hsc +++ b/src/Sound/ALSA/Sequencer/Marshal/Event.hsc @@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Sound.ALSA.Sequencer.Marshal.Event --- Copyright : (c) Henning Thielemann, 2010 +-- Copyright : (c) Henning Thielemann, 2011 -- (c) Iavor S. Diatchki, 2007 -- License : BSD3 -- @@ -33,12 +33,66 @@ (Storable, sizeOf, alignment, peek, poke, pokeByteOff, peekByteOff, ) import Foreign.Ptr (Ptr, castPtr, nullPtr, plusPtr, ) import Foreign.Marshal.Alloc (alloca, ) -import Data.Bits ((.|.), (.&.), ) +import Data.Monoid (mappend, ) +import qualified Data.FlagSet as FlagSet import Data.Int (Int16, Int32, ) import Data.Word (Word8, Word16, Word32, ) import Data.Array (Array, (!), accumArray, ) +data Flag +type Flags = FlagSet.T Word8 Flag +type FlagValue = FlagSet.MaskedValue Word8 Flag + + +timeStampTick, timeStampReal :: FlagValue +timeStampTick = + FlagSet.MaskedValue + #{const SND_SEQ_TIME_STAMP_MASK} + #{const SND_SEQ_TIME_STAMP_TICK} +timeStampReal = + FlagSet.MaskedValue + #{const SND_SEQ_TIME_STAMP_MASK} + #{const SND_SEQ_TIME_STAMP_REAL} + + +timeModeAbs, timeModeRel :: FlagValue +timeModeAbs = + FlagSet.MaskedValue + #{const SND_SEQ_TIME_MODE_MASK} + #{const SND_SEQ_TIME_MODE_ABS} +timeModeRel = + FlagSet.MaskedValue + #{const SND_SEQ_TIME_MODE_MASK} + #{const SND_SEQ_TIME_MODE_REL} + + +eventLengthFixed, eventLengthVariable, eventLengthVarUser :: FlagValue +eventLengthFixed = + FlagSet.MaskedValue + #{const SND_SEQ_EVENT_LENGTH_MASK} + #{const SND_SEQ_EVENT_LENGTH_FIXED} +eventLengthVariable = + FlagSet.MaskedValue + #{const SND_SEQ_EVENT_LENGTH_MASK} + #{const SND_SEQ_EVENT_LENGTH_VARIABLE} +eventLengthVarUser = + FlagSet.MaskedValue + #{const SND_SEQ_EVENT_LENGTH_MASK} + #{const SND_SEQ_EVENT_LENGTH_VARUSR} + + +priorityHigh, priorityNormal :: FlagValue +priorityHigh = + FlagSet.MaskedValue + #{const SND_SEQ_PRIORITY_MASK} + #{const SND_SEQ_PRIORITY_HIGH} +priorityNormal = + FlagSet.MaskedValue + #{const SND_SEQ_PRIORITY_MASK} + #{const SND_SEQ_PRIORITY_NORMAL} + + data Connect = Connect { connSource :: !Addr.T , connDest :: !Addr.T @@ -58,17 +112,16 @@ | RealTime !RealTime.T deriving Show -peekTimestamp :: Word8 -> Ptr TimeStamp -> IO TimeStamp +peekTimestamp :: Flags -> 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) - } + if FlagSet.match flags timeStampTick + then fmap TickTime $ peek $ castPtr p + else fmap RealTime $ peek $ castPtr p -pokeTimestamp :: Ptr TimeStamp -> TimeStamp -> IO Word8 +pokeTimestamp :: Ptr TimeStamp -> TimeStamp -> IO FlagValue 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} + TickTime t -> poke (castPtr p) t >> return timeStampTick + RealTime t -> poke (castPtr p) t >> return timeStampReal @@ -253,7 +306,7 @@ 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 + { highPriority = not $ FlagSet.match flags priorityNormal , tag = tg , queue = q , timestamp = time @@ -269,12 +322,13 @@ ; 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 + ; let flags = + (if highPriority e + then priorityHigh + else priorityNormal) + `mappend` real + `mappend` eventLengthFixed + ; #{poke snd_seq_event_t, flags} p (FlagSet.fromMaskedValue flags) } allocaEv :: T -> (Ptr T -> IO a) -> IO a @@ -284,14 +338,20 @@ allocaMaybeEv me h = maybe (h nullPtr) (\e -> allocaEv e h) me +pokeBody :: + (Storable d, Type e) => + Ptr Data -> e -> d -> IO Word8 +pokeBody p e d = + poke (castPtr p) d >> return (expEv e) + 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) + NoteEv e d -> pokeBody p e d + CtrlEv e d -> pokeBody p e d + AddrEv e d -> pokeBody p e d + ConnEv e d -> pokeBody p e d + CustomEv e d -> pokeBody p e d + EmptyEv e -> return (expEv e) peekData :: Array Word8 (Ptr Data -> IO Data) @@ -410,7 +470,7 @@ data NoteEv = ANote | NoteOn | NoteOff | KeyPress - deriving Show + deriving (Show, Eq, Ord, Enum, Bounded) data CtrlEv = Controller | PgmChange | ChanPress | PitchBend | Control14 @@ -418,7 +478,7 @@ | SongPos | SongSel | QFrame | TimeSign | KeySign - deriving Show + deriving (Show, Eq, Ord, Enum, Bounded) data QueueEv = QueueStart | QueueContinue @@ -430,33 +490,36 @@ | QueueTick | QueueSkew | QueueSyncPos - deriving Show + deriving (Show, Eq, Ord, Enum, Bounded) data EmptyEv = TuneRequest | Reset | Sensing | None | Unknown - deriving Show + deriving (Show, Eq, Ord, Enum, Bounded) data CustomEv = Echo | OSS | User0 | User1 | User2 | User3 | User4 | User5 | User6 | User7 | User8 | User9 - deriving Show + deriving (Show, Eq, Ord, Enum, Bounded) data AddrEv = ClientStart | ClientExit | ClientChange | PortStart | PortExit | PortChange - deriving Show + deriving (Show, Eq, Ord, Enum, Bounded) data ConnEv = PortSubscribed | PortUnsubscribed - deriving Show + deriving (Show, Eq, Ord, Enum, Bounded) -expNoteEv :: NoteEv -> Word8 -expNoteEv e = case e of +class Type e where + expEv :: e -> Word8 + +instance Type NoteEv where + expEv 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 +instance Type CtrlEv where + expEv e = case e of Controller -> #{const SND_SEQ_EVENT_CONTROLLER} PgmChange -> #{const SND_SEQ_EVENT_PGMCHANGE} ChanPress -> #{const SND_SEQ_EVENT_CHANPRESS} @@ -470,8 +533,8 @@ TimeSign -> #{const SND_SEQ_EVENT_TIMESIGN} KeySign -> #{const SND_SEQ_EVENT_KEYSIGN} -expQueueEv :: QueueEv -> Word8 -expQueueEv e = case e of +instance Type QueueEv where + expEv e = case e of QueueStart -> #{const SND_SEQ_EVENT_START} QueueContinue -> #{const SND_SEQ_EVENT_CONTINUE} QueueStop -> #{const SND_SEQ_EVENT_STOP} @@ -483,16 +546,16 @@ QueueSkew -> #{const SND_SEQ_EVENT_QUEUE_SKEW} QueueSyncPos -> #{const SND_SEQ_EVENT_SYNC_POS} -expEmptyEv :: EmptyEv -> Word8 -expEmptyEv e = case e of +instance Type EmptyEv where + expEv 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 +instance Type CustomEv where + expEv e = case e of Echo -> #{const SND_SEQ_EVENT_ECHO} OSS -> #{const SND_SEQ_EVENT_OSS} User0 -> #{const SND_SEQ_EVENT_USR0} @@ -506,8 +569,8 @@ User8 -> #{const SND_SEQ_EVENT_USR8} User9 -> #{const SND_SEQ_EVENT_USR9} -expAddrEv :: AddrEv -> Word8 -expAddrEv e = case e of +instance Type AddrEv where + expEv 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} @@ -515,29 +578,39 @@ PortExit -> #{const SND_SEQ_EVENT_PORT_EXIT} PortChange -> #{const SND_SEQ_EVENT_PORT_CHANGE} -expConnEv :: ConnEv -> Word8 -expConnEv e = case e of +instance Type ConnEv where + expEv e = case e of PortSubscribed -> #{const SND_SEQ_EVENT_PORT_SUBSCRIBED} PortUnsubscribed -> #{const SND_SEQ_EVENT_PORT_UNSUBSCRIBED} +maxEventType :: EmptyEv +maxEventType = maxBound + + +peekBody :: + (Storable d) => + (d -> Data) -> Ptr Data -> IO Data +peekBody makeBody p = + fmap makeBody (peek (castPtr p)) + peekNoteEv :: NoteEv -> Ptr Data -> IO Data -peekNoteEv e p = NoteEv e `fmap` peek (castPtr p) +peekNoteEv e = peekBody (NoteEv e) peekCtrlEv :: CtrlEv -> Ptr Data -> IO Data -peekCtrlEv e p = CtrlEv e `fmap` peek (castPtr p) +peekCtrlEv e = peekBody (CtrlEv e) peekAddrEv :: AddrEv -> Ptr Data -> IO Data -peekAddrEv e p = AddrEv e `fmap` peek (castPtr p) +peekAddrEv e = peekBody (AddrEv e) peekConnEv :: ConnEv -> Ptr Data -> IO Data -peekConnEv e p = ConnEv e `fmap` peek (castPtr p) +peekConnEv e = peekBody (ConnEv e) 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) +peekCustomEv e = peekBody (CustomEv e) data Data diff --git a/src/Sound/ALSA/Sequencer/Marshal/Port.hsc b/src/Sound/ALSA/Sequencer/Marshal/Port.hsc --- a/src/Sound/ALSA/Sequencer/Marshal/Port.hsc +++ b/src/Sound/ALSA/Sequencer/Marshal/Port.hsc @@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Sound.ALSA.Sequencer.Marshal --- Copyright : (c) Henning Thielemann, 2010 +-- Copyright : (c) Henning Thielemann, 2011 -- (c) Iavor S. Diatchki, 2007 -- License : BSD3 -- @@ -26,9 +26,11 @@ import qualified Sound.ALSA.Sequencer.Utility as U import Foreign.C.Types (CInt, CUInt, ) import Foreign.Storable (Storable, ) -import Data.Bits ((.|.), ) +import Data.Ix (Ix, range, index, inRange, rangeSize, ) import Data.Word (Word8, ) - +import Data.Maybe (fromMaybe, ) +import qualified Data.Ix.Enum as IxEnum +import qualified Data.EnumSet as EnumSet -- The type of client ports. @@ -46,11 +48,156 @@ imp p = Cons (fromIntegral p) +{- +We could also define + +> newtype CapabilityFlag = CapabilityFlag Int + +but the enumeration definition gives nicer Show instance. +-} +data CapabilityFlag = + CapOther Int {- ^ a capability that cannot be represented by the other constructors -} + | CapRead {- ^ readable from this port -} + | CapWrite {- ^ writable to this port -} + | CapSyncRead {- ^ allow read subscriptions -} + | CapSyncWrite {- ^ allow write subscriptions -} + | CapDuplex {- ^ allow read/write duplex -} + | CapSubsRead {- ^ allow read subscription -} + | CapSubsWrite {- ^ allow write subscription -} + | CapNoExport {- ^ routing not allowed -} + deriving (Eq, Ord, Show) + +data TypeFlag = + TypeOther Int {- ^ a type that cannot be represented by the other constructors -} + | TypeSpecific {- ^ hardware specific -} + | TypeMIDIGeneric {- ^ generic MIDI device -} + | TypeMIDIGM {- ^ General MIDI compatible device -} + | TypeMIDIGS {- ^ GS compatible device -} + | TypeMIDIXG {- ^ XG compatible device -} + | TypeMIDIMT32 {- ^ MT-32 compatible device -} + | TypeMIDIGM2 {- ^ General MIDI 2 compatible device -} + + | TypeSynth {- ^ Synth device -} + | TypeDirectSample {- ^ Sampling device (support sample download) -} + | TypeSample {- ^ Sampling device (sample can be downloaded at any time) -} + + | TypeHardware {- ^ This port is implemented in hardware. -} + | TypeSoftware {- ^ This port is implemented in software. -} + | TypeSynthesizer {- ^ Messages sent to this port will generate sounds. -} + | TypePort {- ^ This port may connect to other devices + (whose characteristics are not known). -} + | TypeApplication {- ^ application (sequencer/editor) -} + deriving (Eq, Ord, Show) + + +capFlagSet :: CapabilityFlag -> Cap +capFlagSet cap = + case cap of + CapOther n -> EnumSet.singletonByPosition n + CapRead -> capRead + CapWrite -> capWrite + CapSyncRead -> capSyncRead + CapSyncWrite -> capSyncWrite + CapDuplex -> capDuplex + CapSubsRead -> capSubsRead + CapSubsWrite -> capSubsWrite + CapNoExport -> capNoExport + +{- | +The Enum instance may not be very efficient, +but it should hardly be used, at all. +Better use constants such as 'capRead' and set manipulation. +If the binary logarithm is computed by constant unfolding, +performance would be better, but direct set manipulation is still faster. +We implement the 'Enum' instance in this way, +in order to stay independent from the particular ALSA definitions, +that may differ between platforms. +-} +instance Enum CapabilityFlag where + fromEnum cap = + case cap of + CapOther n -> n + _ -> EnumSet.mostSignificantPosition (capFlagSet cap) + toEnum n = + fromMaybe (CapOther n) $ + lookup (EnumSet.singletonByPosition n) $ + map (\cap -> (capFlagSet cap, cap)) $ + CapRead : + CapWrite : + CapSyncRead : + CapSyncWrite : + CapDuplex : + CapSubsRead : + CapSubsWrite : + CapNoExport : + [] + +instance Ix CapabilityFlag where + range = IxEnum.range + index = IxEnum.index + inRange = IxEnum.inRange + rangeSize = IxEnum.rangeSize + + +typeFlagSet :: TypeFlag -> Type +typeFlagSet typ = + case typ of + TypeOther n -> EnumSet.singletonByPosition n + TypeSpecific -> typeSpecific + TypeMIDIGeneric -> typeMidiGeneric + TypeMIDIGM -> typeMidiGM + TypeMIDIGS -> typeMidiGS + TypeMIDIXG -> typeMidiXG + TypeMIDIMT32 -> typeMidiMT32 + TypeMIDIGM2 -> typeMidiGM2 + TypeSynth -> typeSynth + TypeDirectSample -> typeDirectSample + TypeSample -> typeSample + TypeHardware -> typeHardware + TypeSoftware -> typeSoftware + TypeSynthesizer -> typeSynthesizer + TypePort -> typePort + TypeApplication -> typeApplication + +instance Enum TypeFlag where + fromEnum typ = + case typ of + TypeOther n -> n + _ -> EnumSet.mostSignificantPosition (typeFlagSet typ) + toEnum n = + fromMaybe (TypeOther n) $ + lookup (EnumSet.singletonByPosition n) $ + map (\typ -> (typeFlagSet typ, typ)) $ + TypeSpecific : + TypeMIDIGeneric : + TypeMIDIGM : + TypeMIDIGS : + TypeMIDIXG : + TypeMIDIMT32 : + TypeMIDIGM2 : + TypeSynth : + TypeDirectSample : + TypeSample : + TypeHardware : + TypeSoftware : + TypeSynthesizer : + TypePort : + TypeApplication : + [] + + +instance Ix TypeFlag where + range = IxEnum.range + index = IxEnum.index + inRange = IxEnum.inRange + rangeSize = IxEnum.rangeSize + + -- | Port capabilities. -newtype Cap = Cap { unCap :: CUInt } deriving (Eq,Ord) +type Cap = EnumSet.T CUInt CapabilityFlag -- | Port types. -newtype Type = Type { unType :: CUInt } deriving (Eq,Ord) +type Type = EnumSet.T CUInt TypeFlag #{enum T, Cons , systemTimer = SND_SEQ_PORT_SYSTEM_TIMER @@ -58,7 +205,7 @@ , unknown = SND_SEQ_ADDRESS_UNKNOWN } -#{enum Cap, Cap +#{enum Cap, EnumSet.Cons , capRead = SND_SEQ_PORT_CAP_READ , capWrite = SND_SEQ_PORT_CAP_WRITE , capSyncRead = SND_SEQ_PORT_CAP_SYNC_READ @@ -70,9 +217,9 @@ } caps :: [Cap] -> Cap -caps cs = Cap (foldl (.|.) 0 (map unCap cs)) +caps = EnumSet.unions -#{enum Type, Type +#{enum Type, EnumSet.Cons , typeSpecific = SND_SEQ_PORT_TYPE_SPECIFIC , typeMidiGeneric = SND_SEQ_PORT_TYPE_MIDI_GENERIC , typeMidiGM = SND_SEQ_PORT_TYPE_MIDI_GM @@ -93,4 +240,4 @@ } types :: [Type] -> Type -types cs = Type (foldl (.|.) 0 (map unType cs)) +types = EnumSet.unions diff --git a/src/Sound/ALSA/Sequencer/Marshal/QuerySubscribe.hsc b/src/Sound/ALSA/Sequencer/Marshal/QuerySubscribe.hsc new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Marshal/QuerySubscribe.hsc @@ -0,0 +1,21 @@ +module Sound.ALSA.Sequencer.Marshal.QuerySubscribe where + +#include +import Foreign.C.Types (CInt, ) + + +data Type = + Read + | Write + deriving (Show, Eq, Ord, Enum) + +expType :: Type -> CInt +expType t = case t of + Read -> #{const SND_SEQ_QUERY_SUBS_READ} + Write -> #{const SND_SEQ_QUERY_SUBS_WRITE} + +impType :: CInt -> Type +impType t = case t of + #{const SND_SEQ_QUERY_SUBS_READ} -> Read + #{const SND_SEQ_QUERY_SUBS_WRITE} -> Write + _ -> error ("QuerySubscribe.impType: unknown subscription type (" ++ show t ++ ")") diff --git a/src/Sound/ALSA/Sequencer/Port.hs b/src/Sound/ALSA/Sequencer/Port.hs --- a/src/Sound/ALSA/Sequencer/Port.hs +++ b/src/Sound/ALSA/Sequencer/Port.hs @@ -64,7 +64,7 @@ import qualified Sound.ALSA.Exception as Exc import Sound.ALSA.Sequencer.Area -import Foreign.C.Types (CInt, CUInt, ) +import Foreign.C.Types (CInt, ) import Foreign.C.String (CString, withCAString, ) import Foreign.Ptr (Ptr, ) @@ -76,12 +76,12 @@ -- | 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) = +createSimple (Seq.Cons h) s c 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 +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_create_simple_port" + snd_seq_create_simple_port :: Ptr Seq.Core -> CString -> Port.Cap -> Port.Type -> IO CInt @@ -90,7 +90,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_delete_simple_port" snd_seq_delete_simple_port :: Ptr Seq.Core -> CInt -> IO CInt @@ -110,7 +110,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_create_port" snd_seq_create_port :: Ptr Seq.Core -> Ptr PortInfo_ -> IO CInt -- | Delete the port. @@ -118,5 +118,5 @@ 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" +foreign import ccall unsafe "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 --- a/src/Sound/ALSA/Sequencer/Port/Info.hs +++ b/src/Sound/ALSA/Sequencer/Port/Info.hs @@ -79,10 +79,10 @@ 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)) + 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_port_info" snd_seq_get_port_info :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt @@ -91,11 +91,11 @@ 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 + 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_any_port_info" snd_seq_get_any_port_info :: Ptr Seq.Core -> CInt -> CInt -> Ptr T_ -> IO CInt @@ -115,7 +115,7 @@ 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" +foreign import ccall unsafe "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 @@ -124,7 +124,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_port_info" snd_seq_set_port_info :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt @@ -134,7 +134,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_info_get_addr" snd_seq_port_info_get_addr :: Ptr T_ -> IO (Ptr Addr.T) @@ -143,7 +143,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_info_set_addr" snd_seq_port_info_set_addr :: Ptr T_ -> Ptr Addr.T -> IO () diff --git a/src/Sound/ALSA/Sequencer/Queue.hs b/src/Sound/ALSA/Sequencer/Queue.hs --- a/src/Sound/ALSA/Sequencer/Queue.hs +++ b/src/Sound/ALSA/Sequencer/Queue.hs @@ -42,7 +42,7 @@ 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" +foreign import ccall unsafe "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 @@ -53,7 +53,7 @@ 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" +foreign import ccall unsafe "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 @@ -68,7 +68,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_free_queue" snd_seq_free_queue :: Ptr Seq.Core -> CInt -> IO CInt @@ -81,7 +81,7 @@ -> 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 + Event.allocaMaybeEv me $ \p -> Exc.checkResult_ "control_queue" =<< snd_seq_control_queue h (Queue.exp q) (fromIntegral $ Event.expEv a) (fromIntegral b) p -foreign import ccall "alsa/asoundlib.h snd_seq_control_queue" +foreign import ccall unsafe "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 --- a/src/Sound/ALSA/Sequencer/Queue/Info.hs +++ b/src/Sound/ALSA/Sequencer/Queue/Info.hs @@ -52,11 +52,11 @@ 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 + 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_queue_info" snd_seq_get_queue_info :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt @@ -64,7 +64,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_queue_info" snd_seq_set_queue_info :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt diff --git a/src/Sound/ALSA/Sequencer/Queue/Status.hs b/src/Sound/ALSA/Sequencer/Queue/Status.hs --- a/src/Sound/ALSA/Sequencer/Queue/Status.hs +++ b/src/Sound/ALSA/Sequencer/Queue/Status.hs @@ -44,11 +44,11 @@ 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 + 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_queue_status" snd_seq_get_queue_status :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt @@ -60,19 +60,19 @@ clone = Area.queue_status_clone -foreign import ccall "alsa/asoundlib.h" +foreign import ccall unsafe "alsa/asoundlib.h" snd_seq_queue_status_get_queue :: Ptr T_ -> IO CInt -foreign import ccall "alsa/asoundlib.h" +foreign import ccall unsafe "alsa/asoundlib.h" snd_seq_queue_status_get_events :: Ptr T_ -> IO CInt -foreign import ccall "alsa/asoundlib.h" +foreign import ccall unsafe "alsa/asoundlib.h" snd_seq_queue_status_get_tick_time :: Ptr T_ -> IO Word32 -foreign import ccall "alsa/asoundlib.h" +foreign import ccall unsafe "alsa/asoundlib.h" snd_seq_queue_status_get_real_time :: Ptr T_ -> IO (Ptr RealTime.T) -foreign import ccall "alsa/asoundlib.h" +foreign import ccall unsafe "alsa/asoundlib.h" snd_seq_queue_status_get_status :: Ptr T_ -> IO CUInt diff --git a/src/Sound/ALSA/Sequencer/Queue/Tempo.hs b/src/Sound/ALSA/Sequencer/Queue/Tempo.hs --- a/src/Sound/ALSA/Sequencer/Queue/Tempo.hs +++ b/src/Sound/ALSA/Sequencer/Queue/Tempo.hs @@ -48,11 +48,11 @@ 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 + 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_queue_tempo" snd_seq_get_queue_tempo :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt @@ -60,7 +60,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_queue_tempo" snd_seq_set_queue_tempo :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt diff --git a/src/Sound/ALSA/Sequencer/Queue/Timer.hs b/src/Sound/ALSA/Sequencer/Queue/Timer.hs --- a/src/Sound/ALSA/Sequencer/Queue/Timer.hs +++ b/src/Sound/ALSA/Sequencer/Queue/Timer.hs @@ -47,11 +47,11 @@ 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 + 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_queue_timer" snd_seq_get_queue_timer :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt @@ -59,7 +59,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_queue_timer" snd_seq_set_queue_timer :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt diff --git a/src/Sound/ALSA/Sequencer/RealTime.hs b/src/Sound/ALSA/Sequencer/RealTime.hs --- a/src/Sound/ALSA/Sequencer/RealTime.hs +++ b/src/Sound/ALSA/Sequencer/RealTime.hs @@ -7,7 +7,6 @@ import qualified Sound.ALSA.Sequencer.Marshal.RealTime as RealTime import Prelude hiding (fromInteger, toInteger, ) -import qualified Prelude as P nanoPerSecond :: Num a => a diff --git a/src/Sound/ALSA/Sequencer/Sequencer.hs b/src/Sound/ALSA/Sequencer/Sequencer.hs --- a/src/Sound/ALSA/Sequencer/Sequencer.hs +++ b/src/Sound/ALSA/Sequencer/Sequencer.hs @@ -42,7 +42,7 @@ 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" +foreign import ccall unsafe "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) @@ -60,7 +60,7 @@ -> IO () close (Seq.Cons h) = Exc.checkResult_ "close" =<< snd_seq_close h -foreign import ccall "alsa/asoundlib.h snd_seq_close" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_close" snd_seq_close :: Ptr Seq.Core -> IO CInt @@ -87,7 +87,7 @@ -> 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_name" snd_seq_name :: Ptr Seq.Core -> IO CString @@ -103,7 +103,7 @@ -> 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_nonblock" snd_seq_nonblock :: Ptr Seq.Core -> CInt -> IO CInt @@ -118,7 +118,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_output_buffer_size" snd_seq_get_output_buffer_size :: Ptr Seq.Core -> IO CSize @@ -132,7 +132,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_output_buffer_size" snd_seq_set_output_buffer_size :: Ptr Seq.Core -> CSize -> IO CInt @@ -144,7 +144,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_input_buffer_size" snd_seq_get_input_buffer_size :: Ptr Seq.Core -> IO CSize @@ -158,7 +158,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_input_buffer_size" snd_seq_set_input_buffer_size :: Ptr Seq.Core -> CSize -> IO CInt @@ -174,7 +174,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_client_pool_output" snd_seq_set_client_pool_output :: Ptr Seq.Core -> CSize -> IO CInt @@ -188,7 +188,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_client_pool_output_room" snd_seq_set_client_pool_output_room :: Ptr Seq.Core -> CSize -> IO CInt @@ -200,7 +200,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_reset_pool_output" snd_seq_reset_pool_output :: Ptr Seq.Core -> IO CInt @@ -214,7 +214,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_client_pool_input" snd_seq_set_client_pool_input :: Ptr Seq.Core -> CSize -> IO CInt @@ -226,7 +226,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_reset_pool_input" snd_seq_reset_pool_input :: Ptr Seq.Core -> IO CInt @@ -246,7 +246,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_connect_from" snd_seq_connect_from :: Ptr Seq.Core -> CInt -> CInt -> CInt -> IO CInt @@ -256,7 +256,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_connect_to" snd_seq_connect_to :: Ptr Seq.Core -> CInt -> CInt -> CInt -> IO CInt @@ -266,7 +266,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_disconnect_from" snd_seq_disconnect_from :: Ptr Seq.Core -> CInt -> CInt -> CInt -> IO CInt -- | Simple disconnection. @@ -275,7 +275,7 @@ 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" +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_disconnect_to" snd_seq_disconnect_to :: Ptr Seq.Core -> CInt -> CInt -> CInt -> IO CInt @@ -290,8 +290,8 @@ parseAddress (Seq.Cons h) s = alloca $ \pa -> withCAString s $ \ps -> - do Exc.checkResult "parse_address" =<< snd_seq_parse_address h pa 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" +foreign import ccall unsafe "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/Subscribe.hs b/src/Sound/ALSA/Sequencer/Subscribe.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Subscribe.hs @@ -0,0 +1,147 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Sound.ALSA.Sequencer.Subscribe +-- Copyright : (c) Dylan Simon, 2011 +-- License : BSD3 +-- +-- Stability : provisional +-- +-- This module contains functions for working with subscriptions. +-- Reference: +-- +-------------------------------------------------------------------------------- + +module Sound.ALSA.Sequencer.Subscribe + ( {- T + + , alloc + , copy + , clone + + , getSender + , getDest + , getQueue + , getExclusive + , getTimeUpdate + , getTimeReal + + , setSender + , setDest + , setQueue + , setExclusive + , setTimeUpdate + , setTimeReal + + , subscribePort + , unsubscribePort + + , create + , -} subscribe + , unsubscribe + ) where + +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.Sequencer.Marshal.Queue as Queue +import qualified Sound.ALSA.Exception as Exc + +import Foreign.C.Types (CInt, ) +import Foreign.Ptr (Ptr, ) +import Foreign.Marshal.Alloc (alloca, ) +import Foreign.Storable (peek, poke, ) + +type T = Area.PortSubscribe +type T_ = Area.PortSubscribe_ + +alloc :: IO T +_copy :: T -> T -> IO () +_clone :: T -> IO T +_getQueue :: T -> IO Queue.T +_getExclusive :: T -> IO Bool +_getTimeUpdate:: T -> IO Bool +_getTimeReal :: T -> IO Bool +setQueue :: T -> Queue.T -> IO () +setExclusive :: T -> Bool -> IO () +setTimeUpdate :: T -> Bool -> IO () +setTimeReal :: T -> Bool -> IO () + +alloc = Area.port_subscribe_malloc +_copy = Area.port_subscribe_copy +_clone = Area.port_subscribe_clone +_getQueue = Area.port_subscribe_get_queue +_getExclusive = Area.port_subscribe_get_exclusive +_getTimeUpdate= Area.port_subscribe_get_time_update +_getTimeReal = Area.port_subscribe_get_time_real +setQueue = Area.port_subscribe_set_queue +setExclusive = Area.port_subscribe_set_exclusive +setTimeUpdate = Area.port_subscribe_set_time_update +setTimeReal = Area.port_subscribe_set_time_real + +-- | Get sender address of a port subscription +_getSender :: T -> IO Addr.T +_getSender s = + peek =<< Area.with_port_subscribe s snd_seq_port_subscribe_get_sender + +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_get_sender" + snd_seq_port_subscribe_get_sender :: Ptr T_ -> IO (Ptr Addr.T) + +-- | Get destination address of a port subscription +_getDest :: T -> IO Addr.T +_getDest s = + peek =<< Area.with_port_subscribe s snd_seq_port_subscribe_get_dest + +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_get_dest" + snd_seq_port_subscribe_get_dest :: Ptr T_ -> IO (Ptr Addr.T) + +-- | Set sender address of a port subscription +setSender :: T -> Addr.T -> IO () +setSender s c = + alloca $ \p -> poke p c >> Area.with_port_subscribe s (`snd_seq_port_subscribe_set_sender` p) + +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_set_sender" + snd_seq_port_subscribe_set_sender :: Ptr T_ -> Ptr Addr.T -> IO () + +-- | Set destination address of a port subscription +setDest :: T -> Addr.T -> IO () +setDest s c = + alloca $ \p -> poke p c >> Area.with_port_subscribe s (`snd_seq_port_subscribe_set_dest` p) + +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_set_dest" + snd_seq_port_subscribe_set_dest :: Ptr T_ -> Ptr Addr.T -> IO () + +-- | Subscribe a port connection +subscribePort :: Seq.T mode -> T -> IO () +subscribePort (Seq.Cons h) s = + Exc.checkResult_ "subscribe_port" =<< Area.with_port_subscribe s (snd_seq_subscribe_port h) + +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_subscribe_port" + snd_seq_subscribe_port :: Ptr Seq.Core -> Ptr T_ -> IO CInt + +-- | Unsubscribe a connection between ports +unsubscribePort :: Seq.T mode -> T -> IO () +unsubscribePort (Seq.Cons h) s = + Exc.checkResult_ "unsubscribe_port" =<< Area.with_port_subscribe s (snd_seq_unsubscribe_port h) + +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_unsubscribe_port" + snd_seq_unsubscribe_port :: Ptr Seq.Core -> Ptr T_ -> IO CInt + +create :: Addr.T -> Addr.T -> Bool -> Maybe (Queue.T, Bool) -> IO T +create sender dest excl time = do + s <- alloc + setSender s sender + setDest s dest + setExclusive s excl + maybe (return ()) (\(queue, realtime) -> do + setTimeUpdate s True + setQueue s queue + setTimeReal s realtime) time + return s + +-- | Subscribe a port connection: @'subscribeSimple' sender dest exclusive (Just (updatequeue, realtime))@ +subscribe :: Seq.T mode -> Addr.T -> Addr.T -> Bool -> Maybe (Queue.T, Bool) -> IO () +subscribe ss sender dest excl time = subscribePort ss =<< create sender dest excl time + +-- | Unsubscribe a port connection: @'unsubscribeSimple' sender dest@ +unsubscribe :: Seq.T mode -> Addr.T -> Addr.T -> IO () +unsubscribe ss sender dest = unsubscribePort ss =<< create sender dest False Nothing diff --git a/src/Sound/ALSA/Sequencer/Subscribe/Query.hs b/src/Sound/ALSA/Sequencer/Subscribe/Query.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Subscribe/Query.hs @@ -0,0 +1,150 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Sound.ALSA.Sequencer.Subscribe.Query +-- Copyright : (c) Dylan Simon, 2011 +-- License : BSD3 +-- +-- Stability : provisional +-- +-- This module contains functions for working with subscriptions. +-- Reference: +-- +-------------------------------------------------------------------------------- + +module Sound.ALSA.Sequencer.Subscribe.Query + ( T + , Query.Type(..) + + {- + , alloc + , copy + , clone + -} + + , getClient + , getPort + , getRoot + , getType + , getIndex + , getNumSubs + , getAddr + , getQueue + , getExclusive + , getTimeUpdate + , getTimeReal + + {- + , setClient + , setPort + , setType + , setIndex + -} + + , query + , queryAll + ) where + +import qualified Sound.ALSA.Sequencer.Marshal.QuerySubscribe as Query +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.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.Exception as Exc + +import Foreign.C.Error (Errno(Errno), eNOENT, ) +import Foreign.C.Types (CInt, ) +import Foreign.Ptr (Ptr, ) +import Foreign.Marshal.Alloc (alloca, ) +import Foreign.Storable (peek, poke, ) +import Data.Word (Word, ) + +type T = Area.QuerySubscribe +type T_ = Area.QuerySubscribe_ + +alloc :: IO T +_copy :: T -> T -> IO () +_clone :: T -> IO T +getClient :: T -> IO Client.T +getPort :: T -> IO Port.T +getType :: T -> IO Query.Type +getIndex :: T -> IO Word +getNumSubs :: T -> IO Word +getQueue :: T -> IO Queue.T +getExclusive :: T -> IO Bool +getTimeUpdate :: T -> IO Bool +getTimeReal :: T -> IO Bool +_setClient :: T -> Client.T -> IO () +_setPort :: T -> Port.T -> IO () +setType :: T -> Query.Type -> IO () +setIndex :: T -> Word -> IO () + +alloc = Area.query_subscribe_malloc +_copy = Area.query_subscribe_copy +_clone = Area.query_subscribe_clone +getClient = Area.query_subscribe_get_client +getPort = Area.query_subscribe_get_port +getType = Area.query_subscribe_get_type +getIndex = Area.query_subscribe_get_index +getNumSubs = Area.query_subscribe_get_num_subs +getQueue = Area.query_subscribe_get_queue +getExclusive = Area.query_subscribe_get_exclusive +getTimeUpdate = Area.query_subscribe_get_time_update +getTimeReal = Area.query_subscribe_get_time_real +_setClient = Area.query_subscribe_set_client +_setPort = Area.query_subscribe_set_port +setType = Area.query_subscribe_set_type +setIndex = Area.query_subscribe_set_index + +-- | Get the client/port address of a query +getRoot :: T -> IO Addr.T +getRoot q = + peek =<< Area.with_query_subscribe q snd_seq_query_subscribe_get_root + +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_get_root" + snd_seq_query_subscribe_get_root :: Ptr T_ -> IO (Ptr Addr.T) + +-- | Get the address of subscriber of query +getAddr :: T -> IO Addr.T +getAddr q = + peek =<< Area.with_query_subscribe q snd_seq_query_subscribe_get_addr + +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_get_addr" + snd_seq_query_subscribe_get_addr :: Ptr T_ -> IO (Ptr Addr.T) + + +-- | Set the client/port address of a query +setRoot :: T -> Addr.T -> IO () +setRoot q c = + alloca $ \p -> poke p c >> Area.with_query_subscribe q (`snd_seq_query_subscribe_set_root` p) + +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_set_root" + snd_seq_query_subscribe_set_root :: Ptr T_ -> Ptr Addr.T -> IO () + + +-- | Query port subscriber list +queryPort :: Seq.T mode -> T -> IO Bool +queryPort (Seq.Cons h) q = + Exc.checkResultMaybe "query_port_subscribers" (const True) (\e -> if Errno (negate e) == eNOENT then Just False else Nothing) =<< + Area.with_query_subscribe q (snd_seq_query_port_subscribers h) + +foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_port_subscribers" + snd_seq_query_port_subscribers :: Ptr Seq.Core -> Ptr T_ -> IO CInt + +-- | Queries a subscriber connected to (Write) or from (Read) a given address: @'query' seq addr typ index@ +query :: Seq.T mode -> Addr.T -> Query.Type -> Word -> IO (Maybe T) +query ss root t i = do + q <- alloc + setRoot q root + setType q t + setIndex q i + r <- queryPort ss q + return $ if r then Just q else Nothing + +-- | Queries the list of subscribers accessing a port +queryAll :: Seq.T mode -> Addr.T -> Query.Type -> IO [T] +queryAll ss root t = queryRest 0 where + queryRest i = query ss root t i >>= + maybe (return []) (\q -> (q:) `fmap` queryRest (succ i)) +