Play.hs

{- |
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 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.RealField as RealField

-- import NumericPrelude (round, )
import Prelude hiding (round, break, )


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


{-
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 a) =>
   Int -> SigSt.T a -> IO ()
auto rate ys =
   let sink =
          ALSA.alsaSoundSinkTime "plughw:0,0" soundFormat $
          ALSA.SoundBufferTime 50000 10000

       {-# INLINE soundFormat #-}
       soundFormat :: ALSA.SoundFmt y
       soundFormat =
          ALSA.SoundFmt {
             ALSA.sampleFreq = 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 a, SoxFrame.C a) =>
   FilePath -> Int -> SigSt.T a -> IO ()
autoAndRecord fileName rate =
   let sink =
          ALSA.alsaSoundSinkTime "plughw:0,0" soundFormat $
          ALSA.SoundBufferTime 50000 10000

       {-# INLINE soundFormat #-}
       soundFormat :: ALSA.SoundFmt y
       soundFormat =
          ALSA.SoundFmt {
             ALSA.sampleFreq = 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, RealField.C y) =>
   Int -> SigSt.T y -> IO ()
monoToInt16 rate xs =
   auto rate
      (SigSt.map BinSmp.int16FromCanonical xs)

{-# INLINE stereoToInt16 #-}
stereoToInt16 ::
   (Storable y, RealField.C y) =>
   Int -> SigSt.T (Stereo.T y) -> IO ()
stereoToInt16 rate xs =
   auto rate
      (SigSt.map (fmap BinSmp.int16FromCanonical) xs)