{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module SDL.Mixer
(
withAudio
, Audio(..)
, Format(..)
, Output(..)
, defaultAudio
, ChunkSize
, queryAudio
, openAudio
, closeAudio
, Loadable(..)
, Chunk(..)
, chunkDecoders
, Music(..)
, musicDecoders
, Channel
, pattern AllChannels
, setChannels
, getChannels
, play
, playForever
, Times
, pattern Once
, pattern Forever
, playOn
, Milliseconds
, Limit
, pattern NoLimit
, playLimit
, fadeIn
, fadeInOn
, fadeInLimit
, reserveChannels
, Group
, pattern DefaultGroup
, group
, groupSpan
, groupCount
, getAvailable
, getOldest
, getNewest
, pause
, resume
, halt
, haltAfter
, haltGroup
, Volume
, HasVolume(..)
, playing
, playingCount
, paused
, pausedCount
, playedLast
, Fading
, fading
, fadeOut
, fadeOutGroup
, whenChannelFinished
, playMusic
, Position
, fadeInMusic
, fadeInMusicAt
, fadeInMusicAtMOD
, pauseMusic
, haltMusic
, resumeMusic
, rewindMusic
, setMusicPosition
, setMusicPositionMOD
, setMusicVolume
, getMusicVolume
, playingMusic
, pausedMusic
, fadingMusic
, MusicType(..)
, musicType
, playingMusicType
, fadeOutMusic
, whenMusicFinished
, Effect
, EffectFinished
, pattern PostProcessing
, effect
, effectPan
, effectDistance
, effectPosition
, effectReverseStereo
, initialize
, InitFlag(..)
, quit
, version
) where
import Control.Exception.Lifted (finally)
import Control.Monad (void, forM, when)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Bits ((.|.), (.&.))
import Data.ByteString (ByteString, readFile)
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import Data.Default.Class (Default(def))
import Data.Foldable (foldl)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Int (Int16)
import Data.Vector.Storable.Mutable (IOVector, unsafeFromForeignPtr0)
import Data.Word (Word8)
import Foreign.C.String (peekCString)
import Foreign.C.Types (CInt)
import Foreign.ForeignPtr (newForeignPtr_, castForeignPtr)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (FunPtr, nullFunPtr, freeHaskellFunPtr)
import Foreign.Ptr (Ptr, castPtr, nullPtr)
import Foreign.Storable (Storable(..))
import Prelude hiding (foldl, readFile)
import SDL.ExceptionHelper
import SDL.Raw.Filesystem (rwFromConstMem)
import System.IO.Unsafe (unsafePerformIO)
import qualified SDL.Raw
import qualified SDL.Raw.Mixer
initialize :: (Foldable f, Functor m, MonadIO m) => f InitFlag -> m ()
initialize flags = do
let raw = foldl (\a b -> a .|. initToCInt b) 0 flags
throwIf_ ((/= raw) . (.&. raw)) "SDL.Mixer.initialize" "Mix_Init" $
SDL.Raw.Mixer.init raw
data InitFlag
= InitFLAC
| InitMOD
| InitMODPlug
| InitMP3
| InitOGG
| InitFluidSynth
deriving (Eq, Ord, Bounded, Read, Show)
initToCInt :: InitFlag -> CInt
initToCInt = \case
InitFLAC -> SDL.Raw.Mixer.INIT_FLAC
InitMOD -> SDL.Raw.Mixer.INIT_MOD
InitMODPlug -> SDL.Raw.Mixer.INIT_MODPLUG
InitMP3 -> SDL.Raw.Mixer.INIT_MP3
InitOGG -> SDL.Raw.Mixer.INIT_OGG
InitFluidSynth -> SDL.Raw.Mixer.INIT_FLUIDSYNTH
quit :: MonadIO m => m ()
quit = SDL.Raw.Mixer.quit
version :: (Integral a, MonadIO m) => m (a, a, a)
version = liftIO $ do
SDL.Raw.Version major minor patch <- peek =<< SDL.Raw.Mixer.getVersion
return (fromIntegral major, fromIntegral minor, fromIntegral patch)
withAudio
:: (MonadBaseControl IO m, MonadIO m) => Audio -> ChunkSize -> m a -> m a
withAudio conf csize act = do
openAudio conf csize
finally act closeAudio
openAudio :: MonadIO m => Audio -> ChunkSize -> m ()
openAudio (Audio {..}) chunkSize =
throwIfNeg_ "SDL.Mixer.openAudio" "Mix_OpenAudio" $
SDL.Raw.Mixer.openAudio
(fromIntegral audioFrequency)
(formatToWord audioFormat)
(outputToCInt audioOutput)
(fromIntegral chunkSize)
data Audio = Audio
{ audioFrequency :: Int
, audioFormat :: Format
, audioOutput :: Output
} deriving (Eq, Read, Show)
instance Default Audio where
def = Audio { audioFrequency = SDL.Raw.Mixer.DEFAULT_FREQUENCY
, audioFormat = wordToFormat SDL.Raw.Mixer.DEFAULT_FORMAT
, audioOutput = cIntToOutput SDL.Raw.Mixer.DEFAULT_CHANNELS
}
defaultAudio :: Audio
defaultAudio = def
type ChunkSize = Int
data Format
= FormatU8
| FormatS8
| FormatU16_LSB
| FormatS16_LSB
| FormatU16_MSB
| FormatS16_MSB
| FormatU16_Sys
| FormatS16_Sys
deriving (Eq, Ord, Bounded, Read, Show)
formatToWord :: Format -> SDL.Raw.Mixer.Format
formatToWord = \case
FormatU8 -> SDL.Raw.Mixer.AUDIO_U8
FormatS8 -> SDL.Raw.Mixer.AUDIO_S8
FormatU16_LSB -> SDL.Raw.Mixer.AUDIO_U16LSB
FormatS16_LSB -> SDL.Raw.Mixer.AUDIO_S16LSB
FormatU16_MSB -> SDL.Raw.Mixer.AUDIO_U16MSB
FormatS16_MSB -> SDL.Raw.Mixer.AUDIO_S16MSB
FormatU16_Sys -> SDL.Raw.Mixer.AUDIO_U16SYS
FormatS16_Sys -> SDL.Raw.Mixer.AUDIO_S16SYS
wordToFormat :: SDL.Raw.Mixer.Format -> Format
wordToFormat = \case
SDL.Raw.Mixer.AUDIO_U8 -> FormatU8
SDL.Raw.Mixer.AUDIO_S8 -> FormatS8
SDL.Raw.Mixer.AUDIO_U16LSB -> FormatU16_LSB
SDL.Raw.Mixer.AUDIO_S16LSB -> FormatS16_LSB
SDL.Raw.Mixer.AUDIO_U16MSB -> FormatU16_MSB
SDL.Raw.Mixer.AUDIO_S16MSB -> FormatS16_MSB
SDL.Raw.Mixer.AUDIO_U16SYS -> FormatU16_Sys
SDL.Raw.Mixer.AUDIO_S16SYS -> FormatS16_Sys
_ -> error "SDL.Mixer.wordToFormat: unknown Format."
data Output = Mono | Stereo
deriving (Eq, Ord, Bounded, Read, Show)
outputToCInt :: Output -> CInt
outputToCInt = \case
Mono -> 1
Stereo -> 2
cIntToOutput :: CInt -> Output
cIntToOutput = \case
1 -> Mono
2 -> Stereo
_ -> error "SDL.Mixer.cIntToOutput: unknown number of channels."
queryAudio :: MonadIO m => m Audio
queryAudio =
liftIO .
alloca $ \freq ->
alloca $ \form ->
alloca $ \chan -> do
void . throwIf0 "SDL.Mixer.queryAudio" "Mix_QuerySpec" $
SDL.Raw.Mixer.querySpec freq form chan
Audio
<$> (fromIntegral <$> peek freq)
<*> (wordToFormat <$> peek form)
<*> (cIntToOutput <$> peek chan)
closeAudio :: MonadIO m => m ()
closeAudio = SDL.Raw.Mixer.closeAudio
class Loadable a where
decode :: MonadIO m => ByteString -> m a
load :: MonadIO m => FilePath -> m a
load = (decode =<<) . liftIO . readFile
free :: MonadIO m => a -> m ()
type Volume = Int
volumeToCInt :: Volume -> CInt
volumeToCInt = fromIntegral . max 0 . min 128
class HasVolume a where
getVolume :: MonadIO m => a -> m Volume
setVolume :: MonadIO m => Volume -> a -> m ()
chunkDecoders :: MonadIO m => m [String]
chunkDecoders =
liftIO $ do
num <- SDL.Raw.Mixer.getNumChunkDecoders
forM [0 .. num - 1] $ \i ->
SDL.Raw.Mixer.getChunkDecoder i >>= peekCString
newtype Chunk = Chunk (Ptr SDL.Raw.Mixer.Chunk) deriving (Eq, Show)
instance Loadable Chunk where
decode bytes = liftIO $ do
unsafeUseAsCStringLen bytes $ \(cstr, len) -> do
rw <- rwFromConstMem (castPtr cstr) (fromIntegral len)
fmap Chunk .
throwIfNull "SDL.Mixer.decode<Chunk>" "Mix_LoadWAV_RW" $
SDL.Raw.Mixer.loadWAV_RW rw 0
free (Chunk p) = liftIO $ SDL.Raw.Mixer.freeChunk p
instance HasVolume Chunk where
getVolume (Chunk p) = fmap fromIntegral $ SDL.Raw.Mixer.volumeChunk p (-1)
setVolume v (Chunk p) = void . SDL.Raw.Mixer.volumeChunk p $ volumeToCInt v
newtype Channel = Channel CInt deriving (Eq, Ord, Enum, Integral, Real, Num)
instance Show Channel where
show = \case
AllChannels -> "AllChannels"
Channel c -> "Channel " ++ show c
clipChan :: CInt -> CInt
clipChan = max SDL.Raw.Mixer.CHANNEL_POST
setChannels :: MonadIO m => Int -> m ()
setChannels = void . SDL.Raw.Mixer.allocateChannels . fromIntegral . max 0
getChannels :: MonadIO m => m Int
getChannels = fromIntegral <$> SDL.Raw.Mixer.allocateChannels (-1)
reserveChannels :: MonadIO m => Int -> m Int
reserveChannels =
fmap fromIntegral . SDL.Raw.Mixer.reserveChannels . fromIntegral
playedLast :: MonadIO m => Channel -> m (Maybe Chunk)
playedLast (Channel c) = do
p <- SDL.Raw.Mixer.getChunk $ clipChan c
return $ if p == nullPtr then Nothing else Just (Chunk p)
pattern AllChannels = (-1) :: Channel
instance HasVolume Channel where
setVolume v (Channel c) =
void . SDL.Raw.Mixer.volume (clipChan c) $ volumeToCInt v
getVolume (Channel c) =
fmap fromIntegral $ SDL.Raw.Mixer.volume (clipChan c) (-1)
play :: MonadIO m => Chunk -> m ()
play = void . playOn (-1) Once
playForever :: MonadIO m => Chunk -> m ()
playForever = void . playOn (-1) Forever
newtype Times = Times CInt deriving (Eq, Ord, Enum, Integral, Real, Num)
pattern Once = 1 :: Times
pattern Forever = 0 :: Times
playOn :: MonadIO m => Channel -> Times -> Chunk -> m Channel
playOn = playLimit NoLimit
type Milliseconds = Int
type Limit = Milliseconds
pattern NoLimit = (-1) :: Limit
playLimit :: MonadIO m => Limit -> Channel -> Times -> Chunk -> m Channel
playLimit l (Channel c) (Times t) (Chunk p) =
throwIfNeg "SDL.Mixer.playLimit" "Mix_PlayChannelTimed" $
fmap fromIntegral $
SDL.Raw.Mixer.playChannelTimed
(clipChan c) p (max (-1) $ t - 1) (fromIntegral l)
fadeIn :: MonadIO m => Milliseconds -> Chunk -> m ()
fadeIn ms = void . fadeInOn AllChannels Once ms
fadeInOn :: MonadIO m => Channel -> Times -> Milliseconds -> Chunk -> m Channel
fadeInOn = fadeInLimit NoLimit
fadeInLimit
:: MonadIO m =>
Limit -> Channel -> Times -> Milliseconds -> Chunk -> m Channel
fadeInLimit l (Channel c) (Times t) ms (Chunk p) =
throwIfNeg "SDL.Mixer.fadeInLimit" "Mix_FadeInChannelTimed" $
fromIntegral <$>
SDL.Raw.Mixer.fadeInChannelTimed
(clipChan c) p (max (-1) $ t - 1) (fromIntegral ms) (fromIntegral l)
fadeOut :: MonadIO m => Milliseconds -> Channel -> m ()
fadeOut ms (Channel c) =
void $ SDL.Raw.Mixer.fadeOutChannel (clipChan c) $ fromIntegral ms
fadeOutGroup :: MonadIO m => Milliseconds -> Group -> m ()
fadeOutGroup ms = \case
DefaultGroup -> fadeOut ms AllChannels
Group g -> void $ SDL.Raw.Mixer.fadeOutGroup g $ fromIntegral ms
pause :: MonadIO m => Channel -> m ()
pause (Channel c) = SDL.Raw.Mixer.pause $ clipChan c
resume :: MonadIO m => Channel -> m ()
resume (Channel c) = SDL.Raw.Mixer.resume $ clipChan c
halt :: MonadIO m => Channel -> m ()
halt (Channel c) = void $ SDL.Raw.Mixer.haltChannel $ clipChan c
haltAfter :: MonadIO m => Milliseconds -> Channel -> m ()
haltAfter ms (Channel c) =
void . SDL.Raw.Mixer.expireChannel (clipChan c) $ fromIntegral ms
haltGroup :: MonadIO m => Group -> m ()
haltGroup = \case
DefaultGroup -> halt AllChannels
Group g -> void $ SDL.Raw.Mixer.haltGroup $ max 0 g
{-# NOINLINE channelFinishedFunPtr #-}
channelFinishedFunPtr :: IORef (FunPtr (SDL.Raw.Mixer.Channel -> IO ()))
channelFinishedFunPtr = unsafePerformIO $ newIORef nullFunPtr
whenChannelFinished :: MonadIO m => (Channel -> IO ()) -> m ()
whenChannelFinished callback = liftIO $ do
let callback' = callback . Channel
callbackRaw <- SDL.Raw.Mixer.wrapChannelCallback callback'
SDL.Raw.Mixer.channelFinished callbackRaw
lastFunPtr <- readIORef channelFinishedFunPtr
when (lastFunPtr /= nullFunPtr) $ freeHaskellFunPtr lastFunPtr
writeIORef channelFinishedFunPtr callbackRaw
playing :: MonadIO m => Channel -> m Bool
playing (Channel c) = (> 0) <$> SDL.Raw.Mixer.playing (clipChan c)
playingCount :: MonadIO m => m Int
playingCount = fromIntegral <$> SDL.Raw.Mixer.playing (-1)
paused :: MonadIO m => Channel -> m Bool
paused (Channel c) = (> 0) <$> SDL.Raw.Mixer.paused (clipChan c)
pausedCount :: MonadIO m => m Int
pausedCount = fromIntegral <$> SDL.Raw.Mixer.paused (-1)
data Fading = NoFading | FadingIn | FadingOut
deriving (Eq, Ord, Show, Read)
wordToFading :: SDL.Raw.Mixer.Fading -> Fading
wordToFading = \case
SDL.Raw.Mixer.NO_FADING -> NoFading
SDL.Raw.Mixer.FADING_IN -> FadingIn
SDL.Raw.Mixer.FADING_OUT -> FadingOut
_ -> error "SDL.Mixer.wordToFading: unknown Fading value."
fading :: MonadIO m => Channel -> m Fading
fading (Channel c) =
wordToFading <$> SDL.Raw.Mixer.fadingChannel (clipChan c)
newtype Group = Group CInt deriving (Eq, Ord, Enum, Integral, Real, Num)
pattern DefaultGroup = (-1) :: Group
group :: MonadIO m => Group -> Channel -> m Bool
group wrapped@(Group g) channel =
case channel of
AllChannels -> do
total <- getChannels
if total > 0 then
(> 0) <$> groupSpan wrapped 0 (Channel $ fromIntegral $ total - 1)
else
return True
Channel c ->
if c >= 0 then
(== 1) <$> SDL.Raw.Mixer.groupChannel c g
else
return False
groupSpan :: MonadIO m => Group -> Channel -> Channel -> m Int
groupSpan wrap@(Group g) from@(Channel c1) to@(Channel c2)
| c1 < 0 || c2 < 0 = return 0
| c1 > c2 = groupSpan wrap to from
| otherwise = fromIntegral <$> SDL.Raw.Mixer.groupChannels c1 c2 g
groupCount :: MonadIO m => Group -> m Int
groupCount (Group g) = fromIntegral <$> SDL.Raw.Mixer.groupCount g
getAvailable :: MonadIO m => Group -> m (Maybe Channel)
getAvailable (Group g) = do
found <- SDL.Raw.Mixer.groupAvailable g
return $ if found >= 0 then Just $ fromIntegral found else Nothing
getOldest :: MonadIO m => Group -> m (Maybe Channel)
getOldest (Group g) = do
found <- SDL.Raw.Mixer.groupOldest g
return $ if found >= 0 then Just $ fromIntegral found else Nothing
getNewest :: MonadIO m => Group -> m (Maybe Channel)
getNewest (Group g) = do
found <- SDL.Raw.Mixer.groupNewer g
return $ if found >= 0 then Just $ fromIntegral found else Nothing
musicDecoders :: MonadIO m => m [String]
musicDecoders =
liftIO $ do
num <- SDL.Raw.Mixer.getNumMusicDecoders
forM [0 .. num - 1] $ \i ->
SDL.Raw.Mixer.getMusicDecoder i >>= peekCString
newtype Music = Music (Ptr SDL.Raw.Mixer.Music) deriving (Eq, Show)
instance Loadable Music where
decode bytes = liftIO $ do
unsafeUseAsCStringLen bytes $ \(cstr, len) -> do
rw <- rwFromConstMem (castPtr cstr) (fromIntegral len)
fmap Music .
throwIfNull "SDL.Mixer.decode<Music>" "Mix_LoadMUS_RW" $
SDL.Raw.Mixer.loadMUS_RW rw 0
free (Music p) = liftIO $ SDL.Raw.Mixer.freeMusic p
playMusic :: MonadIO m => Times -> Music -> m ()
playMusic times (Music p) =
throwIfNeg_ "SDL.Mixer.playMusic" "Mix_PlayMusic" $
SDL.Raw.Mixer.playMusic p $
case times of
Forever -> (-1)
Times t -> max 1 t
pauseMusic :: MonadIO m => m ()
pauseMusic = SDL.Raw.Mixer.pauseMusic
haltMusic :: MonadIO m => m ()
haltMusic = void SDL.Raw.Mixer.haltMusic
resumeMusic :: MonadIO m => m ()
resumeMusic = SDL.Raw.Mixer.resumeMusic
playingMusic :: MonadIO m => m Bool
playingMusic = (> 0) <$> SDL.Raw.Mixer.playingMusic
pausedMusic :: MonadIO m => m Bool
pausedMusic = (> 0) <$> SDL.Raw.Mixer.pausedMusic
rewindMusic :: MonadIO m => m ()
rewindMusic = SDL.Raw.Mixer.rewindMusic
fadeInMusic :: MonadIO m => Milliseconds -> Times -> Music -> m ()
fadeInMusic ms times (Music p) =
throwIfNeg_ "SDL.Mixer.fadeInMusic" "Mix_FadeInMusic" $
SDL.Raw.Mixer.fadeInMusic p t' (fromIntegral ms)
where
t' = case times of
Forever -> (-1)
Times t -> max 1 t
fadeOutMusic :: MonadIO m => Milliseconds -> m Bool
fadeOutMusic = fmap (== 1) . SDL.Raw.Mixer.fadeOutMusic . fromIntegral
type Position = Milliseconds
setMusicPosition :: MonadIO m => Position -> m ()
setMusicPosition at = do
rewindMusic
throwIfNeg_ "SDL.Mixer.setMusicPosition" "Mix_SetMusicPosition" $
SDL.Raw.Mixer.setMusicPosition $ realToFrac at / 1000.0
setMusicPositionMOD :: MonadIO m => Int -> m ()
setMusicPositionMOD n = do
throwIfNeg_ "SDL.Mixer.setMusicPositionMOD" "Mix_SetMusicPosition" $
SDL.Raw.Mixer.setMusicPosition $ realToFrac n
fadeInMusicAt :: MonadIO m => Position -> Milliseconds -> Times -> Music -> m ()
fadeInMusicAt at ms times (Music p) =
throwIfNeg_ "SDL.Mixer.fadeInMusicAt" "Mix_FadeInMusicPos" $
SDL.Raw.Mixer.fadeInMusicPos
p t' (fromIntegral ms) (realToFrac at / 1000.0)
where
t' = case times of
Forever -> (-1)
Times t -> max 1 t
fadeInMusicAtMOD :: MonadIO m => Int -> Milliseconds -> Times -> Music -> m ()
fadeInMusicAtMOD at ms times (Music p) =
throwIfNeg_ "SDL.Mixer.fadeInMusicAtMOD" "Mix_FadeInMusicPos" $
SDL.Raw.Mixer.fadeInMusicPos
p t' (fromIntegral ms) (realToFrac at)
where
t' = case times of
Forever -> (-1)
Times t -> max 1 t
fadingMusic :: MonadIO m => m Fading
fadingMusic = wordToFading <$> SDL.Raw.Mixer.fadingMusic
getMusicVolume :: MonadIO m => m Volume
getMusicVolume = fmap fromIntegral $ SDL.Raw.Mixer.volumeMusic (-1)
setMusicVolume :: MonadIO m => Volume -> m ()
setMusicVolume v = void . SDL.Raw.Mixer.volumeMusic $ volumeToCInt v
data MusicType
= CMD
| WAV
| MOD
| MID
| OGG
| MP3
| MP3_MAD
| FLAC
| MODPlug
deriving (Eq, Show, Read, Ord, Bounded)
wordToMusicType :: SDL.Raw.Mixer.MusicType -> Maybe MusicType
wordToMusicType = \case
SDL.Raw.Mixer.MUS_NONE -> Nothing
SDL.Raw.Mixer.MUS_CMD -> Just CMD
SDL.Raw.Mixer.MUS_WAV -> Just WAV
SDL.Raw.Mixer.MUS_MOD -> Just MOD
SDL.Raw.Mixer.MUS_MID -> Just MID
SDL.Raw.Mixer.MUS_OGG -> Just OGG
SDL.Raw.Mixer.MUS_MP3 -> Just MP3
SDL.Raw.Mixer.MUS_MP3_MAD -> Just MP3_MAD
SDL.Raw.Mixer.MUS_FLAC -> Just FLAC
SDL.Raw.Mixer.MUS_MODPLUG -> Just MODPlug
_ -> Nothing
musicType :: Music -> Maybe MusicType
musicType (Music p) =
wordToMusicType $ unsafePerformIO (SDL.Raw.Mixer.getMusicType p)
playingMusicType :: MonadIO m => m (Maybe MusicType)
playingMusicType = wordToMusicType <$> SDL.Raw.Mixer.getMusicType nullPtr
{-# NOINLINE musicFinishedFunPtr #-}
musicFinishedFunPtr :: IORef (FunPtr (IO ()))
musicFinishedFunPtr = unsafePerformIO $ newIORef nullFunPtr
whenMusicFinished :: MonadIO m => IO () -> m ()
whenMusicFinished callback = liftIO $ do
callbackRaw <- SDL.Raw.Mixer.wrapMusicCallback callback
SDL.Raw.Mixer.hookMusicFinished callbackRaw
lastFunPtr <- readIORef musicFinishedFunPtr
when (lastFunPtr /= nullFunPtr) $ freeHaskellFunPtr lastFunPtr
writeIORef musicFinishedFunPtr callbackRaw
type Effect = Channel -> IOVector Word8 -> IO ()
type EffectFinished = Channel -> IO ()
pattern PostProcessing = SDL.Raw.Mixer.CHANNEL_POST :: Channel
effect :: MonadIO m => Channel -> EffectFinished -> Effect -> m (m ())
effect (Channel channel) fin ef = do
ef' <- liftIO $ SDL.Raw.Mixer.wrapEffect $ \c p len _ -> do
fp <- castForeignPtr <$> newForeignPtr_ p
ef (Channel c) . unsafeFromForeignPtr0 fp $ fromIntegral len
fin' <- liftIO $ SDL.Raw.Mixer.wrapEffectFinished $ \c _ ->
fin $ Channel c
result <- SDL.Raw.Mixer.registerEffect channel ef' fin' nullPtr
if result == 0 then do
liftIO $ freeHaskellFunPtr ef' >> freeHaskellFunPtr fin'
throwFailed "SDL.Raw.Mixer.addEffect" "Mix_RegisterEffect"
else
return . liftIO $ do
removed <- SDL.Raw.Mixer.unregisterEffect channel ef'
freeHaskellFunPtr ef' >> freeHaskellFunPtr fin'
when (removed == 0) $
throwFailed "SDL.Raw.Mixer.removeEffect" "Mix_UnregisterEffect"
effectPan :: MonadIO m => Channel -> Volume -> Volume -> m (m ())
effectPan channel@(Channel c) lVol rVol = do
void . throwIf0 "SDL.Raw.Mixer.effectPan" "Mix_SetPanning" $
SDL.Raw.Mixer.setPanning c (wordVol lVol) (wordVol rVol)
return . void $ effectPan channel 128 128
wordVol :: Volume -> Word8
wordVol = fromIntegral . min 255 . (*2) . volumeToCInt
effectDistance :: MonadIO m => Channel -> Word8 -> m (m ())
effectDistance channel@(Channel c) dist = do
void . throwIf0 "SDL.Raw.Mixer.effectDistance" "Mix_SetDistance" $
SDL.Raw.Mixer.setDistance c dist
return . void $ effectDistance channel 0
effectPosition :: MonadIO m => Channel -> Int16 -> Word8 -> m (m ())
effectPosition channel@(Channel c) angle dist = do
void . throwIf0 "SDL.Raw.Mixer.effectPosition" "Mix_SetPosition" $
SDL.Raw.Mixer.setPosition c angle dist
return . void $ effectPosition channel 0 0
effectReverseStereo :: MonadIO m => Channel -> Bool -> m (m ())
effectReverseStereo channel@(Channel c) rev = do
void . throwIf0 "SDL.Raw.Mixer.effectReverseStereo" "Mix_SetReverseStereo" $
SDL.Raw.Mixer.setReverseStereo c (if rev then 1 else 0)
return . void $ effectReverseStereo channel False