diff --git a/Bindings/PortAudio.hsc b/Bindings/PortAudio.hsc --- a/Bindings/PortAudio.hsc +++ b/Bindings/PortAudio.hsc @@ -221,7 +221,7 @@ #ccall Pa_OpenStream , Ptr (Ptr ) -> Ptr -> Ptr -> CDouble -> CULong -> CULong -> -> Ptr () -> IO CInt #ccall Pa_OpenDefaultStream , Ptr (Ptr ) -> CInt -> CInt -> CULong -> CDouble -> CULong -> -> Ptr () -> IO CInt #ccall Pa_CloseStream , Ptr -> IO CInt -#ccall Pa_SetStreamFinishedCallback , Ptr -> Ptr -> IO CInt +#ccall Pa_SetStreamFinishedCallback , Ptr -> -> IO CInt #ccall Pa_StartStream , Ptr -> IO CInt #ccall Pa_StopStream , Ptr -> IO CInt #ccall Pa_AbortStream , Ptr -> IO CInt diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -0,0 +1,6 @@ +0.3 +---- + +* `withStream` no longer starts a stream on its own +* Added `withStartStream` and `setStreamFinishedCallback` +* Removed `Closed` in favour of `()` diff --git a/System/PortAudio.hs b/System/PortAudio.hs --- a/System/PortAudio.hs +++ b/System/PortAudio.hs @@ -10,13 +10,18 @@ , Input , Output -- * Opening a stream + , Stream , withStream , StreamCallbackResult(..) + , startStream + , stopStream + , withStartStream + , isStreamStopped + , setStreamFinishedCallback -- * Stream parameters , StreamParameters , streamParameters , PortAudioSample - , Closed(..) , noConnection -- * Timestamps and status flags , Status(..) @@ -198,8 +203,10 @@ , inputOverflow :: !Bool , outputUnderflow :: !Bool , outputOverflow :: !Bool - , primingOutput :: !Bool } + , primingOutput :: !Bool } deriving (Show, Eq, Ord) +newtype Stream = Stream { unStream :: Ptr C'PaStream } + withStream :: (Storable i, Storable o) => Double -- ^ sampling rate -> Int -- ^ buffer size @@ -207,7 +214,7 @@ -> Maybe (StreamParameters Output o) -> StreamFlags -> (Status -> V.Vector i -> MV.IOVector o -> IO StreamCallbackResult) -- ^ callback - -> IO r + -> (Stream -> IO r) -> IO r withStream rate buf paramI paramO (StreamFlags flags) f m = withMaybe paramI $ \pin -> withMaybe paramO $ \pout -> do @@ -222,19 +229,27 @@ cb nullPtr peek ps - alloca $ \ps -> bracket (opener ps) (wrap . c'Pa_CloseStream) - $ \s -> bracket_ (wrap $ c'Pa_StartStream s) (wrap $ c'Pa_StopStream s) m + alloca $ \ps -> bracket (opener ps) (wrap . c'Pa_CloseStream) $ m . Stream -data Closed = Closed +startStream :: Stream -> IO () +startStream = wrap . c'Pa_StartStream . unStream -instance Storable Closed where - sizeOf _ = 0 - alignment _ = 1 - peek _ = return Closed - poke _ _ = return () +stopStream :: Stream -> IO () +stopStream = wrap . c'Pa_StopStream . unStream +setStreamFinishedCallback :: Stream -> IO () -> IO () +setStreamFinishedCallback (Stream s) m = do + cb <- mk'PaStreamFinishedCallback (const m) + wrap $ c'Pa_SetStreamFinishedCallback s cb + +isStreamStopped :: Stream -> IO Bool +isStreamStopped = fmap (==1) . c'Pa_IsStreamStopped . unStream + +withStartStream :: Stream -> IO r -> IO r +withStartStream s = bracket_ (startStream s) (stopStream s) + -- | This is 'Nothing', but it explicitly specifies the stream type with zero-width unit type. -noConnection :: Maybe (StreamParameters t Closed) +noConnection :: Maybe (StreamParameters t ()) noConnection = Nothing callback :: (Storable a, Storable b) => (Status -> V.Vector a -> MV.IOVector b -> IO StreamCallbackResult) -> Ptr () -> Ptr () -> CULong -> Ptr C'PaStreamCallbackTimeInfo -> CULong -> z -> IO CUInt diff --git a/bindings-portaudio.cabal b/bindings-portaudio.cabal --- a/bindings-portaudio.cabal +++ b/bindings-portaudio.cabal @@ -1,8 +1,9 @@ cabal-version: 2.4 name: bindings-portaudio -version: 0.2.1 +version: 0.3 category: Sound +copyright: Copyright (c) 2020 Fumiaki Kinoshita author: Fumiaki Kinoshita maintainer: Fumiaki Kinoshita @@ -53,15 +54,13 @@ default-language: Haskell2010 ghc-options: -Wall -O2 - if impl(ghc >= 6.8) - ghc-options: -fwarn-tabs exposed-modules: Bindings.PortAudio System.PortAudio - build-tools: - hsc2hs + build-tool-depends: + hsc2hs:hsc2hs build-depends: base < 5, bindings-DSL ^>= 1.0, vector diff --git a/example/example-portaudio.cabal b/example/example-portaudio.cabal --- a/example/example-portaudio.cabal +++ b/example/example-portaudio.cabal @@ -23,6 +23,7 @@ , bindings-portaudio , vector >= 0.10 && < 0.13 , linear + , optparse-applicative -- hs-source-dirs: ghc-options: -threaded -Wall -O2 default-language: Haskell2010 diff --git a/example/sine.hs b/example/sine.hs --- a/example/sine.hs +++ b/example/sine.hs @@ -1,11 +1,12 @@ {-# LANGUAGE ViewPatterns, LambdaCase #-} +{-# LANGUAGE ApplicativeDo #-} import System.PortAudio import Control.Concurrent +import Control.Monad import Linear (V2(..)) import qualified Data.Vector as V import qualified Data.Vector.Storable.Mutable as MV -import System.Environment -import System.Exit +import Options.Applicative period :: Int period = 128 @@ -30,17 +31,24 @@ 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 +main = join $ execParser (info app mempty) -usageExit :: IO () -usageExit = do - pname <- getProgName - putStrLn $ "\nUsage: " ++ pname ++ " \n" - exitSuccess +app :: Parser (IO ()) +app = do + rate <- option auto $ long "rate" <> help "sampling rate" <> value 44100 + buf <- option auto $ long "buffer" <> help "number of samples for the buffer" <> value 1024 + device <- option auto $ long "device" <> help "device index" <> value (-1) + helper + pure $ withPortAudio $ do + (_, devs) <- getDevices + if device < 0 + then forM_ (zip [0 :: Int ..] devs) $ \(i, dev) -> + putStrLn $ show i ++ ": " ++ deviceName dev + else do + let dev = devs !! device + phase <- newMVar 0 + let output = streamParameters dev 0 + withStream rate buf noConnection output mempty (callback phase) + $ \s -> do + setStreamFinishedCallback s $ putStrLn "Done" + withStartStream s $ threadDelay $ 1000 * 1000