bindings-portaudio 0.2 → 0.2.1

raw patch · 5 files changed

+69/−70 lines, 5 filesdep ~bindings-DSLPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: bindings-DSL

API changes (from Hackage documentation)

Files

• CHANGELOG.md +0/−0
• System/PortAudio.hs +17/−14
• bindings-portaudio.cabal +5/−4
• example/example-portaudio.cabal +1/−1
• example/sine.hs +46/−51

@@ -152,9 +152,11 @@  newtype StreamFlags = StreamFlags CULong +instance Semigroup StreamFlags where+  StreamFlags a <> StreamFlags b = StreamFlags (a .|. b)+ instance Monoid StreamFlags where   mempty = StreamFlags 0-  StreamFlags a `mappend` StreamFlags b = StreamFlags (a .|. b)  clipOff :: StreamFlags clipOff = StreamFlags 0x00000001@@ -168,23 +170,25 @@ primeOutputBuffersUsingStreamCallback :: StreamFlags primeOutputBuffersUsingStreamCallback = StreamFlags 0x00000008 -w :: IO CInt -> IO ()-w n = do+wrap :: IO CInt -> IO ()+wrap n = do   r <- n   unless (r == 0) $ throwIO $ fromErrorCode r  withPortAudio :: IO a -> IO a-withPortAudio = bracket_ (w c'Pa_Initialize) (w c'Pa_Terminate)+withPortAudio = bracket_ (wrap c'Pa_Initialize) (wrap c'Pa_Terminate)  data StreamCallbackResult = Continue | Complete | Abort deriving (Show, Eq, Ord, Enum) +instance Semigroup StreamCallbackResult where+  Complete <> x = x+  x <> Complete = x+  Abort <> _ = Abort+  _ <> Abort = Abort+  Continue <> Continue = Continue+ instance Monoid StreamCallbackResult where   mempty = Complete-  mappend Complete x = x-  mappend x Complete = x-  mappend Abort _ = Abort-  mappend _ Abort = Abort-  mappend Continue Continue = Continue  data Status = Status   { currentTime :: !Double@@ -208,9 +212,8 @@ withStream rate buf paramI paramO (StreamFlags flags) f m =   withMaybe paramI $ \pin -> withMaybe paramO $ \pout -> do     cb <- mk'PaStreamCallback $ callback f-    let opener = do-          ps <- malloc-          w $ c'Pa_OpenStream ps+    let opener ps = do+          wrap $ c'Pa_OpenStream ps               (castPtr pin)               (castPtr pout)               (CDouble rate)@@ -219,8 +222,8 @@               cb               nullPtr           peek ps-    bracket opener (\s -> w (c'Pa_CloseStream s) >> free s)-      $ \s -> bracket_ (w $ c'Pa_StartStream s) (w $ c'Pa_StopStream s) m+    alloca $ \ps -> bracket (opener ps) (wrap . c'Pa_CloseStream)+      $ \s -> bracket_ (wrap $ c'Pa_StartStream s) (wrap $ c'Pa_StopStream s) m  data Closed = Closed 

@@ -1,16 +1,16 @@+cabal-version: 2.4 name:         bindings-portaudio-version:      0.2+version:      0.2.1 category:     Sound  author:       Fumiaki Kinoshita <fumiexcel@gmail.com> maintainer:   Fumiaki Kinoshita <fumiexcel@gmail.com> -license:      BSD3+license:      BSD-3-Clause license-file: LICENSE  synopsis:     Low-level bindings to portaudio library description:-cabal-version: >= 1.10 build-type:    Simple  extra-source-files:@@ -26,6 +26,7 @@   extra.c   LICENSE   README.md+  CHANGELOG.md   example/*.hs   example/example-portaudio.cabal   example/LICENSE@@ -63,7 +64,7 @@     hsc2hs    build-depends:-    base          < 5, bindings-DSL == 1.0.*, vector+    base          < 5, bindings-DSL ^>= 1.0, vector    cc-options: -g 

@@ -21,7 +21,7 @@   -- other-extensions:   build-depends:       base >=4.6 && < 5                      , bindings-portaudio-                     , vector >= 0.10 && < 0.12+                     , vector >= 0.10 && < 0.13                      , linear   -- hs-source-dirs:   ghc-options: -threaded -Wall -O2

@@ -1,51 +1,46 @@-{-# LANGUAGE ViewPatterns, LambdaCase #-}
-import System.PortAudio
-import Control.Applicative
-import Control.Concurrent
-import Control.Monad
-import Foreign.C.String
-import Foreign.C.Types
-import Foreign hiding (void)
-import Linear (V2(..))
-import qualified Data.Vector as V
-import qualified Data.Vector.Storable.Mutable as MV
-import System.Environment
-import System.Exit
-
-period :: Int
-period = 128
-
-table :: V.Vector Float
-table = V.fromList [sin t | i <- [0..period - 1], let t = fromIntegral i / fromIntegral period * 2 * pi]
-
-callback :: MVar Int -> Status -> input -> MV.IOVector (V2 Float) -> IO StreamCallbackResult
-callback phase _ _ o = do
-  i0 <- takeMVar phase
-  go i0 0
-  putMVar phase $ i0 + n
-  return Continue
-  where
-    n = MV.length o
-    go :: Int -> Int -> IO ()
-    go i0 i
-      | i == n = return ()
-      | otherwise = do
-        let v = table V.! ((i0 + i) `mod` period)
-        MV.write o i (V2 v v)
-        go i0 (i + 1)
-
-main :: IO ()
-main = getArgs >>= \case
-  ((read -> rate) : (read -> buf) : _) -> withPortAudio $ do
-    (_, dev : _) <- getDevices
-    phase <- newMVar 0
-    let output = streamParameters dev 0
-    withStream rate buf noConnection output mempty (callback phase)
-      $ threadDelay $ 1000 * 1000
-  _ -> usageExit
-
-usageExit :: IO ()
-usageExit = do
-  pname <- getProgName
-  putStrLn $ "\nUsage: " ++ pname ++ " <sample rate> <buffer size>\n"
-  exitSuccess
+{-# LANGUAGE ViewPatterns, LambdaCase #-}+import System.PortAudio+import Control.Concurrent+import Linear (V2(..))+import qualified Data.Vector as V+import qualified Data.Vector.Storable.Mutable as MV+import System.Environment+import System.Exit++period :: Int+period = 128++table :: V.Vector Float+table = V.fromList [sin t | i <- [0..period - 1], let t = fromIntegral i / fromIntegral period * 2 * pi]++callback :: MVar Int -> Status -> input -> MV.IOVector (V2 Float) -> IO StreamCallbackResult+callback phase _ _ o = do+  i0 <- takeMVar phase+  go i0 0+  putMVar phase $ i0 + n+  return Continue+  where+    n = MV.length o+    go :: Int -> Int -> IO ()+    go i0 i+      | i == n = return ()+      | otherwise = do+        let v = table V.! ((i0 + i) `mod` period)+        MV.write o i (V2 v v)+        go i0 (i + 1)++main :: IO ()+main = getArgs >>= \case+  ((read -> rate) : (read -> buf) : _) -> withPortAudio $ do+    (_, dev : _) <- getDevices+    phase <- newMVar 0+    let output = streamParameters dev 0+    withStream rate buf noConnection output mempty (callback phase)+      $ threadDelay $ 1000 * 1000+  _ -> usageExit++usageExit :: IO ()+usageExit = do+  pname <- getProgName+  putStrLn $ "\nUsage: " ++ pname ++ " <sample rate> <buffer size>\n"+  exitSuccess