module LambdaSound.Play (play) where

import Control.Concurrent (threadDelay)
import Control.Monad (guard, when)
import Data.Massiv.Array qualified as M
import Data.Vector.Storable.ByteString (vectorToByteString)
import LambdaSound.Sampling
import LambdaSound.Sound
import Sound.ProteaAudio qualified as PA

-- | Play the sound with the given sample rate and the given volume.
--
-- You need to have SDL2 installed for playing!
play :: Int -> Float -> Sound T Pulse -> IO ()
play :: Int -> Float -> Sound 'T Pulse -> IO ()
play Int
sampleRate Float
volume Sound 'T Pulse
sound = do
  Vector S Pulse
samples <- Hz -> Sound 'T Pulse -> IO (Vector S Pulse)
sampleSound (Int -> Hz
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
sampleRate) Sound 'T Pulse
sound
  Int -> Float -> Vector S Pulse -> IO ()
playSamples Int
sampleRate Float
volume Vector S Pulse
samples

playSamples :: Int -> Float -> M.Vector M.S Pulse -> IO ()
playSamples :: Int -> Float -> Vector S Pulse -> IO ()
playSamples Int
sampleRate Float
volume Vector S Pulse
samples = do
  Int -> Int -> Int -> IO Bool
PA.initAudio Int
1 Int
sampleRate Int
1024 IO Bool -> (Bool -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard

  let floatBytes :: ByteString
floatBytes =
        Vector Pulse -> ByteString
forall a. Storable a => Vector a -> ByteString
vectorToByteString (Vector Pulse -> ByteString) -> Vector Pulse -> ByteString
forall a b. (a -> b) -> a -> b
$
          Vector S Pulse -> Vector Pulse
forall ix e. Index ix => Array S ix e -> Vector e
M.toStorableVector
            Vector S Pulse
samples

  Sample
sample <- ByteString -> Int -> Int -> Int -> Float -> IO Sample
PA.sampleFromMemoryPcm ByteString
floatBytes Int
1 Int
sampleRate Int
32 Float
volume
  Sound
_sound <- Sample -> Float -> Float -> Float -> Float -> IO Sound
PA.soundPlay Sample
sample Float
1 Float
1 Float
0 Float
1

  IO ()
waitPlayback

  IO ()
PA.finishAudio

waitPlayback :: IO ()
waitPlayback :: IO ()
waitPlayback = do
  Int
n <- IO Int
PA.soundActiveAll
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Int -> IO ()
threadDelay Int
1000
    IO ()
waitPlayback