-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.SDL.Mixer.Music
-- Copyright   :  (c) David Himmelstrup 2005
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-----------------------------------------------------------------------------
module Graphics.UI.SDL.Mixer.Music
    ( freeMusic
    , tryLoadMUS
    , loadMUS
    , tryPlayMusic
    , playMusic
    , tryFadeInMusic
    , fadeInMusic
    , tryFadeInMusicPos
    , fadeInMusicPos
    , setMusicVolume
    , getMusicVolume
    , modifyMusicVolume
    , pauseMusic
    , resumeMusic
    , rewindMusic
    , trySetMusicPosition
    , setMusicPosition
    , trySetMusicCmd
    , setMusicCmd
    , disableMusicCmd
    , haltMusic
    , tryFadeOutMusic
    , fadeOutMusic
    , getMusicType
    , playingMusic
    , pausedMusic
    , fadingMusic
    ) where


import Foreign(Ptr, FunPtr, nullPtr, toBool, withForeignPtr, newForeignPtr)
import Foreign.C(withCString, CString)

import Graphics.UI.SDL.Mixer.Types(Fading, MusicType, Music, MusicStruct)
import Graphics.UI.SDL.General(unwrapMaybe, unwrapBool)

-- void Mix_FreeMusic(Mix_Music *music)
foreign import ccall unsafe "&Mix_FreeMusic" mixFreeMusicFinal :: FunPtr (Ptr MusicStruct -> IO ())

mkFinalizedMusic :: Ptr MusicStruct -> IO Music
mkFinalizedMusic :: Ptr MusicStruct -> IO Music
mkFinalizedMusic = FinalizerPtr MusicStruct -> Ptr MusicStruct -> IO Music
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr MusicStruct
mixFreeMusicFinal

foreign import ccall unsafe "Mix_FreeMusic" mixFreeMusic :: Ptr MusicStruct -> IO ()
freeMusic :: Music -> IO ()
freeMusic :: Music -> IO ()
freeMusic Music
music = Music -> (Ptr MusicStruct -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Music
music Ptr MusicStruct -> IO ()
mixFreeMusic

-- Mix_Music *Mix_LoadMUS(const char *file)
foreign import ccall unsafe "Mix_LoadMUS" mixLoadMUS :: CString -> IO (Ptr MusicStruct)
tryLoadMUS :: FilePath -> IO (Maybe Music)
tryLoadMUS :: FilePath -> IO (Maybe Music)
tryLoadMUS FilePath
path
    = FilePath -> (CString -> IO (Maybe Music)) -> IO (Maybe Music)
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
path ((CString -> IO (Maybe Music)) -> IO (Maybe Music))
-> (CString -> IO (Maybe Music)) -> IO (Maybe Music)
forall a b. (a -> b) -> a -> b
$ \CString
cPath ->
      do Ptr MusicStruct
music <- CString -> IO (Ptr MusicStruct)
mixLoadMUS CString
cPath
         if Ptr MusicStruct
music Ptr MusicStruct -> Ptr MusicStruct -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr MusicStruct
forall a. Ptr a
nullPtr
            then Maybe Music -> IO (Maybe Music)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Music
forall a. Maybe a
Nothing
            else (Music -> Maybe Music) -> IO Music -> IO (Maybe Music)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Music -> Maybe Music
forall a. a -> Maybe a
Just (Ptr MusicStruct -> IO Music
mkFinalizedMusic Ptr MusicStruct
music)

loadMUS :: FilePath -> IO Music
loadMUS :: FilePath -> IO Music
loadMUS = FilePath -> IO (Maybe Music) -> IO Music
forall a. FilePath -> IO (Maybe a) -> IO a
unwrapMaybe FilePath
"Mix_LoadMUS" (IO (Maybe Music) -> IO Music)
-> (FilePath -> IO (Maybe Music)) -> FilePath -> IO Music
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Maybe Music)
tryLoadMUS

-- int Mix_PlayMusic(Mix_Music *music, int loops)
foreign import ccall unsafe "Mix_PlayMusic" mixPlayMusic :: Ptr MusicStruct -> Int -> IO Int
tryPlayMusic :: Music -> Int -> IO Bool
tryPlayMusic :: Music -> Int -> IO Bool
tryPlayMusic Music
music Int
loops
    = Music -> (Ptr MusicStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Music
music ((Ptr MusicStruct -> IO Bool) -> IO Bool)
-> (Ptr MusicStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr MusicStruct
musicPtr ->
      (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0) (Ptr MusicStruct -> Int -> IO Int
mixPlayMusic Ptr MusicStruct
musicPtr Int
loops)

playMusic :: Music -> Int -> IO ()
playMusic :: Music -> Int -> IO ()
playMusic Music
music Int
loops = FilePath -> IO Bool -> IO ()
unwrapBool FilePath
"Mix_PlayMusic" (Music -> Int -> IO Bool
tryPlayMusic Music
music Int
loops)

tryFadeInMusic :: Music -> Int -> Int -> IO Bool
tryFadeInMusic :: Music -> Int -> Int -> IO Bool
tryFadeInMusic Music
music Int
loops Int
ms
    = Music -> Int -> Int -> Double -> IO Bool
tryFadeInMusicPos Music
music Int
loops Int
ms Double
0

fadeInMusic :: Music -> Int -> Int -> IO ()
fadeInMusic :: Music -> Int -> Int -> IO ()
fadeInMusic Music
music Int
loops Int
ms
    = Music -> Int -> Int -> Double -> IO ()
fadeInMusicPos Music
music Int
loops Int
ms Double
0

-- int Mix_FadeInMusicPos(Mix_Music *music, int loops, int ms, double position)
foreign import ccall unsafe "Mix_FadeInMusicPos" mixFadeInMusicPos
    :: Ptr MusicStruct -> Int -> Int -> Double -> IO Int
tryFadeInMusicPos :: Music -> Int -> Int -> Double -> IO Bool
tryFadeInMusicPos :: Music -> Int -> Int -> Double -> IO Bool
tryFadeInMusicPos Music
music Int
loops Int
ms Double
pos
    = Music -> (Ptr MusicStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Music
music ((Ptr MusicStruct -> IO Bool) -> IO Bool)
-> (Ptr MusicStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr MusicStruct
musicPtr ->
      (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0) (Ptr MusicStruct -> Int -> Int -> Double -> IO Int
mixFadeInMusicPos Ptr MusicStruct
musicPtr Int
loops Int
ms Double
pos)

fadeInMusicPos :: Music -> Int -> Int -> Double -> IO ()
fadeInMusicPos :: Music -> Int -> Int -> Double -> IO ()
fadeInMusicPos Music
music Int
loops Int
ms Double
pos
    = FilePath -> IO Bool -> IO ()
unwrapBool FilePath
"Mix_FadeInMusic" (Music -> Int -> Int -> Double -> IO Bool
tryFadeInMusicPos Music
music Int
loops Int
ms Double
pos)

-- int Mix_VolumeMusic(int volume)
foreign import ccall unsafe "Mix_VolumeMusic" mixVolumeMusic :: Int -> IO Int

setMusicVolume :: Int -> IO ()
setMusicVolume :: Int -> IO ()
setMusicVolume Int
volume = Int -> IO Int
mixVolumeMusic Int
volume IO Int -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

getMusicVolume :: IO Int
getMusicVolume :: IO Int
getMusicVolume = Int -> IO Int
mixVolumeMusic (-Int
1)

modifyMusicVolume :: (Int -> Int) -> IO ()
modifyMusicVolume :: (Int -> Int) -> IO ()
modifyMusicVolume Int -> Int
fn = IO Int
getMusicVolume IO Int -> (Int -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> IO ()
setMusicVolume (Int -> IO ()) -> (Int -> Int) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
fn

-- void Mix_PauseMusic()
foreign import ccall unsafe "Mix_PauseMusic" pauseMusic :: IO ()

-- void Mix_ResumeMusic()
foreign import ccall unsafe "Mix_ResumeMusic" resumeMusic :: IO ()

-- void Mix_RewindMusic()
foreign import ccall unsafe "Mix_RewindMusic" rewindMusic :: IO ()

-- int Mix_SetMusicPosition(double position)
foreign import ccall unsafe "Mix_SetMusicPosition" mixSetMusicPosition :: Double -> IO Int

trySetMusicPosition :: Double -> IO Bool
trySetMusicPosition :: Double -> IO Bool
trySetMusicPosition = (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0) (IO Int -> IO Bool) -> (Double -> IO Int) -> Double -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> IO Int
mixSetMusicPosition

setMusicPosition :: Double -> IO ()
setMusicPosition :: Double -> IO ()
setMusicPosition = FilePath -> IO Bool -> IO ()
unwrapBool FilePath
"Mix_SetMusicPosition" (IO Bool -> IO ()) -> (Double -> IO Bool) -> Double -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> IO Bool
trySetMusicPosition

-- int Mix_SetMusicCMD(const char *command)
foreign import ccall unsafe "Mix_SetMusicCMD" mixSetMusicCmd :: CString -> IO Int

trySetMusicCmd :: String -> IO Bool
trySetMusicCmd :: FilePath -> IO Bool
trySetMusicCmd FilePath
cmd
    = FilePath -> (CString -> IO Bool) -> IO Bool
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
cmd ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \CString
cString ->
      (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0) (CString -> IO Int
mixSetMusicCmd CString
cString)

setMusicCmd :: String -> IO ()
setMusicCmd :: FilePath -> IO ()
setMusicCmd FilePath
cmd = FilePath -> IO Bool -> IO ()
unwrapBool FilePath
"Mix_SetMusicCMD" (FilePath -> IO Bool
trySetMusicCmd FilePath
cmd)

disableMusicCmd :: IO ()
disableMusicCmd :: IO ()
disableMusicCmd = CString -> IO Int
mixSetMusicCmd CString
forall a. Ptr a
nullPtr IO Int -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- int Mix_HaltMusic()
foreign import ccall unsafe "Mix_HaltMusic" mixHaltMusic :: IO Int
haltMusic :: IO ()
haltMusic :: IO ()
haltMusic = IO Int
mixHaltMusic IO Int -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- int Mix_FadeOutMusic(int ms)
foreign import ccall unsafe "Mix_FadeOutMusic" mixFadeOutMusic :: Int -> IO Int
tryFadeOutMusic :: Int -> IO Bool
tryFadeOutMusic :: Int -> IO Bool
tryFadeOutMusic Int
ms = (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1) (Int -> IO Int
mixFadeOutMusic Int
ms)

fadeOutMusic :: Int -> IO ()
fadeOutMusic :: Int -> IO ()
fadeOutMusic Int
ms = FilePath -> IO Bool -> IO ()
unwrapBool FilePath
"Mix_FadeOutMusic" (Int -> IO Bool
tryFadeOutMusic Int
ms)

-- Mix_MusicType Mix_GetMusicType(const Mix_Music *music)
foreign import ccall unsafe "Mix_GetMusicType" mixGetMusicType :: Ptr MusicStruct -> IO Int

getMusicType :: Maybe Music -> IO MusicType
getMusicType :: Maybe Music -> IO MusicType
getMusicType Maybe Music
mbMusic
    = Maybe Music -> (Ptr MusicStruct -> IO MusicType) -> IO MusicType
forall a b. Maybe (ForeignPtr a) -> (Ptr a -> IO b) -> IO b
withMusic Maybe Music
mbMusic ((Ptr MusicStruct -> IO MusicType) -> IO MusicType)
-> (Ptr MusicStruct -> IO MusicType) -> IO MusicType
forall a b. (a -> b) -> a -> b
$ \Ptr MusicStruct
musicPtr ->
      (Int -> MusicType) -> IO Int -> IO MusicType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> MusicType
forall a. Enum a => Int -> a
toEnum (Ptr MusicStruct -> IO Int
mixGetMusicType Ptr MusicStruct
musicPtr)
    where withMusic :: Maybe (ForeignPtr a) -> (Ptr a -> IO b) -> IO b
withMusic Maybe (ForeignPtr a)
Nothing Ptr a -> IO b
action = Ptr a -> IO b
action Ptr a
forall a. Ptr a
nullPtr
          withMusic (Just ForeignPtr a
music) Ptr a -> IO b
action = ForeignPtr a -> (Ptr a -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
music Ptr a -> IO b
action

-- int Mix_PlayingMusic()
foreign import ccall unsafe "Mix_PlayingMusic" mixPlayingMusic :: IO Int

playingMusic :: IO Bool
playingMusic :: IO Bool
playingMusic = (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool IO Int
mixPlayingMusic

-- int Mix_PausedMusic()
foreign import ccall unsafe "Mix_PausedMusic" mixPausedMusic :: IO Int

pausedMusic :: IO Bool
pausedMusic :: IO Bool
pausedMusic = (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool IO Int
mixPausedMusic

-- Mix_Fading Mix_FadingMusic()
foreign import ccall unsafe "Mix_FadingMusic" mixFadingMusic :: IO Int

fadingMusic :: IO Fading
fadingMusic :: IO Fading
fadingMusic = (Int -> Fading) -> IO Int -> IO Fading
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Fading
forall a. Enum a => Int -> a
toEnum IO Int
mixFadingMusic