module Sound.OpenAL.Config (
ALboolean, ALchar, ALbyte, ALubyte, ALshort, ALushort, ALint, ALuint,
ALsizei, ALenum, ALfloat, ALdouble,
ALCboolean, ALCchar, ALCbyte, ALCubyte, ALCshort, ALCushort, ALCint, ALCuint,
ALCsizei, ALCenum, ALCfloat, ALCdouble,
ALCdevice, Device, nullDevice, marshalDevice, unmarshalDevice, closeDevice,
ALCcontext, Context, nullContext, marshalContext, unmarshalContext,
alcProcessContext, alcMakeContextCurrent, alcDestroyContext
) where
import Data.Int
import Data.Word
import Foreign.Ptr ( Ptr, nullPtr )
#include "HsOpenALConfig.h"
type ALboolean = HTYPE_ALBOOLEAN
type ALchar = HTYPE_ALCHAR
type ALbyte = HTYPE_ALBYTE
type ALubyte = HTYPE_ALUBYTE
type ALshort = HTYPE_ALSHORT
type ALushort = HTYPE_ALUSHORT
type ALint = HTYPE_ALINT
type ALuint = HTYPE_ALUINT
type ALsizei = HTYPE_ALSIZEI
type ALenum = HTYPE_ALENUM
type ALfloat = HTYPE_ALFLOAT
type ALdouble = HTYPE_ALDOUBLE
type ALCboolean = HTYPE_ALCBOOLEAN
type ALCchar = HTYPE_ALCCHAR
type ALCbyte = HTYPE_ALCBYTE
type ALCubyte = HTYPE_ALCUBYTE
type ALCshort = HTYPE_ALCSHORT
type ALCushort = HTYPE_ALCUSHORT
type ALCint = HTYPE_ALCINT
type ALCuint = HTYPE_ALCUINT
type ALCsizei = HTYPE_ALCSIZEI
type ALCenum = HTYPE_ALCENUM
type ALCfloat = HTYPE_ALCFLOAT
type ALCdouble = HTYPE_ALCDOUBLE
newtype Device = Device ALCdevice
deriving ( Eq, Ord, Show )
newtype ALCdevice = ALCdevice (Ptr ALCdevice)
deriving ( Eq, Ord, Show )
nullDevice :: Device
nullDevice = Device (ALCdevice nullPtr)
marshalDevice :: Device -> ALCdevice
marshalDevice (Device device) = device
unmarshalDevice :: ALCdevice -> Maybe Device
unmarshalDevice device =
if device == marshalDevice nullDevice then Nothing else Just (Device device)
closeDevice :: Device -> IO Bool
#if ALCCLOSEDEVICE_VOID
closeDevice = fmap (const True) . alcCloseDevice . marshalDevice
foreign import CALLCONV unsafe "alcCloseDevice"
alcCloseDevice :: ALCdevice -> IO ()
#else
closeDevice = fmap (/= CONST_ALC_FALSE) . alcCloseDevice . marshalDevice
foreign import CALLCONV unsafe "alcCloseDevice"
alcCloseDevice :: ALCdevice -> IO ALCboolean
#endif
data Context = Context ALCcontext
deriving ( Eq, Ord, Show )
newtype ALCcontext = ALCcontext (Ptr ALCcontext)
deriving ( Eq, Ord, Show )
nullContext :: Context
nullContext = Context (ALCcontext nullPtr)
marshalContext :: Context -> ALCcontext
marshalContext (Context context) = context
unmarshalContext :: ALCcontext -> Maybe Context
unmarshalContext context =
if context == marshalContext nullContext then Nothing else Just (Context context)
#if ALCPROCESSCONTEXT_VOID
foreign import CALLCONV unsafe "alcProcessContext"
alcProcessContext :: ALCcontext -> IO ()
#else
foreign import CALLCONV unsafe "alcProcessContext"
alcProcessContext :: ALCcontext -> IO ALCcontext
#endif
#if ALCMAKECONTEXTCURRENT_VOID
foreign import CALLCONV unsafe "alcMakeContextCurrent"
alcMakeContextCurrent :: ALCcontext -> IO ()
#else
foreign import CALLCONV unsafe "alcMakeContextCurrent"
alcMakeContextCurrent :: ALCcontext -> IO ALCenum
#endif
#if ALCDESTROYCONTEXT_VOID
foreign import CALLCONV unsafe "alcDestroyContext"
alcDestroyContext :: ALCcontext -> IO ()
#else
foreign import CALLCONV unsafe "alcDestroyContext"
alcDestroyContext :: ALCcontext -> IO ALCenum
#endif