{-# OPTIONS -Wall #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Bindings to @raudio@
module Raylib.Core.Audio
  ( -- * High level
    initAudioDevice,
    closeAudioDevice,
    isAudioDeviceReady,
    setMasterVolume,
    getMasterVolume,
    loadWave,
    loadWaveFromMemory,
    loadSound,
    loadSoundFromWave,
    loadSoundAlias,
    unloadSoundAlias,
    updateSound,
    unloadSound,
    isWaveReady,
    isSoundReady,
    exportWave,
    exportWaveAsCode,
    playSound,
    stopSound,
    pauseSound,
    resumeSound,
    isSoundPlaying,
    setSoundVolume,
    setSoundPitch,
    setSoundPan,
    waveCopy,
    waveCrop,
    waveFormat,
    loadWaveSamples,
    loadMusicStream,
    loadMusicStreamFromMemory,
    unloadMusicStream,
    isMusicReady,
    playMusicStream,
    isMusicStreamPlaying,
    updateMusicStream,
    stopMusicStream,
    pauseMusicStream,
    resumeMusicStream,
    seekMusicStream,
    setMusicVolume,
    setMusicPitch,
    setMusicPan,
    getMusicTimeLength,
    getMusicTimePlayed,
    loadAudioStream,
    unloadAudioStream,
    isAudioStreamReady,
    updateAudioStream,
    isAudioStreamProcessed,
    playAudioStream,
    pauseAudioStream,
    resumeAudioStream,
    isAudioStreamPlaying,
    stopAudioStream,
    setAudioStreamVolume,
    setAudioStreamPitch,
    setAudioStreamPan,
    setAudioStreamBufferSizeDefault,
    setAudioStreamCallback,
    attachAudioStreamProcessor,
    detachAudioStreamProcessor,
    attachAudioMixedProcessor,
    detachAudioMixedProcessor,

    -- * Native
    c'initAudioDevice,
    c'closeAudioDevice,
    c'isAudioDeviceReady,
    c'setMasterVolume,
    c'getMasterVolume,
    c'loadWave,
    c'loadWaveFromMemory,
    c'loadSound,
    c'loadSoundFromWave,
    c'loadSoundAlias,
    c'updateSound,
    c'isWaveReady,
    c'unloadWave,
    c'isSoundReady,
    c'unloadSound,
    c'unloadSoundAlias,
    c'exportWave,
    c'exportWaveAsCode,
    c'playSound,
    c'stopSound,
    c'pauseSound,
    c'resumeSound,
    c'isSoundPlaying,
    c'setSoundVolume,
    c'setSoundPitch,
    c'setSoundPan,
    c'waveCopy,
    c'waveCrop,
    c'waveFormat,
    c'loadWaveSamples,
    c'unloadWaveSamples,
    c'loadMusicStream,
    c'loadMusicStreamFromMemory,
    c'isMusicReady,
    c'unloadMusicStream,
    c'playMusicStream,
    c'isMusicStreamPlaying,
    c'updateMusicStream,
    c'stopMusicStream,
    c'pauseMusicStream,
    c'resumeMusicStream,
    c'seekMusicStream,
    c'setMusicVolume,
    c'setMusicPitch,
    c'setMusicPan,
    c'getMusicTimeLength,
    c'getMusicTimePlayed,
    c'loadAudioStream,
    c'isAudioStreamReady,
    c'unloadAudioStream,
    c'updateAudioStream,
    c'isAudioStreamProcessed,
    c'playAudioStream,
    c'pauseAudioStream,
    c'resumeAudioStream,
    c'isAudioStreamPlaying,
    c'stopAudioStream,
    c'setAudioStreamVolume,
    c'setAudioStreamPitch,
    c'setAudioStreamPan,
    c'setAudioStreamBufferSizeDefault,
    c'setAudioStreamCallback,
    c'attachAudioStreamProcessor,
    c'detachAudioStreamProcessor,
    c'attachAudioMixedProcessor,
    c'detachAudioMixedProcessor,

    -- * Callbacks
    mk'audioCallback,
    createAudioCallback,
  )
where

import Foreign (Ptr, Storable (peek, sizeOf), castPtr, toBool, castFunPtr)
import Foreign.C
  ( CBool (..),
    CFloat (..),
    CInt (..),
    CString,
    CUChar (..),
    CUInt (..),
    withCString,
  )
import Raylib.Internal (WindowResources, addAudioBuffer, addAudioBufferAlias, addCtxData, unloadAudioBuffers, unloadCtxData, unloadSingleAudioBuffer, unloadSingleAudioBufferAlias, unloadSingleCtxDataPtr, addFunPtr, unloadSingleFunPtr)
import Raylib.Internal.Foreign
  ( pop,
    popCArray,
    withFreeable,
    withFreeableArrayLen,
  )
import Raylib.Internal.TH (genNative)
import Raylib.Types
  ( AudioCallback,
    AudioStream (audioStream'buffer),
    C'AudioCallback,
    Music (music'ctxData, music'ctxType, music'stream),
    Sound (sound'stream),
    Wave (wave'channels, wave'frameCount),
  )

$( genNative
     [ ("c'initAudioDevice", "InitAudioDevice_", "rl_bindings.h", [t|IO ()|], False),
       ("c'closeAudioDevice", "CloseAudioDevice_", "rl_bindings.h", [t|IO ()|], False),
       ("c'isAudioDeviceReady", "IsAudioDeviceReady_", "rl_bindings.h", [t|IO CBool|], False),
       ("c'setMasterVolume", "SetMasterVolume_", "rl_bindings.h", [t|CFloat -> IO ()|], False),
       ("c'getMasterVolume", "GetMasterVolume_", "rl_bindings.h", [t|IO CFloat|], False),
       ("c'loadWave", "LoadWave_", "rl_bindings.h", [t|CString -> IO (Ptr Wave)|], False),
       ("c'loadWaveFromMemory", "LoadWaveFromMemory_", "rl_bindings.h", [t|CString -> Ptr CUChar -> CInt -> IO (Ptr Wave)|], False),
       ("c'loadSound", "LoadSound_", "rl_bindings.h", [t|CString -> IO (Ptr Sound)|], False),
       ("c'loadSoundFromWave", "LoadSoundFromWave_", "rl_bindings.h", [t|Ptr Wave -> IO (Ptr Sound)|], False),
       ("c'loadSoundAlias", "LoadSoundAlias_", "rl_bindings.h", [t|Ptr Sound -> IO (Ptr Sound)|], False),
       ("c'updateSound", "UpdateSound_", "rl_bindings.h", [t|Ptr Sound -> Ptr () -> CInt -> IO ()|], False),
       ("c'isWaveReady", "IsWaveReady_", "rl_bindings.h", [t|Ptr Wave -> IO CBool|], False),
       ("c'unloadWave", "UnloadWave_", "rl_bindings.h", [t|Ptr Wave -> IO ()|], False),
       ("c'isSoundReady", "IsSoundReady_", "rl_bindings.h", [t|Ptr Sound -> IO CBool|], False),
       ("c'unloadSound", "UnloadSound_", "rl_bindings.h", [t|Ptr Sound -> IO ()|], False),
       ("c'unloadSoundAlias", "UnloadSoundAlias_", "rl_bindings.h", [t|Ptr Sound -> IO ()|], False),
       ("c'exportWave", "ExportWave_", "rl_bindings.h", [t|Ptr Wave -> CString -> IO CBool|], False),
       ("c'exportWaveAsCode", "ExportWaveAsCode_", "rl_bindings.h", [t|Ptr Wave -> CString -> IO CBool|], False),
       ("c'playSound", "PlaySound_", "rl_bindings.h", [t|Ptr Sound -> IO ()|], False),
       ("c'stopSound", "StopSound_", "rl_bindings.h", [t|Ptr Sound -> IO ()|], False),
       ("c'pauseSound", "PauseSound_", "rl_bindings.h", [t|Ptr Sound -> IO ()|], False),
       ("c'resumeSound", "ResumeSound_", "rl_bindings.h", [t|Ptr Sound -> IO ()|], False),
       ("c'isSoundPlaying", "IsSoundPlaying_", "rl_bindings.h", [t|Ptr Sound -> IO CBool|], False),
       ("c'setSoundVolume", "SetSoundVolume_", "rl_bindings.h", [t|Ptr Sound -> CFloat -> IO ()|], False),
       ("c'setSoundPitch", "SetSoundPitch_", "rl_bindings.h", [t|Ptr Sound -> CFloat -> IO ()|], False),
       ("c'setSoundPan", "SetSoundPan_", "rl_bindings.h", [t|Ptr Sound -> CFloat -> IO ()|], False),
       ("c'waveCopy", "WaveCopy_", "rl_bindings.h", [t|Ptr Wave -> IO (Ptr Wave)|], False),
       ("c'waveCrop", "WaveCrop_", "rl_bindings.h", [t|Ptr Wave -> CInt -> CInt -> IO ()|], False),
       ("c'waveFormat", "WaveFormat_", "rl_bindings.h", [t|Ptr Wave -> CInt -> CInt -> CInt -> IO ()|], False),
       ("c'loadWaveSamples", "LoadWaveSamples_", "rl_bindings.h", [t|Ptr Wave -> IO (Ptr CFloat)|], False),
       ("c'unloadWaveSamples", "UnloadWaveSamples_", "rl_bindings.h", [t|Ptr CFloat -> IO ()|], False),
       ("c'loadMusicStream", "LoadMusicStream_", "rl_bindings.h", [t|CString -> IO (Ptr Music)|], False),
       ("c'loadMusicStreamFromMemory", "LoadMusicStreamFromMemory_", "rl_bindings.h", [t|CString -> Ptr CUChar -> CInt -> IO (Ptr Music)|], False),
       ("c'isMusicReady", "IsMusicReady_", "rl_bindings.h", [t|Ptr Music -> IO CBool|], False),
       ("c'unloadMusicStream", "UnloadMusicStream_", "rl_bindings.h", [t|Ptr Music -> IO ()|], False),
       ("c'playMusicStream", "PlayMusicStream_", "rl_bindings.h", [t|Ptr Music -> IO ()|], False),
       ("c'isMusicStreamPlaying", "IsMusicStreamPlaying_", "rl_bindings.h", [t|Ptr Music -> IO CBool|], False),
       ("c'updateMusicStream", "UpdateMusicStream_", "rl_bindings.h", [t|Ptr Music -> IO ()|], False),
       ("c'stopMusicStream", "StopMusicStream_", "rl_bindings.h", [t|Ptr Music -> IO ()|], False),
       ("c'pauseMusicStream", "PauseMusicStream_", "rl_bindings.h", [t|Ptr Music -> IO ()|], False),
       ("c'resumeMusicStream", "ResumeMusicStream_", "rl_bindings.h", [t|Ptr Music -> IO ()|], False),
       ("c'seekMusicStream", "SeekMusicStream_", "rl_bindings.h", [t|Ptr Music -> CFloat -> IO ()|], False),
       ("c'setMusicVolume", "SetMusicVolume_", "rl_bindings.h", [t|Ptr Music -> CFloat -> IO ()|], False),
       ("c'setMusicPitch", "SetMusicPitch_", "rl_bindings.h", [t|Ptr Music -> CFloat -> IO ()|], False),
       ("c'setMusicPan", "SetMusicPan_", "rl_bindings.h", [t|Ptr Music -> CFloat -> IO ()|], False),
       ("c'getMusicTimeLength", "GetMusicTimeLength_", "rl_bindings.h", [t|Ptr Music -> IO CFloat|], False),
       ("c'getMusicTimePlayed", "GetMusicTimePlayed_", "rl_bindings.h", [t|Ptr Music -> IO CFloat|], False),
       ("c'loadAudioStream", "LoadAudioStream_", "rl_bindings.h", [t|CUInt -> CUInt -> CUInt -> IO (Ptr AudioStream)|], False),
       ("c'isAudioStreamReady", "IsAudioStreamReady_", "rl_bindings.h", [t|Ptr AudioStream -> IO CBool|], False),
       ("c'unloadAudioStream", "UnloadAudioStream_", "rl_bindings.h", [t|Ptr AudioStream -> IO ()|], False),
       ("c'updateAudioStream", "UpdateAudioStream_", "rl_bindings.h", [t|Ptr AudioStream -> Ptr () -> CInt -> IO ()|], False),
       ("c'isAudioStreamProcessed", "IsAudioStreamProcessed_", "rl_bindings.h", [t|Ptr AudioStream -> IO CBool|], False),
       ("c'playAudioStream", "PlayAudioStream_", "rl_bindings.h", [t|Ptr AudioStream -> IO ()|], False),
       ("c'pauseAudioStream", "PauseAudioStream_", "rl_bindings.h", [t|Ptr AudioStream -> IO ()|], False),
       ("c'resumeAudioStream", "ResumeAudioStream_", "rl_bindings.h", [t|Ptr AudioStream -> IO ()|], False),
       ("c'isAudioStreamPlaying", "IsAudioStreamPlaying_", "rl_bindings.h", [t|Ptr AudioStream -> IO CBool|], False),
       ("c'stopAudioStream", "StopAudioStream_", "rl_bindings.h", [t|Ptr AudioStream -> IO ()|], False),
       ("c'setAudioStreamVolume", "SetAudioStreamVolume_", "rl_bindings.h", [t|Ptr AudioStream -> CFloat -> IO ()|], False),
       ("c'setAudioStreamPitch", "SetAudioStreamPitch_", "rl_bindings.h", [t|Ptr AudioStream -> CFloat -> IO ()|], False),
       ("c'setAudioStreamPan", "SetAudioStreamPan_", "rl_bindings.h", [t|Ptr AudioStream -> CFloat -> IO ()|], False),
       ("c'setAudioStreamBufferSizeDefault", "SetAudioStreamBufferSizeDefault_", "rl_bindings.h", [t|CInt -> IO ()|], False),
       ("c'setAudioStreamCallback", "SetAudioStreamCallback_", "rl_bindings.h", [t|Ptr AudioStream -> C'AudioCallback -> IO ()|], False),
       ("c'attachAudioStreamProcessor", "AttachAudioStreamProcessor_", "rl_bindings.h", [t|Ptr AudioStream -> C'AudioCallback -> IO ()|], False),
       ("c'detachAudioStreamProcessor", "DetachAudioStreamProcessor_", "rl_bindings.h", [t|Ptr AudioStream -> C'AudioCallback -> IO ()|], False),
       ("c'attachAudioMixedProcessor", "AttachAudioMixedProcessor_", "rl_bindings.h", [t|C'AudioCallback -> IO ()|], False),
       ("c'detachAudioMixedProcessor", "DetachAudioMixedProcessor_", "rl_bindings.h", [t|C'AudioCallback -> IO ()|], False)
     ]
 )

initAudioDevice :: IO ()
initAudioDevice :: IO ()
initAudioDevice = IO ()
c'initAudioDevice

closeAudioDevice :: WindowResources -> IO ()
closeAudioDevice :: WindowResources -> IO ()
closeAudioDevice WindowResources
wr = do
  WindowResources -> IO ()
unloadCtxData WindowResources
wr
  WindowResources -> IO ()
unloadAudioBuffers WindowResources
wr
  IO ()
c'closeAudioDevice

isAudioDeviceReady :: IO Bool
isAudioDeviceReady :: IO Bool
isAudioDeviceReady = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CBool
c'isAudioDeviceReady

setMasterVolume :: Float -> IO ()
setMasterVolume :: Float -> IO ()
setMasterVolume Float
volume = CFloat -> IO ()
c'setMasterVolume (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
volume)

getMasterVolume :: IO Float
getMasterVolume :: IO Float
getMasterVolume = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CFloat -> Float) -> IO CFloat -> IO Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CFloat
c'getMasterVolume

loadWave :: String -> IO Wave
loadWave :: String -> IO Wave
loadWave String
fileName = String -> (CString -> IO (Ptr Wave)) -> IO (Ptr Wave)
forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO (Ptr Wave)
c'loadWave IO (Ptr Wave) -> (Ptr Wave -> IO Wave) -> IO Wave
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Wave -> IO Wave
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

loadWaveFromMemory :: String -> [Integer] -> IO Wave
loadWaveFromMemory :: String -> [Integer] -> IO Wave
loadWaveFromMemory String
fileType [Integer]
fileData = String -> (CString -> IO (Ptr Wave)) -> IO (Ptr Wave)
forall a. String -> (CString -> IO a) -> IO a
withCString String
fileType (\CString
f -> [CUChar] -> (Int -> Ptr CUChar -> IO (Ptr Wave)) -> IO (Ptr Wave)
forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen ((Integer -> CUChar) -> [Integer] -> [CUChar]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
fileData) (\Int
size Ptr CUChar
d -> CString -> Ptr CUChar -> CInt -> IO (Ptr Wave)
c'loadWaveFromMemory CString
f Ptr CUChar
d (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* CUChar -> Int
forall a. Storable a => a -> Int
sizeOf (CUChar
0 :: CUChar)))) IO (Ptr Wave) -> (Ptr Wave -> IO Wave) -> IO Wave
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Wave -> IO Wave
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

loadSound :: String -> WindowResources -> IO Sound
loadSound :: String -> WindowResources -> IO Sound
loadSound String
fileName WindowResources
wr = do
  Sound
sound <- String -> (CString -> IO (Ptr Sound)) -> IO (Ptr Sound)
forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO (Ptr Sound)
c'loadSound IO (Ptr Sound) -> (Ptr Sound -> IO Sound) -> IO Sound
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Sound -> IO Sound
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop
  Ptr () -> WindowResources -> IO ()
addAudioBuffer (Ptr RAudioBuffer -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (AudioStream -> Ptr RAudioBuffer
audioStream'buffer (Sound -> AudioStream
sound'stream Sound
sound))) WindowResources
wr
  Sound -> IO Sound
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Sound
sound

loadSoundFromWave :: Wave -> WindowResources -> IO Sound
loadSoundFromWave :: Wave -> WindowResources -> IO Sound
loadSoundFromWave Wave
wave WindowResources
wr = do
  Sound
sound <- Wave -> (Ptr Wave -> IO (Ptr Sound)) -> IO (Ptr Sound)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Wave
wave Ptr Wave -> IO (Ptr Sound)
c'loadSoundFromWave IO (Ptr Sound) -> (Ptr Sound -> IO Sound) -> IO Sound
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Sound -> IO Sound
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop
  Ptr () -> WindowResources -> IO ()
addAudioBuffer (Ptr RAudioBuffer -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (AudioStream -> Ptr RAudioBuffer
audioStream'buffer (Sound -> AudioStream
sound'stream Sound
sound))) WindowResources
wr
  Sound -> IO Sound
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Sound
sound

loadSoundAlias :: Sound -> WindowResources -> IO Sound
loadSoundAlias :: Sound -> WindowResources -> IO Sound
loadSoundAlias Sound
source WindowResources
wr = do
  Sound
sound <- Sound -> (Ptr Sound -> IO (Ptr Sound)) -> IO (Ptr Sound)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Sound
source Ptr Sound -> IO (Ptr Sound)
c'loadSoundAlias IO (Ptr Sound) -> (Ptr Sound -> IO Sound) -> IO Sound
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Sound -> IO Sound
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop
  Ptr () -> WindowResources -> IO ()
addAudioBufferAlias (Ptr RAudioBuffer -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (AudioStream -> Ptr RAudioBuffer
audioStream'buffer (Sound -> AudioStream
sound'stream Sound
sound))) WindowResources
wr
  Sound -> IO Sound
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Sound
sound

-- | Unloads a sound alias from RAM
unloadSoundAlias :: Sound -> WindowResources -> IO ()
unloadSoundAlias :: Sound -> WindowResources -> IO ()
unloadSoundAlias Sound
sound = Ptr () -> WindowResources -> IO ()
unloadSingleAudioBufferAlias (Ptr RAudioBuffer -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (AudioStream -> Ptr RAudioBuffer
audioStream'buffer (Sound -> AudioStream
sound'stream Sound
sound)))

updateSound :: Sound -> Ptr () -> Int -> IO ()
updateSound :: Sound -> Ptr () -> Int -> IO ()
updateSound Sound
sound Ptr ()
dataValue Int
sampleCount = Sound -> (Ptr Sound -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Sound
sound (\Ptr Sound
s -> Ptr Sound -> Ptr () -> CInt -> IO ()
c'updateSound Ptr Sound
s Ptr ()
dataValue (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sampleCount))

-- | Unloads a sound from RAM. Sounds are automatically unloaded
-- when `closeAudioDevice` is called, so manually unloading sounds is
-- not required. In larger projects, you may want to manually unload
-- sounds to avoid having them in RAM for too long.
unloadSound :: Sound -> WindowResources -> IO ()
unloadSound :: Sound -> WindowResources -> IO ()
unloadSound Sound
sound = AudioStream -> WindowResources -> IO ()
unloadAudioStream (Sound -> AudioStream
sound'stream Sound
sound)

isWaveReady :: Wave -> IO Bool
isWaveReady :: Wave -> IO Bool
isWaveReady Wave
wave = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Wave -> (Ptr Wave -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Wave
wave Ptr Wave -> IO CBool
c'isWaveReady

isSoundReady :: Sound -> IO Bool
isSoundReady :: Sound -> IO Bool
isSoundReady Sound
sound = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sound -> (Ptr Sound -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Sound
sound Ptr Sound -> IO CBool
c'isSoundReady

exportWave :: Wave -> String -> IO Bool
exportWave :: Wave -> String -> IO Bool
exportWave Wave
wave String
fileName = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Wave -> (Ptr Wave -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Wave
wave (String -> (CString -> IO CBool) -> IO CBool
forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName ((CString -> IO CBool) -> IO CBool)
-> (Ptr Wave -> CString -> IO CBool) -> Ptr Wave -> IO CBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Wave -> CString -> IO CBool
c'exportWave)

exportWaveAsCode :: Wave -> String -> IO Bool
exportWaveAsCode :: Wave -> String -> IO Bool
exportWaveAsCode Wave
wave String
fileName = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Wave -> (Ptr Wave -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Wave
wave (String -> (CString -> IO CBool) -> IO CBool
forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName ((CString -> IO CBool) -> IO CBool)
-> (Ptr Wave -> CString -> IO CBool) -> Ptr Wave -> IO CBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Wave -> CString -> IO CBool
c'exportWaveAsCode)

playSound :: Sound -> IO ()
playSound :: Sound -> IO ()
playSound Sound
sound = Sound -> (Ptr Sound -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Sound
sound Ptr Sound -> IO ()
c'playSound

stopSound :: Sound -> IO ()
stopSound :: Sound -> IO ()
stopSound Sound
sound = Sound -> (Ptr Sound -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Sound
sound Ptr Sound -> IO ()
c'stopSound

pauseSound :: Sound -> IO ()
pauseSound :: Sound -> IO ()
pauseSound Sound
sound = Sound -> (Ptr Sound -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Sound
sound Ptr Sound -> IO ()
c'pauseSound

resumeSound :: Sound -> IO ()
resumeSound :: Sound -> IO ()
resumeSound Sound
sound = Sound -> (Ptr Sound -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Sound
sound Ptr Sound -> IO ()
c'resumeSound

isSoundPlaying :: Sound -> IO Bool
isSoundPlaying :: Sound -> IO Bool
isSoundPlaying Sound
sound = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sound -> (Ptr Sound -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Sound
sound Ptr Sound -> IO CBool
c'isSoundPlaying

setSoundVolume :: Sound -> Float -> IO ()
setSoundVolume :: Sound -> Float -> IO ()
setSoundVolume Sound
sound Float
volume = Sound -> (Ptr Sound -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Sound
sound (\Ptr Sound
s -> Ptr Sound -> CFloat -> IO ()
c'setSoundVolume Ptr Sound
s (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
volume))

setSoundPitch :: Sound -> Float -> IO ()
setSoundPitch :: Sound -> Float -> IO ()
setSoundPitch Sound
sound Float
pitch = Sound -> (Ptr Sound -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Sound
sound (\Ptr Sound
s -> Ptr Sound -> CFloat -> IO ()
c'setSoundPitch Ptr Sound
s (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
pitch))

setSoundPan :: Sound -> Float -> IO ()
setSoundPan :: Sound -> Float -> IO ()
setSoundPan Sound
sound Float
pan = Sound -> (Ptr Sound -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Sound
sound (\Ptr Sound
s -> Ptr Sound -> CFloat -> IO ()
c'setSoundPan Ptr Sound
s (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
pan))

waveCopy :: Wave -> IO Wave
waveCopy :: Wave -> IO Wave
waveCopy Wave
wave = Wave -> (Ptr Wave -> IO (Ptr Wave)) -> IO (Ptr Wave)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Wave
wave Ptr Wave -> IO (Ptr Wave)
c'waveCopy IO (Ptr Wave) -> (Ptr Wave -> IO Wave) -> IO Wave
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Wave -> IO Wave
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

waveCrop :: Wave -> Int -> Int -> IO Wave
waveCrop :: Wave -> Int -> Int -> IO Wave
waveCrop Wave
wave Int
initSample Int
finalSample = do
  Wave
new <- Wave -> IO Wave
waveCopy Wave
wave
  Wave -> (Ptr Wave -> IO Wave) -> IO Wave
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Wave
new (\Ptr Wave
w -> Ptr Wave -> CInt -> CInt -> IO ()
c'waveCrop Ptr Wave
w (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
initSample) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
finalSample) IO () -> IO Wave -> IO Wave
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Wave -> IO Wave
forall a. Storable a => Ptr a -> IO a
peek Ptr Wave
w)

waveFormat :: Wave -> Int -> Int -> Int -> IO ()
waveFormat :: Wave -> Int -> Int -> Int -> IO ()
waveFormat Wave
wave Int
sampleRate Int
sampleSize Int
channels = do
  Wave
new <- Wave -> IO Wave
waveCopy Wave
wave
  Wave -> (Ptr Wave -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Wave
new (\Ptr Wave
n -> Ptr Wave -> CInt -> CInt -> CInt -> IO ()
c'waveFormat Ptr Wave
n (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sampleRate) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sampleSize) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
channels))

loadWaveSamples :: Wave -> IO [Float]
loadWaveSamples :: Wave -> IO [Float]
loadWaveSamples Wave
wave =
  Wave -> (Ptr Wave -> IO [Float]) -> IO [Float]
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Wave
wave
    (\Ptr Wave
w -> (CFloat -> Float) -> [CFloat] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac ([CFloat] -> [Float]) -> IO [CFloat] -> IO [Float]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Ptr CFloat -> IO [CFloat]
forall a. (Freeable a, Storable a) => Int -> Ptr a -> IO [a]
popCArray (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Wave -> Integer
wave'frameCount Wave
wave Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Wave -> Integer
wave'channels Wave
wave) (Ptr CFloat -> IO [CFloat]) -> IO (Ptr CFloat) -> IO [CFloat]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Wave -> IO (Ptr CFloat)
c'loadWaveSamples Ptr Wave
w))

loadMusicStream :: String -> WindowResources -> IO Music
loadMusicStream :: String -> WindowResources -> IO Music
loadMusicStream String
fileName WindowResources
wr = do
  Music
music <- String -> (CString -> IO (Ptr Music)) -> IO (Ptr Music)
forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO (Ptr Music)
c'loadMusicStream IO (Ptr Music) -> (Ptr Music -> IO Music) -> IO Music
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Music -> IO Music
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop
  Ptr () -> WindowResources -> IO ()
addAudioBuffer (Ptr RAudioBuffer -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (AudioStream -> Ptr RAudioBuffer
audioStream'buffer (AudioStream -> Ptr RAudioBuffer)
-> AudioStream -> Ptr RAudioBuffer
forall a b. (a -> b) -> a -> b
$ Music -> AudioStream
music'stream Music
music)) WindowResources
wr
  Int -> Ptr () -> WindowResources -> IO ()
forall a. Integral a => a -> Ptr () -> WindowResources -> IO ()
addCtxData (MusicContextType -> Int
forall a. Enum a => a -> Int
fromEnum (MusicContextType -> Int) -> MusicContextType -> Int
forall a b. (a -> b) -> a -> b
$ Music -> MusicContextType
music'ctxType Music
music) (Music -> Ptr ()
music'ctxData Music
music) WindowResources
wr
  Music -> IO Music
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Music
music

loadMusicStreamFromMemory :: String -> [Integer] -> WindowResources -> IO Music
loadMusicStreamFromMemory :: String -> [Integer] -> WindowResources -> IO Music
loadMusicStreamFromMemory String
fileType [Integer]
streamData WindowResources
wr = do
  Music
music <- String -> (CString -> IO (Ptr Music)) -> IO (Ptr Music)
forall a. String -> (CString -> IO a) -> IO a
withCString String
fileType (\CString
t -> [CUChar] -> (Int -> Ptr CUChar -> IO (Ptr Music)) -> IO (Ptr Music)
forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen ((Integer -> CUChar) -> [Integer] -> [CUChar]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
streamData) (\Int
size Ptr CUChar
d -> CString -> Ptr CUChar -> CInt -> IO (Ptr Music)
c'loadMusicStreamFromMemory CString
t Ptr CUChar
d (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* CUChar -> Int
forall a. Storable a => a -> Int
sizeOf (CUChar
0 :: CUChar)))) IO (Ptr Music) -> (Ptr Music -> IO Music) -> IO Music
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Music -> IO Music
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop
  Ptr () -> WindowResources -> IO ()
addAudioBuffer (Ptr RAudioBuffer -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (AudioStream -> Ptr RAudioBuffer
audioStream'buffer (AudioStream -> Ptr RAudioBuffer)
-> AudioStream -> Ptr RAudioBuffer
forall a b. (a -> b) -> a -> b
$ Music -> AudioStream
music'stream Music
music)) WindowResources
wr
  Int -> Ptr () -> WindowResources -> IO ()
forall a. Integral a => a -> Ptr () -> WindowResources -> IO ()
addCtxData (MusicContextType -> Int
forall a. Enum a => a -> Int
fromEnum (MusicContextType -> Int) -> MusicContextType -> Int
forall a b. (a -> b) -> a -> b
$ Music -> MusicContextType
music'ctxType Music
music) (Music -> Ptr ()
music'ctxData Music
music) WindowResources
wr
  Music -> IO Music
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Music
music

-- | Unloads a music stream from RAM. Music streams are automatically unloaded
-- when `closeAudioDevice` is called, so manually unloading music streams is
-- not required. In larger projects, you may want to manually unload music
-- streams to avoid having them in RAM for too long.
unloadMusicStream :: Music -> WindowResources -> IO ()
unloadMusicStream :: Music -> WindowResources -> IO ()
unloadMusicStream Music
music = Int -> Ptr () -> WindowResources -> IO ()
forall a. Integral a => a -> Ptr () -> WindowResources -> IO ()
unloadSingleCtxDataPtr (MusicContextType -> Int
forall a. Enum a => a -> Int
fromEnum (MusicContextType -> Int) -> MusicContextType -> Int
forall a b. (a -> b) -> a -> b
$ Music -> MusicContextType
music'ctxType Music
music) (Music -> Ptr ()
music'ctxData Music
music)

isMusicReady :: Music -> IO Bool
isMusicReady :: Music -> IO Bool
isMusicReady Music
music = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Music -> (Ptr Music -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Music
music Ptr Music -> IO CBool
c'isMusicReady

playMusicStream :: Music -> IO ()
playMusicStream :: Music -> IO ()
playMusicStream Music
music = Music -> (Ptr Music -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Music
music Ptr Music -> IO ()
c'playMusicStream

isMusicStreamPlaying :: Music -> IO Bool
isMusicStreamPlaying :: Music -> IO Bool
isMusicStreamPlaying Music
music = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Music -> (Ptr Music -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Music
music Ptr Music -> IO CBool
c'isMusicStreamPlaying

updateMusicStream :: Music -> IO ()
updateMusicStream :: Music -> IO ()
updateMusicStream Music
music = Music -> (Ptr Music -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Music
music Ptr Music -> IO ()
c'updateMusicStream

stopMusicStream :: Music -> IO ()
stopMusicStream :: Music -> IO ()
stopMusicStream Music
music = Music -> (Ptr Music -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Music
music Ptr Music -> IO ()
c'stopMusicStream

pauseMusicStream :: Music -> IO ()
pauseMusicStream :: Music -> IO ()
pauseMusicStream Music
music = Music -> (Ptr Music -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Music
music Ptr Music -> IO ()
c'pauseMusicStream

resumeMusicStream :: Music -> IO ()
resumeMusicStream :: Music -> IO ()
resumeMusicStream Music
music = Music -> (Ptr Music -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Music
music Ptr Music -> IO ()
c'resumeMusicStream

seekMusicStream :: Music -> Float -> IO ()
seekMusicStream :: Music -> Float -> IO ()
seekMusicStream Music
music Float
position = Music -> (Ptr Music -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Music
music (\Ptr Music
m -> Ptr Music -> CFloat -> IO ()
c'seekMusicStream Ptr Music
m (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
position))

setMusicVolume :: Music -> Float -> IO ()
setMusicVolume :: Music -> Float -> IO ()
setMusicVolume Music
music Float
volume = Music -> (Ptr Music -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Music
music (\Ptr Music
m -> Ptr Music -> CFloat -> IO ()
c'setMusicVolume Ptr Music
m (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
volume))

setMusicPitch :: Music -> Float -> IO ()
setMusicPitch :: Music -> Float -> IO ()
setMusicPitch Music
music Float
pitch = Music -> (Ptr Music -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Music
music (\Ptr Music
m -> Ptr Music -> CFloat -> IO ()
c'setMusicPitch Ptr Music
m (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
pitch))

setMusicPan :: Music -> Float -> IO ()
setMusicPan :: Music -> Float -> IO ()
setMusicPan Music
music Float
pan = Music -> (Ptr Music -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Music
music (\Ptr Music
m -> Ptr Music -> CFloat -> IO ()
c'setMusicPan Ptr Music
m (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
pan))

getMusicTimeLength :: Music -> IO Float
getMusicTimeLength :: Music -> IO Float
getMusicTimeLength Music
music = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CFloat -> Float) -> IO CFloat -> IO Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Music -> (Ptr Music -> IO CFloat) -> IO CFloat
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Music
music Ptr Music -> IO CFloat
c'getMusicTimeLength

getMusicTimePlayed :: Music -> IO Float
getMusicTimePlayed :: Music -> IO Float
getMusicTimePlayed Music
music = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CFloat -> Float) -> IO CFloat -> IO Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Music -> (Ptr Music -> IO CFloat) -> IO CFloat
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Music
music Ptr Music -> IO CFloat
c'getMusicTimePlayed

loadAudioStream :: Integer -> Integer -> Integer -> WindowResources -> IO AudioStream
loadAudioStream :: Integer -> Integer -> Integer -> WindowResources -> IO AudioStream
loadAudioStream Integer
sampleRate Integer
sampleSize Integer
channels WindowResources
wr = do
  AudioStream
stream <- CUInt -> CUInt -> CUInt -> IO (Ptr AudioStream)
c'loadAudioStream (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
sampleRate) (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
sampleSize) (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
channels) IO (Ptr AudioStream)
-> (Ptr AudioStream -> IO AudioStream) -> IO AudioStream
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr AudioStream -> IO AudioStream
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop
  Ptr () -> WindowResources -> IO ()
addAudioBuffer (Ptr RAudioBuffer -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (AudioStream -> Ptr RAudioBuffer
audioStream'buffer AudioStream
stream)) WindowResources
wr
  AudioStream -> IO AudioStream
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AudioStream
stream

-- | Unloads an audio stream from RAM. Audio streams are automatically unloaded
-- when `closeAudioDevice` is called, so manually unloading audio streams is
-- not required. In larger projects, you may want to manually unload audio
-- streams to avoid having them in RAM for too long.
unloadAudioStream :: AudioStream -> WindowResources -> IO ()
unloadAudioStream :: AudioStream -> WindowResources -> IO ()
unloadAudioStream AudioStream
stream = Ptr () -> WindowResources -> IO ()
unloadSingleAudioBuffer (Ptr RAudioBuffer -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (Ptr RAudioBuffer -> Ptr ()) -> Ptr RAudioBuffer -> Ptr ()
forall a b. (a -> b) -> a -> b
$ AudioStream -> Ptr RAudioBuffer
audioStream'buffer AudioStream
stream)

isAudioStreamReady :: AudioStream -> IO Bool
isAudioStreamReady :: AudioStream -> IO Bool
isAudioStreamReady AudioStream
stream = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AudioStream -> (Ptr AudioStream -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable AudioStream
stream Ptr AudioStream -> IO CBool
c'isAudioStreamReady

updateAudioStream :: AudioStream -> Ptr () -> Int -> IO ()
updateAudioStream :: AudioStream -> Ptr () -> Int -> IO ()
updateAudioStream AudioStream
stream Ptr ()
value Int
frameCount = AudioStream -> (Ptr AudioStream -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable AudioStream
stream (\Ptr AudioStream
s -> Ptr AudioStream -> Ptr () -> CInt -> IO ()
c'updateAudioStream Ptr AudioStream
s Ptr ()
value (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
frameCount))

isAudioStreamProcessed :: AudioStream -> IO Bool
isAudioStreamProcessed :: AudioStream -> IO Bool
isAudioStreamProcessed AudioStream
stream = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AudioStream -> (Ptr AudioStream -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable AudioStream
stream Ptr AudioStream -> IO CBool
c'isAudioStreamProcessed

playAudioStream :: AudioStream -> IO ()
playAudioStream :: AudioStream -> IO ()
playAudioStream AudioStream
stream = AudioStream -> (Ptr AudioStream -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable AudioStream
stream Ptr AudioStream -> IO ()
c'playAudioStream

pauseAudioStream :: AudioStream -> IO ()
pauseAudioStream :: AudioStream -> IO ()
pauseAudioStream AudioStream
stream = AudioStream -> (Ptr AudioStream -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable AudioStream
stream Ptr AudioStream -> IO ()
c'pauseAudioStream

resumeAudioStream :: AudioStream -> IO ()
resumeAudioStream :: AudioStream -> IO ()
resumeAudioStream AudioStream
stream = AudioStream -> (Ptr AudioStream -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable AudioStream
stream Ptr AudioStream -> IO ()
c'resumeAudioStream

isAudioStreamPlaying :: AudioStream -> IO Bool
isAudioStreamPlaying :: AudioStream -> IO Bool
isAudioStreamPlaying AudioStream
stream = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AudioStream -> (Ptr AudioStream -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable AudioStream
stream Ptr AudioStream -> IO CBool
c'isAudioStreamPlaying

stopAudioStream :: AudioStream -> IO ()
stopAudioStream :: AudioStream -> IO ()
stopAudioStream AudioStream
stream = AudioStream -> (Ptr AudioStream -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable AudioStream
stream Ptr AudioStream -> IO ()
c'stopAudioStream

setAudioStreamVolume :: AudioStream -> Float -> IO ()
setAudioStreamVolume :: AudioStream -> Float -> IO ()
setAudioStreamVolume AudioStream
stream Float
volume = AudioStream -> (Ptr AudioStream -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable AudioStream
stream (\Ptr AudioStream
s -> Ptr AudioStream -> CFloat -> IO ()
c'setAudioStreamVolume Ptr AudioStream
s (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
volume))

setAudioStreamPitch :: AudioStream -> Float -> IO ()
setAudioStreamPitch :: AudioStream -> Float -> IO ()
setAudioStreamPitch AudioStream
stream Float
pitch = AudioStream -> (Ptr AudioStream -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable AudioStream
stream (\Ptr AudioStream
s -> Ptr AudioStream -> CFloat -> IO ()
c'setAudioStreamPitch Ptr AudioStream
s (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
pitch))

setAudioStreamPan :: AudioStream -> Float -> IO ()
setAudioStreamPan :: AudioStream -> Float -> IO ()
setAudioStreamPan AudioStream
stream Float
pan = AudioStream -> (Ptr AudioStream -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable AudioStream
stream (\Ptr AudioStream
s -> Ptr AudioStream -> CFloat -> IO ()
c'setAudioStreamPan Ptr AudioStream
s (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
pan))

setAudioStreamBufferSizeDefault :: Int -> IO ()
setAudioStreamBufferSizeDefault :: Int -> IO ()
setAudioStreamBufferSizeDefault = CInt -> IO ()
c'setAudioStreamBufferSizeDefault (CInt -> IO ()) -> (Int -> CInt) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

setAudioStreamCallback :: AudioStream -> AudioCallback -> WindowResources -> IO C'AudioCallback
setAudioStreamCallback :: AudioStream
-> AudioCallback -> WindowResources -> IO C'AudioCallback
setAudioStreamCallback AudioStream
stream AudioCallback
callback WindowResources
window =
  AudioStream
-> (Ptr AudioStream -> IO C'AudioCallback) -> IO C'AudioCallback
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    AudioStream
stream
    ( \Ptr AudioStream
s ->
        do
          C'AudioCallback
c <- AudioCallback -> IO C'AudioCallback
createAudioCallback AudioCallback
callback
          FunPtr () -> WindowResources -> IO ()
addFunPtr (C'AudioCallback -> FunPtr ()
forall a b. FunPtr a -> FunPtr b
castFunPtr C'AudioCallback
c) WindowResources
window
          Ptr AudioStream -> C'AudioCallback -> IO ()
c'setAudioStreamCallback Ptr AudioStream
s C'AudioCallback
c
          C'AudioCallback -> IO C'AudioCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return C'AudioCallback
c
    )

attachAudioStreamProcessor :: AudioStream -> AudioCallback -> WindowResources -> IO C'AudioCallback
attachAudioStreamProcessor :: AudioStream
-> AudioCallback -> WindowResources -> IO C'AudioCallback
attachAudioStreamProcessor AudioStream
stream AudioCallback
callback WindowResources
window =
  AudioStream
-> (Ptr AudioStream -> IO C'AudioCallback) -> IO C'AudioCallback
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    AudioStream
stream
    ( \Ptr AudioStream
s ->
        do
          C'AudioCallback
c <- AudioCallback -> IO C'AudioCallback
createAudioCallback AudioCallback
callback
          FunPtr () -> WindowResources -> IO ()
addFunPtr (C'AudioCallback -> FunPtr ()
forall a b. FunPtr a -> FunPtr b
castFunPtr C'AudioCallback
c) WindowResources
window
          Ptr AudioStream -> C'AudioCallback -> IO ()
c'attachAudioStreamProcessor Ptr AudioStream
s C'AudioCallback
c
          C'AudioCallback -> IO C'AudioCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return C'AudioCallback
c
    )

detachAudioStreamProcessor :: AudioStream -> C'AudioCallback -> WindowResources -> IO ()
detachAudioStreamProcessor :: AudioStream -> C'AudioCallback -> WindowResources -> IO ()
detachAudioStreamProcessor AudioStream
stream C'AudioCallback
callback WindowResources
window =
  AudioStream -> (Ptr AudioStream -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable AudioStream
stream (Ptr AudioStream -> C'AudioCallback -> IO ()
`c'detachAudioStreamProcessor` C'AudioCallback
callback) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunPtr () -> WindowResources -> IO ()
unloadSingleFunPtr (C'AudioCallback -> FunPtr ()
forall a b. FunPtr a -> FunPtr b
castFunPtr C'AudioCallback
callback) WindowResources
window

attachAudioMixedProcessor :: AudioCallback -> WindowResources -> IO C'AudioCallback
attachAudioMixedProcessor :: AudioCallback -> WindowResources -> IO C'AudioCallback
attachAudioMixedProcessor AudioCallback
callback WindowResources
window =
  do
    C'AudioCallback
c <- AudioCallback -> IO C'AudioCallback
createAudioCallback AudioCallback
callback
    FunPtr () -> WindowResources -> IO ()
addFunPtr (C'AudioCallback -> FunPtr ()
forall a b. FunPtr a -> FunPtr b
castFunPtr C'AudioCallback
c) WindowResources
window
    C'AudioCallback -> IO ()
c'attachAudioMixedProcessor C'AudioCallback
c
    C'AudioCallback -> IO C'AudioCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return C'AudioCallback
c

detachAudioMixedProcessor :: C'AudioCallback -> WindowResources -> IO ()
detachAudioMixedProcessor :: C'AudioCallback -> WindowResources -> IO ()
detachAudioMixedProcessor C'AudioCallback
callback WindowResources
window = C'AudioCallback -> IO ()
c'detachAudioMixedProcessor C'AudioCallback
callback IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunPtr () -> WindowResources -> IO ()
unloadSingleFunPtr (C'AudioCallback -> FunPtr ()
forall a b. FunPtr a -> FunPtr b
castFunPtr C'AudioCallback
callback) WindowResources
window

foreign import ccall unsafe "wrapper"
  mk'audioCallback ::
    (Ptr () -> CUInt -> IO ()) -> IO C'AudioCallback

-- foreign import ccall unsafe "dynamic"
--   mK'audioCallback ::
--     C'AudioCallback -> (Ptr () -> CUInt -> IO ())

createAudioCallback :: AudioCallback -> IO C'AudioCallback
createAudioCallback :: AudioCallback -> IO C'AudioCallback
createAudioCallback AudioCallback
callback =
  (Ptr () -> CUInt -> IO ()) -> IO C'AudioCallback
mk'audioCallback
    (\Ptr ()
bufferData CUInt
frames -> AudioCallback
callback Ptr ()
bufferData (CUInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
frames))