Play.hs

{-# LANGUAGE NoImplicitPrelude #-}
{- |
Convert MIDI events of a MIDI controller to a control signal.
-}
module Synthesizer.Storable.ALSA.Play (
   auto,
   autoAndRecord,
   monoToInt16,
   stereoToInt16,
   defaultChunkSize,
   ) 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 qualified System.IO as IO

-- import qualified Synthesizer.State.Signal     as SigS

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 NumericPrelude.Numeric
import NumericPrelude.Base


defaultChunkSize :: SigSt.ChunkSize
defaultChunkSize = SigSt.chunkSize 256


makeSink ::
   (ALSA.SampleFmt y, RealRing.C t) =>
   t ->
   ALSA.SampleFreq ->
   ALSA.SoundSink y ALSA.Pcm
makeSink periodTime rate =
   let {-# INLINE soundFormat #-}
       soundFormat :: ALSA.SoundFmt y
       soundFormat =
          ALSA.SoundFmt {
             ALSA.sampleFreq = rate
          }
   in  ALSA.alsaSoundSinkTime "plughw:0,0" soundFormat $
       ALSA.SoundBufferTime
          (round (5000000*periodTime))
          (round (1000000*periodTime))

{-
alsaOpen: only few buffer underruns with
       let buffer_time = 200000 -- 0.20s
           period_time =  40000 -- 0.04s

However the delay is still perceivable.

Latency for keyboard playback might be better with:
       let buffer_time =  50000 -- 0.05s
           period_time =  10000 -- 0.01s
but we get too much underruns,
without actually achieving the required latency.
-}
{-# INLINE auto #-}
auto ::
   (ALSA.SampleFmt y, RealRing.C t) =>
   t {- ^ period (buffer) size expressed in seconds -} ->
   ALSA.SampleFreq {- ^ sample rate -} ->
   SigSt.T y -> IO ()
auto periodTime rate ys =
   let sink = makeSink periodTime rate
   in  ALSA.withSoundSink sink $ \to ->
       flip mapM_ (SVL.chunks ys) $ \c ->
       SVB.withStartPtr c $ \ptr size ->
       ALSA.soundSinkWrite sink to ptr size

-- cf. Alsa.hs
{-# INLINE arraySize #-}
arraySize :: Storable y => Ptr y -> Int -> Int
arraySize p n = advancePtr p n `minusPtr` p

{-# INLINE autoAndRecord #-}
autoAndRecord ::
   (ALSA.SampleFmt y, SoxFrame.C y, RealRing.C t) =>
   t ->
   FilePath ->
   ALSA.SampleFreq ->
   SigSt.T y -> IO ()
autoAndRecord periodTime fileName rate =
   let sink = makeSink periodTime rate
   in  (\act ->
          fmap (const ()) .
          SoxWrite.simple act SoxOption.none fileName rate) $ \h ys ->
       ALSA.withSoundSink sink $ \to ->
       flip mapM_ (SVL.chunks ys) $ \c ->
       SVB.withStartPtr c $ \ptr size ->
       ALSA.soundSinkWrite sink to ptr size >>
       IO.hPutBuf h ptr (arraySize ptr size)


{-# INLINE monoToInt16 #-}
monoToInt16 ::
   (Storable y, RealRing.C y, RealRing.C t) =>
   t ->
   ALSA.SampleFreq ->
   SigSt.T y -> IO ()
monoToInt16 periodTime rate xs =
   auto periodTime rate
      (SigSt.map BinSmp.int16FromCanonical xs)

{-# INLINE stereoToInt16 #-}
stereoToInt16 ::
   (Storable y, RealRing.C y, RealRing.C t) =>
   t ->
   ALSA.SampleFreq ->
   SigSt.T (Stereo.T y) -> IO ()
stereoToInt16 periodTime rate xs =
   auto periodTime rate
      (SigSt.map (fmap BinSmp.int16FromCanonical) xs)