{-# LANGUAGE RebindableSyntax #-}
module Synthesizer.ALSA.Storable.Play (
Device,
defaultDevice,
defaultChunkSize,
makeSink,
write,
writeLazy,
auto,
autoAndRecord,
autoAndRecordMany,
monoToInt16,
stereoToInt16,
) where
import qualified Sound.ALSA.PCM as ALSA
import qualified Synthesizer.Frame.Stereo as Stereo
import qualified Synthesizer.Basic.Binary as BinSmp
import qualified Sound.Sox.Frame as SoxFrame
import qualified Sound.Sox.Write as SoxWrite
import qualified Sound.Sox.Option.Format as SoxOption
import Foreign.Storable (Storable, )
import Foreign.Marshal.Array (advancePtr, )
import Foreign.Ptr (Ptr, minusPtr, )
import Data.Int (Int16, )
import qualified System.IO as IO
import qualified System.Exit as Exit
import qualified Synthesizer.Storable.Signal as SigSt
import qualified Data.StorableVector.Lazy as SVL
import qualified Data.StorableVector.Base as SVB
import qualified Algebra.RealRing as RealRing
import qualified Data.Traversable as Trav
import qualified Data.Foldable as Fold
import NumericPrelude.Numeric
import NumericPrelude.Base
defaultChunkSize :: SigSt.ChunkSize
defaultChunkSize :: ChunkSize
defaultChunkSize = Int -> ChunkSize
SigSt.chunkSize Int
512
type Device = String
defaultDevice :: Device
defaultDevice :: Device
defaultDevice = Device
"default"
makeSink ::
(ALSA.SampleFmt y, RealRing.C t) =>
Device ->
t ->
ALSA.SampleFreq ->
ALSA.SoundSink ALSA.Pcm y
makeSink :: Device -> t -> Int -> SoundSink Pcm y
makeSink Device
device t
periodTime Int
rate =
Device -> SoundFmt y -> SoundBufferTime -> SoundSink Pcm y
forall y.
SampleFmt y =>
Device -> SoundFmt y -> SoundBufferTime -> SoundSink Pcm y
ALSA.alsaSoundSinkTime Device
device
(SoundFmt :: forall y. Int -> SoundFmt y
ALSA.SoundFmt {
sampleFreq :: Int
ALSA.sampleFreq = Int
rate
}) (SoundBufferTime -> SoundSink Pcm y)
-> SoundBufferTime -> SoundSink Pcm y
forall a b. (a -> b) -> a -> b
$
Int -> Int -> SoundBufferTime
ALSA.SoundBufferTime
(t -> Int
forall a b. (C a, C b) => a -> b
round (t
5000000t -> t -> t
forall a. C a => a -> a -> a
*t
periodTime))
(t -> Int
forall a b. (C a, C b) => a -> b
round (t
1000000t -> t -> t
forall a. C a => a -> a -> a
*t
periodTime))
{-# INLINE auto #-}
auto ::
(ALSA.SampleFmt y) =>
ALSA.SoundSink handle y ->
SigSt.T y -> IO ()
auto :: SoundSink handle y -> T y -> IO ()
auto SoundSink handle y
sink T y
ys =
SoundSink handle y -> (handle y -> IO ()) -> IO ()
forall (handle :: * -> *) y a.
SoundSink handle y -> (handle y -> IO a) -> IO a
ALSA.withSoundSink SoundSink handle y
sink ((handle y -> IO ()) -> IO ()) -> (handle y -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \handle y
to ->
SoundSink handle y -> handle y -> T y -> IO ()
forall y (handle :: * -> *).
Storable y =>
SoundSink handle y -> handle y -> Vector y -> IO ()
writeLazy SoundSink handle y
sink handle y
to T y
ys
{-# INLINE writeLazy #-}
writeLazy ::
(Storable y) =>
ALSA.SoundSink handle y -> handle y ->
SVL.Vector y -> IO ()
writeLazy :: SoundSink handle y -> handle y -> Vector y -> IO ()
writeLazy SoundSink handle y
sink handle y
to Vector y
ys =
(Vector y -> IO ()) -> [Vector y] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (SoundSink handle y -> handle y -> Vector y -> IO ()
forall y (handle :: * -> *).
Storable y =>
SoundSink handle y -> handle y -> Vector y -> IO ()
write SoundSink handle y
sink handle y
to) (Vector y -> [Vector y]
forall a. Vector a -> [Vector a]
SVL.chunks Vector y
ys)
{-# INLINE write #-}
write ::
(Storable y) =>
ALSA.SoundSink handle y -> handle y ->
SVB.Vector y -> IO ()
write :: SoundSink handle y -> handle y -> Vector y -> IO ()
write SoundSink handle y
sink handle y
to Vector y
c =
Vector y -> (Ptr y -> Int -> IO ()) -> IO ()
forall a b.
Storable a =>
Vector a -> (Ptr a -> Int -> IO b) -> IO b
SVB.withStartPtr Vector y
c ((Ptr y -> Int -> IO ()) -> IO ())
-> (Ptr y -> Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr y
ptr Int
size ->
SoundSink handle y -> handle y -> Ptr y -> Int -> IO ()
forall (handle :: * -> *) y.
SoundSink handle y -> handle y -> Ptr y -> Int -> IO ()
ALSA.soundSinkWrite SoundSink handle y
sink handle y
to Ptr y
ptr Int
size
{-# INLINE arraySize #-}
arraySize :: Storable y => Ptr y -> Int -> Int
arraySize :: Ptr y -> Int -> Int
arraySize Ptr y
p Int
n = Ptr y -> Int -> Ptr y
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr y
p Int
n Ptr y -> Ptr y -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr y
p
{-# INLINE autoAndRecord #-}
autoAndRecord ::
(ALSA.SampleFmt y, SoxFrame.C y) =>
FilePath ->
ALSA.SoundFmt y ->
ALSA.SoundSink handle y ->
SigSt.T y -> IO Exit.ExitCode
autoAndRecord :: Device -> SoundFmt y -> SoundSink handle y -> T y -> IO ExitCode
autoAndRecord Device
fileName SoundFmt y
fmt SoundSink handle y
sink =
let rate :: Int
rate = SoundFmt y -> Int
forall y. SoundFmt y -> Int
ALSA.sampleFreq SoundFmt y
fmt
in (\Handle -> T y -> IO ()
act ->
(Handle -> T y -> IO ())
-> T -> Device -> Int -> T y -> IO ExitCode
forall y (sig :: * -> *).
C y =>
(Handle -> sig y -> IO ())
-> T -> Device -> Int -> sig y -> IO ExitCode
SoxWrite.simple Handle -> T y -> IO ()
act T
SoxOption.none Device
fileName Int
rate) ((Handle -> T y -> IO ()) -> T y -> IO ExitCode)
-> (Handle -> T y -> IO ()) -> T y -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ \Handle
h T y
ys ->
SoundSink handle y -> (handle y -> IO ()) -> IO ()
forall (handle :: * -> *) y a.
SoundSink handle y -> (handle y -> IO a) -> IO a
ALSA.withSoundSink SoundSink handle y
sink ((handle y -> IO ()) -> IO ()) -> (handle y -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \handle y
to ->
((Vector y -> IO ()) -> [Vector y] -> IO ())
-> [Vector y] -> (Vector y -> IO ()) -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Vector y -> IO ()) -> [Vector y] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (T y -> [Vector y]
forall a. Vector a -> [Vector a]
SVL.chunks T y
ys) ((Vector y -> IO ()) -> IO ()) -> (Vector y -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Vector y
c ->
Vector y -> (Ptr y -> Int -> IO ()) -> IO ()
forall a b.
Storable a =>
Vector a -> (Ptr a -> Int -> IO b) -> IO b
SVB.withStartPtr Vector y
c ((Ptr y -> Int -> IO ()) -> IO ())
-> (Ptr y -> Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr y
ptr Int
size ->
SoundSink handle y -> handle y -> Ptr y -> Int -> IO ()
forall (handle :: * -> *) y.
SoundSink handle y -> handle y -> Ptr y -> Int -> IO ()
ALSA.soundSinkWrite SoundSink handle y
sink handle y
to Ptr y
ptr Int
size IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Handle -> Ptr y -> Int -> IO ()
forall a. Handle -> Ptr a -> Int -> IO ()
IO.hPutBuf Handle
h Ptr y
ptr (Ptr y -> Int -> Int
forall y. Storable y => Ptr y -> Int -> Int
arraySize Ptr y
ptr Int
size)
{-# INLINE autoAndRecordMany #-}
autoAndRecordMany ::
(ALSA.SampleFmt y, SoxFrame.C y,
Trav.Traversable f) =>
f FilePath ->
ALSA.SoundFmt y ->
ALSA.SoundSink handle y ->
SigSt.T y -> IO (f Exit.ExitCode)
autoAndRecordMany :: f Device
-> SoundFmt y -> SoundSink handle y -> T y -> IO (f ExitCode)
autoAndRecordMany f Device
fileNames SoundFmt y
fmt SoundSink handle y
sink =
let rate :: Int
rate = SoundFmt y -> Int
forall y. SoundFmt y -> Int
ALSA.sampleFreq SoundFmt y
fmt
in (\f Handle -> T y -> IO ()
act ->
(f Handle -> T y -> IO ())
-> T -> T -> f Device -> Int -> T y -> IO (f ExitCode)
forall y (f :: * -> *) (sig :: * -> *).
(C y, Traversable f) =>
(f Handle -> sig y -> IO ())
-> T -> T -> f Device -> Int -> sig y -> IO (f ExitCode)
SoxWrite.manyExtended f Handle -> T y -> IO ()
act T
SoxOption.none T
SoxOption.none f Device
fileNames Int
rate) ((f Handle -> T y -> IO ()) -> T y -> IO (f ExitCode))
-> (f Handle -> T y -> IO ()) -> T y -> IO (f ExitCode)
forall a b. (a -> b) -> a -> b
$ \f Handle
hs T y
ys ->
SoundSink handle y -> (handle y -> IO ()) -> IO ()
forall (handle :: * -> *) y a.
SoundSink handle y -> (handle y -> IO a) -> IO a
ALSA.withSoundSink SoundSink handle y
sink ((handle y -> IO ()) -> IO ()) -> (handle y -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \handle y
to ->
((Vector y -> IO ()) -> [Vector y] -> IO ())
-> [Vector y] -> (Vector y -> IO ()) -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Vector y -> IO ()) -> [Vector y] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (T y -> [Vector y]
forall a. Vector a -> [Vector a]
SVL.chunks T y
ys) ((Vector y -> IO ()) -> IO ()) -> (Vector y -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Vector y
c ->
Vector y -> (Ptr y -> Int -> IO ()) -> IO ()
forall a b.
Storable a =>
Vector a -> (Ptr a -> Int -> IO b) -> IO b
SVB.withStartPtr Vector y
c ((Ptr y -> Int -> IO ()) -> IO ())
-> (Ptr y -> Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr y
ptr Int
size ->
SoundSink handle y -> handle y -> Ptr y -> Int -> IO ()
forall (handle :: * -> *) y.
SoundSink handle y -> handle y -> Ptr y -> Int -> IO ()
ALSA.soundSinkWrite SoundSink handle y
sink handle y
to Ptr y
ptr Int
size IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
(Handle -> IO ()) -> f Handle -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
Fold.traverse_ (\Handle
h -> Handle -> Ptr y -> Int -> IO ()
forall a. Handle -> Ptr a -> Int -> IO ()
IO.hPutBuf Handle
h Ptr y
ptr (Ptr y -> Int -> Int
forall y. Storable y => Ptr y -> Int -> Int
arraySize Ptr y
ptr Int
size)) f Handle
hs
{-# INLINE monoToInt16 #-}
monoToInt16 ::
(Storable y, RealRing.C y) =>
ALSA.SoundSink handle Int16 ->
SigSt.T y -> IO ()
monoToInt16 :: SoundSink handle Int16 -> T y -> IO ()
monoToInt16 SoundSink handle Int16
sink T y
xs =
SoundSink handle Int16 -> T Int16 -> IO ()
forall y (handle :: * -> *).
SampleFmt y =>
SoundSink handle y -> T y -> IO ()
auto SoundSink handle Int16
sink ((y -> Int16) -> T y -> T Int16
forall x y.
(Storable x, Storable y) =>
(x -> y) -> Vector x -> Vector y
SigSt.map y -> Int16
forall a. C a => a -> Int16
BinSmp.int16FromCanonical T y
xs)
{-# INLINE stereoToInt16 #-}
stereoToInt16 ::
(Storable y, RealRing.C y) =>
ALSA.SoundSink handle (Stereo.T Int16) ->
SigSt.T (Stereo.T y) -> IO ()
stereoToInt16 :: SoundSink handle (T Int16) -> T (T y) -> IO ()
stereoToInt16 SoundSink handle (T Int16)
sink T (T y)
xs =
SoundSink handle (T Int16) -> T (T Int16) -> IO ()
forall y (handle :: * -> *).
SampleFmt y =>
SoundSink handle y -> T y -> IO ()
auto SoundSink handle (T Int16)
sink ((T y -> T Int16) -> T (T y) -> T (T Int16)
forall x y.
(Storable x, Storable y) =>
(x -> y) -> Vector x -> Vector y
SigSt.map ((y -> Int16) -> T y -> T Int16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap y -> Int16
forall a. C a => a -> Int16
BinSmp.int16FromCanonical) T (T y)
xs)