-------------------------------------------------------------------------------- -- | -- Module : Sound.OpenAL.ALC.Context -- Copyright : (c) Sven Panne 2003-2009 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable -- -- This module corresponds to section 6.2 (Managing Rendering Contexts) of the -- OpenAL Specification and Reference (version 1.1). -- -- All operations of the AL core API affect a current AL context. Within the -- scope of AL, the ALC is implied - it is not visible as a handle or function -- parameter. Only one AL Context per process can be current at a time. -- Applications maintaining multiple AL Contexts, whether threaded or not, -- have to set the current context accordingly. Applications can have multiple -- threads that share one more or contexts. In other words, AL and ALC are -- threadsafe. -- -------------------------------------------------------------------------------- module Sound.OpenAL.ALC.Context ( Frequency, ContextAttribute(..), Context, createContext, currentContext, processContext, suspendContext, destroyContext, contextsDevice, allAttributes ) where import Data.StateVar import Foreign.Marshal.Array ( withArray0 ) import Foreign.Ptr ( Ptr ) import Sound.OpenAL.ALC.BasicTypes ( ALCint ) import Sound.OpenAL.ALC.ALCboolean ( marshalALCboolean, unmarshalALCboolean ) import Sound.OpenAL.ALC.Device ( Device ) import Sound.OpenAL.ALC.QueryUtils ( IntQuery(..), getInteger, getIntegerv ) import Sound.OpenAL.Config ( ALCdevice, marshalDevice, unmarshalDevice, ALCcontext, Context, nullContext, marshalContext, unmarshalContext, alcProcessContext, alcDestroyContext, alcMakeContextCurrent ) import Sound.OpenAL.Constants ( alc_FREQUENCY, alc_REFRESH, alc_SYNC, alc_MONO_SOURCES, alc_STEREO_SOURCES ) #ifdef __HADDOCK__ import Sound.OpenAL.ALC.Errors ( ALCErrorCategory(..) ) #endif -------------------------------------------------------------------------------- -- | Frequency, specified in samples per second, i.e. units of Hertz \[Hz\]. -- Note that the underlying OpenAL API currently uses integral frequencies -- only, but we want to mirror physical reality here more closely. type Frequency = Float -------------------------------------------------------------------------------- -- | The application can choose to specify certain attributes for a context at -- context-creation time. Attributes not specified explicitly are set to -- implementation dependent defaults. data ContextAttribute = Frequency Frequency -- ^ Frequency for mixing output buffer, in units of -- Hz | Refresh Frequency -- ^ Refresh intervals, in units of Hz | Sync Bool -- ^ Flag, indicating a synchronous context | MonoSources Int -- ^ A hint indicating how many sources should be -- capable of supporting mono data | StereoSources Int -- ^ A hint indicating how many sources should be -- capable of supporting stereo data deriving ( Eq, Ord, Show ) marshalContextAttribute :: ContextAttribute -> (ALCint,ALCint) marshalContextAttribute a = case a of Frequency f -> (alc_FREQUENCY, round f) Refresh r -> (alc_REFRESH, round r) Sync s -> (alc_SYNC, fromIntegral (marshalALCboolean s)) MonoSources m -> (alc_MONO_SOURCES, fromIntegral m) StereoSources s -> (alc_STEREO_SOURCES, fromIntegral s) unmarshalContextAttribute :: (ALCint,ALCint) -> ContextAttribute unmarshalContextAttribute a@(x,y) | x == alc_FREQUENCY = Frequency (fromIntegral y) | x == alc_REFRESH = Refresh (fromIntegral y) | x == alc_SYNC = Sync (unmarshalALCboolean (fromIntegral y)) | x == alc_MONO_SOURCES = MonoSources (fromIntegral y) | x == alc_STEREO_SOURCES = StereoSources (fromIntegral y) | otherwise = error ("unmarshalContextAttribute: illegal value " ++ show a) -------------------------------------------------------------------------------- -- | Create a context for a given device and given attributes. Context creation -- will fail in the following cases: a) if the application requests attributes -- that, by themselves, can not be provided b) if the combination of specified -- attributes can not be provided c) if a specified attribute, or the -- combination of attributes, does not match the default values for unspecified -- attributes If context creation fails, 'Nothing' will be returned, otherwise -- 'Just' the new context. Note that 'createContext' does /not/ set the current -- context, this must be done separately via 'currentContext'. createContext :: Device -> [ContextAttribute] -> IO (Maybe Context) createContext device attributes = do let pairToList (key, value) = [key, value] attrs = concatMap (pairToList . marshalContextAttribute) attributes fmap unmarshalContext . withArray0 0 attrs . alcCreateContext . marshalDevice $ device foreign import CALLCONV unsafe "alcCreateContext" alcCreateContext :: ALCdevice -> Ptr ALCint -> IO ALCcontext -------------------------------------------------------------------------------- -- | Contains 'Just' the current context with respect to OpenAL operation, or -- 'Nothing' if there is no current context. Setting it to the latter is useful -- when shutting OpenAL down. The state variable applies to the device that the -- context was created for. For each OS process (usually this means for each -- application), only one context can be current at any given time. All AL -- commands apply to the current context. Commands that affect objects shared -- among contexts (e.g. buffers) have side effects on other contexts. currentContext :: StateVar (Maybe Context) currentContext = makeStateVar getCurrentContext makeContextCurrent getCurrentContext :: IO (Maybe Context) getCurrentContext = fmap unmarshalContext $ alcGetCurrentContext foreign import CALLCONV unsafe "alcGetCurrentContext" alcGetCurrentContext :: IO ALCcontext makeContextCurrent :: Maybe Context -> IO () makeContextCurrent = fmap (const ()) . alcMakeContextCurrent . marshalContext . maybe nullContext id -------------------------------------------------------------------------------- -- | The current context is the only context accessible to state changes by AL -- commands (aside from state changes affecting shared objects). However, -- multiple contexts can be processed at the same time. To indicate that a -- context should be processed (i.e. that internal execution state like offset -- increments are supposed to be performed), the application has to use -- 'processContext'. Repeated calls to 'processContext' are legal, and do not -- affect a context that is already marked as processing. The default state of a -- context created by 'createContext' is that it is processing. processContext :: Context -> IO () processContext = fmap (const ()) . alcProcessContext . marshalContext -- | The application can suspend any context from processing (including the -- current one). To indicate that a context should be suspended from processing -- (i.e. that internal execution state like offset increments is not supposed to -- be changed), the application has to use 'suspendContext'. Repeated calls to -- 'suspendContext' are legal, and do not affect a context that is already -- marked as suspended. suspendContext :: Context -> IO () suspendContext = alcSuspendContext . marshalContext foreign import CALLCONV unsafe "alcSuspendContext" alcSuspendContext :: ALCcontext -> IO () -------------------------------------------------------------------------------- -- | Destroy the given context. Note that the the correct way to destroy a -- context is to first release it by setting 'currentContext' to -- 'Nothing'. Applications should not attempt to destroy a current context, -- doing so will not work and will result in an 'ALCInvalidOperation' error. destroyContext :: Context -> IO () destroyContext = fmap (const ()) . alcDestroyContext . marshalContext -------------------------------------------------------------------------------- -- | Contains 'Just' the device of the given context or 'Nothing' if the context -- is invalid. contextsDevice :: Context -> GettableStateVar (Maybe Device) contextsDevice = makeGettableStateVar . fmap unmarshalDevice . alcGetContextsDevice . marshalContext foreign import CALLCONV unsafe "alcGetContextsDevice" alcGetContextsDevice :: ALCcontext -> IO ALCdevice -------------------------------------------------------------------------------- -- | Contains the attribute list for the current context of the specified -- device. allAttributes :: Device -> GettableStateVar [ContextAttribute] allAttributes device = makeGettableStateVar $ do numALCints <- fmap fromIntegral $ getInteger (Just device) AttributesSize fmap toContextAttributes $ getIntegerv (Just device) AllAttributes numALCints toContextAttributes :: [ALCint] -> [ContextAttribute] toContextAttributes xs = case xs of [] -> [] -- should only happen when device and/or current context is invalid (0:_) -> [] (x:y:rest) -> unmarshalContextAttribute (x,y) : toContextAttributes rest _ -> error ("toContextAttributes: illegal value " ++ show xs)