module Sound.MikMod
(
mikmodSetMusicVolume,
mikmodGetMusicVolume,
mikmodSetPanSep,
mikmodGetPanSep,
mikmodSetReverb,
mikmodGetReverb,
mikmodSetSndFXVolume,
mikmodGetSndFXVolume,
mikmodSetVolume,
mikmodGetVolume,
mikmodSetDeviceIndex,
mikmodGetDeviceIndex,
MDriverInfo(..),
mikmodGetDriver,
mikmodGetMixFreq,
mikmodSetMixFreq,
DriverModeFlag(..),
mikmodModifyDriverModeFlags,
mikmodGetDriverModeFlags,
mikmodSetDriverModeFlags,
runMikMod,
mikmodSetup,
mikmodGetVersion,
mikmodGetError,
mikmodRegisterAllDrivers,
mikmodRegisterAllLoaders,
mikmodInit,
mikmodInitSafe,
mikmodActive,
mikmodInfoDriver,
mikmodInfoLoader,
mikmodSetNumVoices,
mikmodSetNumVoicesSafe,
mikmodReset,
mikmodResetSafe,
mikmodDisableOutput,
mikmodEnableOutput,
mikmodUpdate,
mikmodExit,
CuriousFlag(..),
playerLoad,
playerLoadSafe,
playerLoadGeneric,
playerLoadGenericSafe,
playerLoadTitle,
playerStart,
playerStop,
playerPaused,
playerTogglePause,
playerActive,
playerFree,
playerGetChannelVoice,
playerGetModule,
MuteOperation(..),
playerMuteChannel,
playerMuteChannels,
playerUnmuteChannel,
playerUnmuteChannels,
playerToggleMuteChannel,
playerToggleMuteChannels,
playerMuted,
playerNextPosition,
playerPrevPosition,
playerSetPosition,
playerSetSpeed,
playerSetTempo,
ModuleHandle,
ModuleInfo(..),
ModuleFlag(..),
getModuleInfo,
getModuleRealChannels,
getModuleTotalChannels,
getModuleSongTime,
getModuleSongPosition,
getModulePatternPosition,
setModuleInitSpeed,
getModuleInitSpeed,
setModuleInitTempo,
getModuleInitTempo,
setModulePanning,
getModulePanning,
setModuleChannelVolume,
getModuleChannelVolume,
setModuleBPM,
getModuleBPM,
setModuleSongSpeed,
getModuleSongSpeed,
setModuleExtSpeed,
getModuleExtSpeed,
setModulePanFlag,
getModulePanFlag,
setModuleWrap,
getModuleWrap,
setModuleRepeatPosition,
getModuleRepeatPosition,
setModuleLoop,
getModuleLoop,
setModuleFadeout,
getModuleFadeout,
setModuleRelativeSpeed,
getModuleRelativeSpeed,
getModuleSamples,
SampleHandle,
SampleInfo(..),
sampleLoad,
sampleLoadSafe,
sampleLoadGeneric,
sampleLoadGenericSafe,
samplePlay,
samplePlayCritical,
sampleFree,
getSampleInfo,
Pan(..),
panLeft,
panRight,
setSamplePanning,
getSamplePanning,
setSampleSpeed,
getSampleSpeed,
setSampleVolume,
getSampleVolume,
SampleFlag(..),
modifySampleFlags,
getSampleFlags,
setSampleFlags,
getSampleInFlags,
getSampleLength,
setSampleLoopStart,
getSampleLoopStart,
setSampleLoopEnd,
getSampleLoopEnd,
Voice(..),
voicePlay,
voiceStop,
voiceStopped,
voiceSetVolume,
voiceGetVolume,
voiceSetFrequency,
voiceGetFrequency,
voiceSetPanning,
voiceGetPanning,
voiceGetPosition,
voiceRealVolume,
MReader(..),
Outcome(..),
IsEOF(..),
byteStringReader,
handleReader,
MikModError(..),
MikModException(..),
describeMikModError,
getErrno,
MikModErrno(..),
mikmodInitThreads,
withMikMod
)
where
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Storable
import Foreign.C.String
import Data.Functor
import Control.Applicative
import Control.Exception
import Data.Bits
import Sound.MikMod.Synonyms
import Sound.MikMod.Types
import Sound.MikMod.Errors
import Sound.MikMod.Flags
import Sound.MikMod.Internal
import Sound.MikMod.MReader
import Sound.MikMod.Module
import Sound.MikMod.Sample
mikmodSetMusicVolume :: Int -> IO ()
mikmodSetMusicVolume v = poke c_md_musicvolume (fromIntegral v)
mikmodGetMusicVolume :: IO Int
mikmodGetMusicVolume = fromIntegral <$> peek c_md_musicvolume
mikmodSetPanSep :: Int -> IO ()
mikmodSetPanSep v = poke c_md_pansep (fromIntegral v)
mikmodGetPanSep :: IO Int
mikmodGetPanSep = fromIntegral <$> peek c_md_pansep
mikmodSetReverb :: Int -> IO ()
mikmodSetReverb v = poke c_md_reverb (fromIntegral v)
mikmodGetReverb :: IO Int
mikmodGetReverb = fromIntegral <$> peek c_md_reverb
mikmodSetSndFXVolume :: Int -> IO ()
mikmodSetSndFXVolume v = poke c_md_sndfxvolume (fromIntegral v)
mikmodGetSndFXVolume :: IO Int
mikmodGetSndFXVolume = fromIntegral <$> peek c_md_sndfxvolume
mikmodSetVolume :: Int -> IO ()
mikmodSetVolume v = poke c_md_volume (fromIntegral v)
mikmodGetVolume :: IO Int
mikmodGetVolume = fromIntegral <$> peek c_md_volume
mikmodGetDeviceIndex :: IO Int
mikmodGetDeviceIndex = fromIntegral <$> peek c_md_device
mikmodSetDeviceIndex :: Int -> IO ()
mikmodSetDeviceIndex i = poke c_md_device (fromIntegral i)
mikmodGetDriver :: IO (Maybe MDriverInfo)
mikmodGetDriver = do
r <- peek c_md_driver
if r == nullPtr
then return Nothing
else Just <$> peekMDriver r
mikmodSetMixFreq :: Int -> IO ()
mikmodSetMixFreq freq = poke c_md_mixfreq (fromIntegral freq)
mikmodGetMixFreq :: IO Int
mikmodGetMixFreq = fromIntegral <$> peek c_md_mixfreq
mikmodModifyDriverModeFlags :: ([DriverModeFlag] -> [DriverModeFlag]) -> IO ()
mikmodModifyDriverModeFlags f = do
flags <- mikmodGetDriverModeFlags
mikmodSetDriverModeFlags (f flags)
mikmodGetDriverModeFlags :: IO [DriverModeFlag]
mikmodGetDriverModeFlags = unpackFlags <$> peek c_md_mode
mikmodSetDriverModeFlags :: [DriverModeFlag] -> IO ()
mikmodSetDriverModeFlags flags = poke c_md_mode (packFlags flags)
mikmodInit :: String -> IO ()
mikmodInit params = do
r <- mikmodInitSafe params
case r of
Left e -> throwIO (MikModException e)
Right _ -> return ()
mikmodInitSafe :: String -> IO (Either MikModError ())
mikmodInitSafe params = withCString params $ \ptr -> do
n <- c_MikMod_Init ptr
if n == 0
then return (Right ())
else Left <$> mikmodGetError
mikmodSetup :: Int -> IO ()
mikmodSetup sfxVoices = do
mikmodRegisterAllDrivers
mikmodRegisterAllLoaders
mikmodInit ""
mikmodSetNumVoices (-1) sfxVoices
mikmodEnableOutput
runMikMod :: Int -> IO a -> IO a
runMikMod sfxVoices action = do
mikmodSetup sfxVoices
action `finally` mikmodExit
mikmodExit :: IO ()
mikmodExit = c_MikMod_Exit
mikmodActive :: IO Bool
mikmodActive = decodeBool <$> c_MikMod_Active
mikmodEnableOutput :: IO ()
mikmodEnableOutput = c_MikMod_EnableOutput
mikmodDisableOutput :: IO ()
mikmodDisableOutput = c_MikMod_DisableOutput
mikmodGetVersion :: IO (Int, Int, Int)
mikmodGetVersion = do
enc <- fromIntegral <$> c_MikMod_GetVersion
return (enc `shiftR` 16, 0xff .&. (enc `shiftR` 8), 0xff .&. enc)
mikmodInfoDriver :: IO (Maybe String)
mikmodInfoDriver = mikmodGetString c_MikMod_InfoDriver
mikmodInfoLoader :: IO (Maybe String)
mikmodInfoLoader = mikmodGetString c_MikMod_InfoLoader
mikmodInitThreads :: IO Bool
mikmodInitThreads = decodeBool <$> c_MikMod_InitThreads
withMikMod :: IO a -> IO a
withMikMod = c_MikMod_Lock `bracket_` c_MikMod_Unlock
mikmodRegisterAllDrivers :: IO ()
mikmodRegisterAllDrivers = c_MikMod_RegisterAllDrivers
mikmodRegisterAllLoaders :: IO ()
mikmodRegisterAllLoaders = c_MikMod_RegisterAllLoaders
mikmodReset :: String -> IO ()
mikmodReset params = do
r <- mikmodResetSafe params
case r of
Left e -> throwIO (MikModException e)
Right _ -> return ()
mikmodResetSafe :: String -> IO (Either MikModError ())
mikmodResetSafe params = withCString params $ \ptr -> do
n <- c_MikMod_Reset ptr
if n == 0
then return (Right ())
else Left <$> mikmodGetError
mikmodSetNumVoices :: Int
-> Int
-> IO ()
mikmodSetNumVoices music sample = do
r <- mikmodSetNumVoicesSafe music sample
case r of
Left e -> throwIO (MikModException e)
Right _ -> return ()
mikmodSetNumVoicesSafe :: Int -> Int -> IO (Either MikModError ())
mikmodSetNumVoicesSafe music sample = do
n <- c_MikMod_SetNumVoices (fromIntegral music) (fromIntegral sample)
if n == 0
then return (Right ())
else Left <$> mikmodGetError
mikmodUpdate :: IO ()
mikmodUpdate = c_MikMod_Update
playerActive :: IO Bool
playerActive = decodeBool <$> c_Player_Active
playerFree :: ModuleHandle -> IO ()
playerFree = c_Player_Free
playerGetChannelVoice :: Int -> IO (Maybe Voice)
playerGetChannelVoice ch = do
v <- c_Player_GetChannelVoice (fromIntegral ch)
if v >= 0
then return $ Just (Voice v)
else return Nothing
playerGetModule :: IO (Maybe ModuleHandle)
playerGetModule = do
ptr <- c_Player_GetModule
if ptr == nullPtr
then pure Nothing
else pure (Just ptr)
playerLoad :: FilePath -> Int -> CuriousFlag -> IO ModuleHandle
playerLoad path maxChans curious = do
r <- playerLoadSafe path maxChans curious
case r of
Left e -> throwIO (MikModException e)
Right mod -> return mod
playerLoadSafe :: FilePath -> Int -> CuriousFlag -> IO (Either MikModError ModuleHandle)
playerLoadSafe path maxChans curious = withCString path $ \cstr -> do
ptr <- c_Player_Load cstr (fromIntegral maxChans) (marshalCurious curious)
if ptr == nullPtr
then Left <$> mikmodGetError
else Right <$> pure ptr
playerLoadGeneric :: MReader -> Int -> CuriousFlag -> IO ModuleHandle
playerLoadGeneric rd maxChans curious = do
r <- playerLoadGenericSafe rd maxChans curious
case r of
Left e -> throwIO (MikModException e)
Right mod -> return mod
playerLoadGenericSafe :: MReader -> Int -> CuriousFlag -> IO (Either MikModError ModuleHandle)
playerLoadGenericSafe rd maxChans curious = withMReader rd $ \rptr -> do
mptr <- c_Player_LoadGeneric rptr (fromIntegral maxChans) (marshalCurious curious)
if mptr == nullPtr
then Left <$> mikmodGetError
else Right <$> pure mptr
playerLoadTitle :: FilePath -> IO (Maybe String)
playerLoadTitle path = do
result <- playerLoadTitleSafe path
case result of
Left e -> throwIO (MikModException e)
Right mtitle -> return mtitle
playerLoadTitleSafe :: FilePath -> IO (Either MikModError (Maybe String))
playerLoadTitleSafe path = do
result <- withCString path c_Player_LoadTitle
if result == nullPtr
then do
mme <- mikmodGetError
if isNotAnError mme
then return (Right Nothing)
else return (Left mme)
else Right . Just <$> peekCString result
playerMuteChannel :: Int -> IO ()
playerMuteChannel ch = c_Player_MuteChannel (fromIntegral ch)
playerMuteChannels :: MuteOperation -> Int -> Int -> IO ()
playerMuteChannels op chanL chanU = c_Player_MuteChannels
(marshalMuteOperation op)
(fromIntegral chanL)
(fromIntegral chanU)
playerMuted :: Int -> IO Bool
playerMuted ch = decodeBool <$> c_Player_Muted (fromIntegral ch)
playerNextPosition :: IO ()
playerNextPosition = c_Player_NextPosition
playerPrevPosition :: IO ()
playerPrevPosition = c_Player_PrevPosition
playerPaused :: IO Bool
playerPaused = decodeBool <$> c_Player_Paused
playerSetPosition :: Int -> IO ()
playerSetPosition pos = c_Player_SetPosition (fromIntegral pos)
playerSetSpeed :: Int -> IO ()
playerSetSpeed speed = c_Player_SetSpeed (fromIntegral speed)
playerSetTempo :: Int -> IO ()
playerSetTempo tempo = c_Player_SetTempo (fromIntegral tempo)
playerSetVolume :: Int -> IO ()
playerSetVolume volume = c_Player_SetVolume (fromIntegral volume)
playerStart :: ModuleHandle -> IO ()
playerStart = c_Player_Start
playerStop :: IO ()
playerStop = c_Player_Stop
playerToggleMuteChannel :: Int -> IO ()
playerToggleMuteChannel ch = c_Player_ToggleMuteChannel (fromIntegral ch)
playerToggleMuteChannels :: MuteOperation -> Int -> Int -> IO ()
playerToggleMuteChannels op chanL chanU = c_Player_ToggleMuteChannels
(marshalMuteOperation op)
(fromIntegral chanL)
(fromIntegral chanU)
playerTogglePause :: IO ()
playerTogglePause = c_Player_TogglePause
playerUnmuteChannel :: Int -> IO ()
playerUnmuteChannel ch = c_Player_UnmuteChannel (fromIntegral ch)
playerUnmuteChannels :: MuteOperation -> Int -> Int -> IO ()
playerUnmuteChannels op chanL chanU = c_Player_UnmuteChannels
(marshalMuteOperation op)
(fromIntegral chanL)
(fromIntegral chanU)
sampleLoad :: FilePath -> IO SampleHandle
sampleLoad path = do
r <- sampleLoadSafe path
case r of
Left e -> throwIO (MikModException e)
Right samp -> return samp
sampleLoadSafe :: FilePath -> IO (Either MikModError SampleHandle)
sampleLoadSafe path = withCString path $ \cstr -> do
ptr <- c_Sample_Load cstr
if ptr == nullPtr
then Left <$> mikmodGetError
else Right <$> pure ptr
sampleLoadGeneric :: MReader -> IO SampleHandle
sampleLoadGeneric mr = do
r <- sampleLoadGenericSafe mr
case r of
Left e -> throwIO (MikModException e)
Right samp -> return samp
sampleLoadGenericSafe :: MReader -> IO (Either MikModError SampleHandle)
sampleLoadGenericSafe mr = withMReader mr $ \rptr -> do
sptr <- c_Sample_LoadGeneric rptr
if sptr == nullPtr
then Left <$> mikmodGetError
else Right <$> pure sptr
samplePlay :: SampleHandle -> Int -> IO (Maybe Voice)
samplePlay samp start = do
v <- c_Sample_Play samp (fromIntegral start) 0
if v >= 0
then (return . Just . Voice) v
else return Nothing
samplePlayCritical :: SampleHandle -> Int -> IO (Maybe Voice)
samplePlayCritical samp start = do
v <- c_Sample_Play samp (fromIntegral start) sfxCritical
if v >= 0
then (return . Just . Voice) v
else return Nothing
sampleFree :: SampleHandle -> IO ()
sampleFree = c_Sample_Free
voiceSetVolume :: Voice -> Int -> IO ()
voiceSetVolume v vol = c_Voice_SetVolume (marshalVoice v) (fromIntegral vol)
voiceGetVolume :: Voice -> IO Int
voiceGetVolume v = fromIntegral <$> c_Voice_GetVolume (marshalVoice v)
voiceSetFrequency :: Voice -> Int -> IO ()
voiceSetFrequency v freq = c_Voice_SetFrequency (marshalVoice v) (fromIntegral freq)
voiceGetFrequency :: Voice -> IO Int
voiceGetFrequency v = fromIntegral <$> c_Voice_GetFrequency (marshalVoice v)
voiceSetPanning :: Voice -> Int -> IO ()
voiceSetPanning v pan = c_Voice_SetPanning (marshalVoice v) (fromIntegral pan)
voiceGetPanning :: Voice -> IO Int
voiceGetPanning v = fromIntegral <$> c_Voice_GetPanning (marshalVoice v)
voicePlay :: Voice -> SampleHandle -> Int -> IO ()
voicePlay v samp start = c_Voice_Play (marshalVoice v) samp (fromIntegral start)
voiceStop :: Voice -> IO ()
voiceStop v = c_Voice_Stop (marshalVoice v)
voiceStopped :: Voice -> IO Bool
voiceStopped v = decodeBool <$> c_Voice_Stopped (marshalVoice v)
voiceGetPosition :: Voice -> IO Int
voiceGetPosition v = fromIntegral <$> c_Voice_GetPosition (marshalVoice v)
voiceRealVolume :: Voice -> IO Int
voiceRealVolume v = fromIntegral <$> c_Voice_RealVolume (marshalVoice v)