{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE PatternSynonyms #-} -- | EGL 1.5 carefully reconstructed. -- EGL is an interface works between native window systems and rendering APIs -- such as OpenGL, OpenGL ES, OpenVG. -- This high-level APIs are specialized for OpenGL ES, so that initialization -- could be simply done in several lines. -- You can still access the rest of C APIs via "Graphics.EGL.Base". -- -- - -- - module Graphics.EGL where import Control.Applicative import Control.Monad import Data.IORef import Foreign hiding (void) import Graphics.EGL.Base import Graphics.OpenGLES.Internal (glLog) --init -- setupEgl -- setSurface -- eglCreateContext -- eglMakeCurrent --eglswap -- trySwap -- BADSUR -> setupEgl, setSurface -- CLOST, BADCXT -> reset --resume -- setSurface -- eglMakeCurrent -- CLOST -> eglCreateContext -- OTHER -> reset -- * EGL Lifecycle -- | Initialize EGL with default display. eglInit :: IO Egl eglInit = eglInitializeOn Nothing [[(egl_RenderableType, egl_OpenGLES2)]] [(egl_ClientVersion, 2)] -- | Initialize EGL with specified display and configurations. eglInitializeOn :: Maybe EGLNativeDisplay -- ^ If any, specify native display pointer. -> [[(EGLConfAttr, Int32)]] -- ^ EGL configurations with many fallbacks. -> [(EGLContextAttr, Int32)] -- ^ Choose GL version here. -> IO Egl eglInitializeOn nd cfgs = newIORef . initial nd cfgs -- | Start using graphics APIs on this thread. initialization is performed here -- whenever necessary. EGL context would be re-created if the last context was -- lost due to power management events such as sleep. eglResume :: Egl -> EGLNativeWindow -- ^ Pointer to the native window handler. -> IO () eglResume egl window = do glLog "eglResume..." cur@EglCurrent{..} <- readIORef egl let share = nullPtr if disp == nullPtr then do -- context not initialized glLog "egl.disp==NULL" (display, config) <- setupEgl ndisp confcand (surf, w, h) <- setSurface display config window cxt <- withAttrList (map (\(EGLContextAttr a,b)->(a,b))cxtconf) $ eglCreateContext display config share logError "eglCreateContext(Init)" withErrorCheck "eglMakeCurrent(Init)" $ eglMakeCurrent display surf surf cxt writeIORef egl cur { disp = display , chosen = config , context = cxt , dsurf = surf , rsurf = surf , nwin = window , screenDims = (w, h) } else do -- resume glLog "egl.disp/=NULL" (surf, w, h) <- setSurface disp chosen window when (screenDims /= (w, h)) $ glLog "screen resized" res <- eglMakeCurrent disp surf surf context when (res == 0) $ do -- EGL_FALSE err <- eglGetError glLog $ "eglMakeCurrent(Resume): " ++ showEglError err if err == 0x300E then do -- EGL_CONTEXT_LOST glLog "Re-creating EGL context..." cxt <- withAttrList (map (\(EGLContextAttr a,b)->(a,b))cxtconf) $ eglCreateContext disp chosen share logError "eglCreateContext(Resume)" writeIORef egl cur { context = cxt , dsurf = surf , rsurf = surf , nwin = window , screenDims = (w, h) } else do eglInvalidate egl -- context reset eglResume egl window {-# NOINLINE eglResume #-} -- | Stop using graphics APIs on this thread. Should be called before a sleep. eglSuspend :: Egl -> IO () eglSuspend egl = do glLog "eglSuspend..." c@EglCurrent{..} <- readIORef egl when (dsurf /= nullPtr) $ do eglDestroySurface disp dsurf writeIORef egl c { dsurf = nullPtr } {-# NOINLINE eglSuspend #-} -- | Invalidate EGL objects and terminates the display on this thread. -- You can still reuse 'Egl' because 'Egl' is state manager. eglInvalidate :: Egl -> IO () eglInvalidate egl = do glLog "eglInvalidate..." EglCurrent{..} <- readIORef egl when (disp /= nullPtr) $ do eglMakeCurrent disp nullPtr nullPtr nullPtr when (context /= nullPtr) $ void (eglDestroyContext disp context) when (dsurf /= nullPtr) $ void (eglDestroySurface disp dsurf) when (rsurf /= nullPtr && rsurf /= dsurf) $ void (eglDestroySurface disp rsurf) void $ eglTerminate disp writeIORef egl $ initial ndisp confcand cxtconf {-# NOINLINE eglInvalidate #-} -- | Create a shared context from given context. --eglShareContext :: Egl -> IO Egl --eglShareContext egl = do -- * Posting the Color Buffer -- | Post EGL surface color buffer to the native window. -- eglPostFrame calls eglSwapBuffers inside. eglPostFrame :: Egl -> IO () eglPostFrame egl = do cur@EglCurrent{..} <- readIORef egl b <- eglSwapBuffers disp dsurf when (b == 0) $ do err <- eglGetError glLog $ "eglPostBuffer: " ++ showEglError err if err == 0x300D then do -- EGL_BAD_SURFACE (display, config) <- setupEgl ndisp confcand -- recreate surface (surf, w, h) <- setSurface display config nwin -- still consider EGL context is valid writeIORef egl cur { disp = display , dsurf = surf , screenDims = (w, h) } else do --if err == EGL_CONTEXT_LOST || err == EGL_BAD_CONTEXT then -- context has been lost!! eglInvalidate egl -- reset context eglResume egl nwin --eglCopyBuffers :: EGLNativePixmap a => EGLDisplay -> EGLSurface -> a -> IO EGLError --eglCopyBuffers display surface pixmap = -- toEglErr (eglCopyBuffers (unD display) (unS surface) (getNativePixmap pixmap)) -- | Specifies the minimum number of video frame periods per buffer swap -- for the window associated with the current context. -- Returns False on failure. The default swap interval is 1. eglPostInterval :: Egl -> Int32 -> IO Bool eglPostInterval egl interval = do display <- disp <$> readIORef egl (/= 0) <$> eglSwapInterval display interval -- * Query Context eglVendor, eglVersion :: Egl -> IO String eglVendor = queryString 0x3053 eglVersion = queryString 0x3054 eglExtensions, eglClientAPIs :: Egl -> IO [String] eglExtensions egl = words <$> queryString 0x3055 egl eglClientAPIs egl = words <$> queryString 0x308D egl eglScreenDims :: Num a => Egl -> IO (a, a) eglScreenDims egl = do (w, h) <- screenDims <$> readIORef egl return (fromIntegral w, fromIntegral h) -- * Attributes egl_True, egl_False, egl_None, egl_DontCare :: EGLint egl_True = 1 egl_False = 0 egl_None = 0x3038 egl_DontCare = -1 -- ** Config Attributes -- 0x3020-0x3042 (Reserved 0x3041-0x304F for additional config attributes) egl_BufferSize, egl_AlphaSize, egl_BlueSize, egl_GreenSize, egl_RedSize, egl_DepthSize, egl_StencilSize, egl_ConfigCaveat, egl_ConfigID, egl_Level, egl_MaxPbufferHeight, egl_MaxPbufferPixels, egl_MaxPbufferWidth, egl_NativeRenderable, egl_NativeVisualID, egl_NativeVisualType, egl_Samples, egl_SampleBuffers, egl_SurfaceType, egl_TransparentType, egl_TransparentBlueValue, egl_TransparentGreenValue, egl_TransparentRedValue, egl_BindToTextureRGB, egl_BindToTextureRGBA, egl_MinSwapInterval, egl_MaxSwapInterval, egl_LuminanceSize, egl_AlphaMaskSize, egl_ColorBufferType, egl_RenderableType, egl_MatchNativePixmap, egl_Conformant :: EGLConfAttr egl_BufferSize = EGLConfAttr 0x3020 egl_AlphaSize = EGLConfAttr 0x3021 egl_BlueSize = EGLConfAttr 0x3022 egl_GreenSize = EGLConfAttr 0x3023 egl_RedSize = EGLConfAttr 0x3024 egl_DepthSize = EGLConfAttr 0x3025 egl_StencilSize = EGLConfAttr 0x3026 -- | One of 'egl_None', 'egl_SlowConfig', 'egl_NonConformantConfig'. egl_ConfigCaveat = EGLConfAttr 0x3027 egl_ConfigID = EGLConfAttr 0x3028 egl_Level = EGLConfAttr 0x3029 egl_MaxPbufferHeight = EGLConfAttr 0x302A egl_MaxPbufferPixels = EGLConfAttr 0x302B egl_MaxPbufferWidth = EGLConfAttr 0x302C egl_NativeRenderable = EGLConfAttr 0x302D egl_NativeVisualID = EGLConfAttr 0x302E egl_NativeVisualType = EGLConfAttr 0x302F egl_Samples = EGLConfAttr 0x3031 egl_SampleBuffers = EGLConfAttr 0x3032 -- | Bitmask, see below. egl_SurfaceType = EGLConfAttr 0x3033 -- | 'egl_None' or 'egl_TransparentRgb'. egl_TransparentType = EGLConfAttr 0x3034 egl_TransparentBlueValue = EGLConfAttr 0x3035 egl_TransparentGreenValue = EGLConfAttr 0x3036 egl_TransparentRedValue = EGLConfAttr 0x3037 egl_BindToTextureRGB = EGLConfAttr 0x3039 egl_BindToTextureRGBA = EGLConfAttr 0x303A egl_MinSwapInterval = EGLConfAttr 0x303B egl_MaxSwapInterval = EGLConfAttr 0x303C egl_LuminanceSize = EGLConfAttr 0x303D egl_AlphaMaskSize = EGLConfAttr 0x303E -- | 'egl_RgbBuffer' or 'egl_LuminanceBuffer'. egl_ColorBufferType = EGLConfAttr 0x303F -- | Bitmask, see below. egl_RenderableType = EGLConfAttr 0x3040 egl_MatchNativePixmap = EGLConfAttr 0x3041 egl_Conformant = EGLConfAttr 0x3042 -- *** egl_ConfigCaveat values (except egl_None) egl_SlowConfig, egl_NonConformantConfig :: EGLint egl_SlowConfig = 0x3050 egl_NonConformantConfig = 0x3051 -- *** egl_SurfaceType mask bits egl_PBuffer, egl_Pixmap, egl_Window, egl_VGColorspaceLinear, egl_VGAlphaFormatPre, egl_MultisampleResolveBox, egl_SwapBehaviorPreserved :: EGLint egl_PBuffer = 0x0001 egl_Pixmap = 0x0002 egl_Window = 0x0004 egl_VGColorspaceLinear = 0x0020 egl_VGAlphaFormatPre = 0x0040 egl_MultisampleResolveBox = 0x0200 egl_SwapBehaviorPreserved = 0x0400 -- *** egl_TransparentType values (except egl_None) egl_TransparentRgb :: EGLint egl_TransparentRgb = 0x3052 -- *** egl_ColorBufferType values egl_RgbBuffer, egl_LuminanceBuffer :: EGLint egl_RgbBuffer = 0x308E egl_LuminanceBuffer = 0x308F -- *** egl_RenderableType bitmask egl_OpenGLES, egl_OpenVG, egl_OpenGLES2, egl_OpenGL, egl_OpenGLES3 :: EGLint egl_OpenGLES = 1 egl_OpenVG = 2 egl_OpenGLES2 = 4 egl_OpenGL = 8 -- | /EGL_KHR_create_context or EGL 1.5 required/ egl_OpenGLES3 = 0x40 -- * Surface eglGetSurfaceAttr :: Egl -> EGLSurfAttr -> IO Int32 eglGetSurfaceAttr egl (EGLSurfAttr attr) = do EglCurrent{..} <- readIORef egl with (-1) $ \ptr -> do eglQuerySurface disp dsurf attr ptr peek ptr eglSetSurfaceAttr :: Egl -> EGLSurfAttr -> Int32 -> IO Bool eglSetSurfaceAttr egl (EGLSurfAttr attr) value = do EglCurrent{..} <- readIORef egl (/= 0) <$> eglSurfaceAttrib disp dsurf attr value -- ** Surface Attributes egl_Height, egl_Width, egl_LargestPbuffer, egl_TextureFormat, egl_TextureTarget, egl_MipmapTexture, egl_MipmapLevel, egl_RenderBuffer, egl_VGColorspace, egl_VGAlphaFormat, egl_HorizontalResolution, egl_VerticalResolution, egl_PixelAspectRaito, egl_SwapBehavior, egl_MultisampleResolve, egl_ConfigId :: EGLSurfAttr -- | int Height of surface. egl_Height = EGLSurfAttr 0x3056 -- | int Width of surface. egl_Width = EGLSurfAttr 0x3067 -- | boolean If true, create largest pbuffer possible. egl_LargestPbuffer = EGLSurfAttr 0x3058 -- | enum Format of texture: RGB, RGBA, or no texture. egl_TextureFormat = EGLSurfAttr 0x3080 -- | enum Type of texture: 2D or no texture. egl_TextureTarget = EGLSurfAttr 0x3081 -- | boolean True if texture has mipmaps. egl_MipmapTexture = EGLSurfAttr 0x3082 -- | int Mipmap level to render to. egl_MipmapLevel = EGLSurfAttr 0x3083 -- | enum Render buffer, see below. egl_RenderBuffer = EGLSurfAttr 0x3086 -- | enum Color space for OpenVG, see below. egl_VGColorspace = EGLSurfAttr 0x3087 -- | enum Alpha format for OpenVG, see below. egl_VGAlphaFormat = EGLSurfAttr 0x3088 -- | int Horizontal dot pitch. egl_HorizontalResolution = EGLSurfAttr 0x3090 -- | int Vertical dot pitch. egl_VerticalResolution = EGLSurfAttr 0x3091 -- | int Display aspect ratio. egl_PixelAspectRaito = EGLSurfAttr 0x3092 -- | enum Buffer swap behavior, see below. egl_SwapBehavior = EGLSurfAttr 0x3093 -- | enum Multisample resolve behavior, see below. egl_MultisampleResolve = EGLSurfAttr 0x3099 -- | int ID of EGLConfig surface was created with egl_Height integer Height of surface. egl_ConfigId = EGLSurfAttr 0x3028 -- | /EGL_KHR_gl_colorspace or EGL 1.5+/ enum Color space for OpenGL, see below. egl_GLColorspace = EGLSurfAttr 0x3087 -- *** egl_Texture{Format,Target} values egl_NoTexture, egl_TextureRgb, egl_TextureRgba, egl_Texture2D :: EGLint egl_NoTexture = 0x305C egl_TextureRgb = 0x305D egl_TextureRgba = 0x305E egl_Texture2D = 0x305F -- *** egl_RenderBuffer values egl_BackBuffer, egl_SingleBuffer :: EGLint egl_BackBuffer = 0x3084 egl_SingleBuffer = 0x3085 -- *** egl_{VG,GL}Colorspace values egl_ColorspaceSrgb, egl_ColorspaceLinear :: EGLint egl_ColorspaceSrgb = 0x3089 egl_ColorspaceLinear = 0x308A -- *** egl_VGAlphaFormat values egl_Nonpre, egl_Pre :: EGLint egl_Nonpre = 0x308B egl_Pre = 0x308C -- *** Resolution and Aspect Raito values egl_DisplayScaling, egl_Unknown :: EGLint -- | Constant scale factor by which fractional display resolutions & -- aspect ratio are scaled when queried as integer values. egl_DisplayScaling = 10000 -- | Unknown display resolution or aspect ratio. egl_Unknown = -1 -- *** egl_SwapBehavior values egl_BufferPreserved, egl_BufferDestroyed :: EGLint egl_BufferPreserved = 0x3094 egl_BufferDestroyed = 0x3095 -- *** egl_MultisampleResolve values egl_ResolveDefault, egl_ResolveBox :: EGLint egl_ResolveDefault = 0x309A egl_ResolveBox = 0x309B -- * Context eglConfigID, eglContextClientType, eglContextClientVersion, eglRenderBuffer :: Egl -> IO Int32 eglConfigID = queryContext 0x3028 eglContextClientType = queryContext 0x3097 eglContextClientVersion = queryContext 0x3098 eglRenderBuffer = queryContext 0x3086 -- ** Context Attributes -- | Specify context client major version, 2 or later. egl_ClientVersion :: EGLContextAttr egl_ClientVersion = EGLContextAttr 0x3098 -- | /EGL_EXT_create_context_robustness required/ -- Same as unpostfixed version. egl_GLRobustAccessExt, egl_GLResetNotificationStrategyExt :: EGLContextAttr egl_GLRobustAccessExt = EGLContextAttr 0x30BF egl_GLResetNotificationStrategyExt = EGLContextAttr 0x3138 egl_MinorVersion, egl_GLProfileMask, egl_GLResetNotificationStrategy :: EGLContextAttr -- | /EGL_KHR_create_context or EGL 1.5 required/ -- Specify context client minor version. egl_MinorVersion = EGLContextAttr 0x30FB -- | /EGL_KHR_create_context or EGL 1.5 required/ -- See below. egl_GLProfileMask = EGLContextAttr 0x30FD -- | /EGL_KHR_create_context or EGL 1.5 required/ -- See below. egl_GLResetNotificationStrategy = EGLContextAttr 0x30BD -- | /EGL_KHR_create_context required/ See below. egl_ContextFlags :: EGLContextAttr egl_ContextFlags = EGLContextAttr 0x30FC -- | /EGL 1.5 required/ Specify 'egl_True' or 'egl_False' egl_GLDebug, egl_GLForwardCompat, egl_GLRobustAccess :: EGLContextAttr egl_GLDebug = EGLContextAttr 0x31B0 egl_GLForwardCompat = EGLContextAttr 0x31B1 egl_GLRobustAccess = EGLContextAttr 0x31B2 -- *** egl_OpenGLProfileMask mask bits egl_GLCoreProfileBit, egl_GLCompatProfileBit :: EGLint egl_GLCoreProfileBit = 1 egl_GLCompatProfileBit = 2 -- *** egl_OpenGLResetNotificationStrategy values egl_NoResetNotification, egl_LoseContextOnReset :: EGLint egl_NoResetNotification = 0x31BE egl_LoseContextOnReset = 0x31BF -- *** egl_ContextFlags bits egl_GLDebugBit, egl_GLForwardCompatBit, egl_GLRobustAccessBit :: EGLint egl_GLDebugBit = 1 egl_GLForwardCompatBit = 2 egl_GLRobustAccessBit = 4 -- * Synchronization Primitives eglWaitCaller :: IO Bool eglWaitCaller = withErrorCheck "eglWaitClient" eglWaitClient eglWaitGPU :: IO Bool eglWaitGPU = withErrorCheck "eglWaitNative" $ eglWaitNative 0x305B -- EGL_CORE_NATIVE_ENGINE -- * Copying Surface to Texture -- | Specify 'egl_RenderBuffer' value. (Perhaps 'egl_BackBuffer' only?) type EGLBuffer = EGLint eglBindAsTexture :: Egl -> EGLBuffer -> IO Bool eglBindAsTexture egl buf = do EglCurrent{..} <- readIORef egl withErrorCheck "eglBindTexImage" $ eglBindTexImage disp dsurf buf eglReleaseTexture :: Egl -> EGLBuffer -> IO Bool eglReleaseTexture egl buf = do EglCurrent{..} <- readIORef egl withErrorCheck "eglReleaseTexImage" $ eglReleaseTexImage disp dsurf buf -- * Switching between APIs newtype GraphicsAPI = GraphicsAPI EGLenum instance Show GraphicsAPI where show OpenGLES = "OpenGLES" show OpenVG = "OpenVG" show OpenGL = "OpenGL" show _ = "None" pattern OpenGLES = GraphicsAPI 0x30A0 pattern OpenVG = GraphicsAPI 0x30A1 pattern OpenGL = GraphicsAPI 0x30A2 eglBindCurrentAPI :: GraphicsAPI -> IO Bool eglBindCurrentAPI (GraphicsAPI e) = withErrorCheck "eglBindAPI" $ eglBindAPI e eglCurrentAPI :: IO GraphicsAPI eglCurrentAPI = GraphicsAPI <$> eglQueryAPI