module Sound.ALUT.Initialization (
ArgumentConsumer, Runner, runALUT, runALUTUsingCurrentContext,
withProgNameAndArgs
) where
import Control.Monad.IO.Class ( MonadIO(..) )
import Data.List ( genericLength )
import Foreign.C.String ( CString, withCString, peekCString )
import Foreign.C.Types ( CInt )
import Foreign.Marshal.Array ( withArray0, peekArray )
import Foreign.Marshal.Utils ( with, withMany )
import Foreign.Ptr ( Ptr, nullPtr )
import Foreign.Storable ( Storable(peek) )
import Sound.OpenAL.AL.BasicTypes ( ALboolean )
import System.Environment ( getProgName, getArgs )
import Sound.ALUT.Config
import Sound.ALUT.Errors
type ArgumentConsumer a = String -> [String] -> a
type Runner m a = ArgumentConsumer (m a) -> m a
runALUT :: MonadIO m => ArgumentConsumer (Runner m a)
runALUT = runner "runALUT" alut_Init
runALUTUsingCurrentContext :: MonadIO m => ArgumentConsumer (Runner m a)
runALUTUsingCurrentContext =
runner "runALUTUsingCurrentContext" alut_InitWithoutContext
runner :: MonadIO m => String -> (Ptr CInt -> Ptr CString -> IO ALboolean) -> String
-> [String] -> Runner m a
runner name initAction progName args action = do
argv <- liftIO $ foo name initAction progName args
result <- action (head argv) (tail argv)
liftIO $ throwIfALfalse name alut_Exit
return result
foo :: String -> (Ptr CInt -> Ptr CString -> IO ALboolean) -> String -> [String] -> IO [String]
foo name initAction progName args =
with (1 + genericLength args) $ \argcBuf ->
withMany withCString (progName : args) $ \argvPtrs ->
withArray0 nullPtr argvPtrs $ \argvBuf -> do
throwIfALfalse name $ initAction argcBuf argvBuf
newArgc <- peek argcBuf
newArgvPtrs <- peekArray (fromIntegral newArgc) argvBuf
mapM peekCString newArgvPtrs
withProgNameAndArgs :: MonadIO m => (ArgumentConsumer (Runner m a)) -> Runner m a
withProgNameAndArgs alutRunner action = do
n <- liftIO getProgName
a <- liftIO getArgs
alutRunner n a action