module Sound.SFML (
PolySound,
newPolySound,
freePolySound,
triggerPolySound,
LoopedSound,
newLoopedSound,
freeLoopedSound,
startLoopedSound,
stopLoopedSound,
playMusic,
playMusicLooped,
stopMusic,
pauseMusic,
) where
import Prelude hiding (mapM_)
import Data.Maybe
import Data.IORef
import Data.Foldable (forM_, mapM_)
import Data.Traversable (forM)
import Control.Monad (when)
import Control.Concurrent.MVar
import System.IO.Unsafe
import Foreign.Ptr
import Sound.SFML.LowLevel
data PolySound = PolySound FilePath (Ptr SoundBuffer) [Ptr Sound] (IORef Int)
instance Show PolySound where
show (PolySound file _ _ _) = "PolySound " ++ show file
newPolySound ::
FilePath
-> Int
-> IO PolySound
newPolySound path numberOfVoices = do
buffer <- sfSoundBuffer_CreateFromFile path
sounds <- forM [1 .. numberOfVoices] $ \ _ -> do
sound <- sfSound_Create
sfSound_SetBuffer sound buffer
return sound
ref <- newIORef 0
return $ PolySound path buffer sounds ref
freePolySound :: PolySound -> IO ()
freePolySound (PolySound _ buffer sounds _) = do
sfSoundBuffer_Destroy buffer
mapM_ sfSound_Destroy sounds
triggerPolySound :: PolySound -> Maybe Float -> IO ()
triggerPolySound (PolySound _ _ sounds ref) volume = do
i <- readIORef ref
let sound = sounds !! i
status <- getSoundStatus sound
when (status == Stopped) $ do
writeIORef ref ((i + 1) `mod` length sounds)
sfSound_SetVolume sound ((fromMaybe 1 volume) * 100)
sfSound_Play sound
newtype LoopedSound = LoopedSound (Ptr Sound)
deriving Show
newLoopedSound :: FilePath -> IO LoopedSound
newLoopedSound path = do
buffer <- sfSoundBuffer_CreateFromFile path
sound <- sfSound_Create
sfSound_SetBuffer sound buffer
sfSound_SetLoop sound True
return $ LoopedSound sound
freeLoopedSound :: LoopedSound -> IO ()
freeLoopedSound (LoopedSound ptr) =
sfSound_Destroy ptr
startLoopedSound :: Maybe Float -> LoopedSound -> IO ()
startLoopedSound volume (LoopedSound ptr) = do
sfSound_SetVolume ptr ((fromMaybe 1 volume) * 100)
sfSound_Play ptr
stopLoopedSound :: LoopedSound -> IO ()
stopLoopedSound (LoopedSound ptr) =
sfSound_Stop ptr
playMusic :: FilePath -> Maybe Float -> IO ()
playMusic = _playMusic False
playMusicLooped :: FilePath -> Maybe Float -> IO ()
playMusicLooped = _playMusic True
_playMusic :: Bool -> FilePath -> Maybe Float -> IO ()
_playMusic looped file volume = modifyMVar_ _globalMusic $ \ mOldMusic -> do
case mOldMusic of
Just (oldFile, oldMusic) -> do
status <- getMusicStatus oldMusic
case status of
Paused | file == oldFile -> do
sfMusic_SetLoop oldMusic looped
sfMusic_SetVolume oldMusic ((fromMaybe 1 volume) * 100)
sfMusic_Play oldMusic
return $ Just (file, oldMusic)
_ -> do
sfMusic_Stop oldMusic
sfMusic_Destroy oldMusic
startNewMusic
Nothing -> startNewMusic
where
startNewMusic = do
music <- sfMusic_CreateFromFile file
sfMusic_SetLoop music looped
sfMusic_SetVolume music ((fromMaybe 1 volume) * 100)
sfMusic_Play music
return $ Just (file, music)
stopMusic :: IO ()
stopMusic = modifyMVar_ _globalMusic $ \ mOldMusic -> do
forM_ mOldMusic $ \ (_, oldMusic) -> do
sfMusic_Stop oldMusic
sfMusic_Destroy oldMusic
return Nothing
pauseMusic :: IO ()
pauseMusic = modifyMVar_ _globalMusic $ \ mMusic -> do
mapM_ (sfMusic_Pause . snd) mMusic
return mMusic
_globalMusic :: MVar (Maybe (FilePath, Ptr Music))
_globalMusic = unsafePerformIO $ newMVar Nothing