Initialize EGL context

app/Main.hs

@@ -14,6 +14,8 @@ import Quasar.Wayland.Protocol.Generated
 
 import Codec.Picture
 
+import Glest.Renderer
+
 
 data Dimensions = Dimensions {
   width :: Int,
@@ -80,10 +82,11 @@ wallpaperImage fn = generateImage pixel width height
 --generateWallpaper = writePng "/tmp/wallpaper.png" wallpaperImage
 
 
-
-
 main :: IO ()
-main = do
+main = testRenderer
+
+softwareRenderingTest :: IO ()
+softwareRenderingTest = do
   withRootResourceManager do
     traceIO "Connecting"
     client <- connectWaylandClient

default.nix

 { pkgs ? import <nixpkgs> {}, haskellPackages ? pkgs.haskellPackages, args ? {} }:
 
 let
-  #quasar-wayland = haskellPackages.callCabal2nix "quasar-wayland" ./. args;
-  quasar-wayland = pkgs.haskell.packages.ghc922.callCabal2nix "quasar-wayland" ./. args;
+  pkg = pkgs.haskell.lib.overrideCabal (haskellPackages.callCabal2nix "glest" ./. ({EGL = null; GLESv2 = null;} // args)) {
+    librarySystemDepends = [ pkgs.libGL ];
+  };
 
 in
-  if pkgs.lib.inNixShell then quasar-wayland.env else quasar-wayland
+  if pkgs.lib.inNixShell then pkg.env else pkg

flake.lock

@@ -14,19 +14,6 @@
         "type": "indirect"
       }
     },
-    "opengles": {
-      "flake": false,
-      "locked": {
-        "lastModified": 1457685835,
-        "narHash": "sha256-IXeh96antj9XOpesibFEIii9mFpJ4VslLj88I/n3tDQ=",
-        "type": "git",
-        "url": "file:///home/jens/dev/fork/opengles"
-      },
-      "original": {
-        "type": "git",
-        "url": "file:///home/jens/dev/fork/opengles"
-      }
-    },
     "quasar": {
       "inputs": {
         "nixpkgs": [
@@ -84,7 +71,7 @@
       },
       "locked": {
         "lastModified": 1640287790,
-        "narHash": "sha256-YI8ZYTxPhzQ/DxVGl7bqTt3ivm67RUryiEUJx8GGkqY=",
+        "narHash": "sha256-p4V9bEjjUK/3AYiRja5Lc3QmPn+KhCHIrJ5NJtpdjAI=",
         "type": "git",
         "url": "file:///home/jens/dev/jens/quasar-wayland"
       },
@@ -98,7 +85,6 @@
     "root": {
       "inputs": {
         "nixpkgs": "nixpkgs",
-        "opengles": "opengles",
         "quasar-wayland": "quasar-wayland"
       }
     }

flake.nix

@@ -4,14 +4,9 @@
       url = gitlab:jens/quasar-wayland?host=git.c3pb.de;
       inputs.nixpkgs.follows = "nixpkgs";
     };
-
-    opengles = {
-      url = github:capsjac/opengles;
-      flake = false;
-    };
   };
 
-  outputs = { self, nixpkgs, quasar-wayland, opengles }:
+  outputs = { self, nixpkgs, quasar-wayland }:
   let
     lib = nixpkgs.lib;
     systems = lib.platforms.unix;
@@ -24,7 +19,7 @@
         quasar-wayland.overlays.quasar
       ]; };
     in {
-      inherit (pkgs.haskellPackages) glest;
+      inherit (pkgs.haskell.packages.ghc922) glest opengles;
     }
     );
 
@@ -32,12 +27,6 @@
       haskell = super.haskell // {
         packageOverrides = hself: hsuper: super.haskell.packageOverrides hself hsuper // {
           glest = import ./. { pkgs = self; haskellPackages = hself; };
-          opengles = self.haskell.lib.overrideCabal hsuper.opengles {
-            src = opengles;
-            editedCabalFile = null;
-            broken = false;
-            jailbreak = true;
-          };
         };
       };
     };

ghcid

-#!/usr/bin/env -S nix develop . -c zsh
+#!/usr/bin/env -S nix develop -L . -c zsh
 
 print -P %F{yellow}Cleaning repository%f
-nix develop -c cabal clean
+nix develop -L -c cabal clean
 
 (git ls-files test example; git ls-files '*.cabal'; git ls-files 'flake.*') | \
   entr -r \
-    nix develop -c \
+    nix develop -L -c \
       ghcid \
         --warnings \
-        "--command=cabal repl lib:quasar-wayland" \
+        "--command=cabal repl lib:glest" \
         "--test=:! \
           cabal test --disable-optimisation --enable-debug-info=2 --test-show-details=direct --ghc-option -fdiagnostics-color=always && \
-          cabal run --disable-optimisation --enable-debug-info=2 --ghc-option -fdiagnostics-color=always quasar-wayland-example && \
+          cabal run --disable-optimisation --enable-debug-info=2 --ghc-option -fdiagnostics-color=always glest && \
           zsh -c 'print -P %F{green}Build and tests passed%f' \
         "

glest.cabal

@@ -57,27 +57,32 @@ common shared-executable-properties
 library
   import: shared-properties
   exposed-modules:
+    Glest.Egl
+    Glest.Egl.Types
+    Glest.Renderer
+    Glest.Utils.InlineC
   other-modules:
   build-depends:
     base >=4.7 && <5,
+    JuicyPixels,
     binary,
     bytestring,
     containers,
     exceptions,
     filepath,
     inline-c,
-    JuicyPixels,
     mtl,
     network,
-    opengles,
     quasar,
     quasar-wayland,
+    stm,
     template-haskell,
     unix,
     unordered-containers,
     utf8-string,
-    stm,
+    vector,
     xml,
+  extra-libraries: EGL, GLESv2
   hs-source-dirs:
     src
 

src/Glest/Egl.hs

+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-prepositive-qualified-module #-}
+
+module Glest.Egl (
+  initializeEgl
+) where
+
+import Control.Exception
+import Data.Foldable (elem)
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Data.Vector.Storable.Mutable qualified as V
+import Foreign
+import Foreign.C.Error
+import Foreign.C.String
+import Glest.Egl.Types
+import Glest.Utils.InlineC
+import Language.C.Inline qualified as C
+import Language.C.Inline.Unsafe qualified as CU
+import Quasar.Prelude
+import System.Posix.Types (Fd(Fd))
+import System.Posix.ByteString.FilePath (RawFilePath, withFilePath)
+
+C.context ctx
+
+C.include "<assert.h>"
+C.include "<fcntl.h>"
+C.include "<stdint.h>"
+C.include "<unistd.h>"
+C.include "<EGL/egl.h>"
+C.include "<EGL/eglext.h>"
+
+C.verbatim "PFNEGLQUERYDEVICESEXTPROC eglQueryDevicesEXT;"
+C.verbatim "PFNEGLQUERYDEVICESTRINGEXTPROC eglQueryDeviceStringEXT;"
+
+data EglException = EglException EGLint
+  deriving (Eq, Exception)
+
+instance Show EglException where
+  show (EglException 0x3000) = "EGL_SUCCESS"
+  show (EglException 0x3001) = "EGL_NOT_INITIALIZED"
+  show (EglException 0x3002) = "EGL_BAD_ACCESS"
+  show (EglException 0x3003) = "EGL_BAD_ALLOC"
+  show (EglException 0x3004) = "EGL_BAD_ATTRIBUTE"
+  show (EglException 0x3005) = "EGL_BAD_CONTEXT"
+  show (EglException 0x3006) = "EGL_BAD_CONFIG"
+  show (EglException 0x3007) = "EGL_BAD_CURRENT_SURFACE"
+  show (EglException 0x3008) = "EGL_BAD_DISPLAY"
+  show (EglException 0x3009) = "EGL_BAD_SURFACE"
+  show (EglException 0x300a) = "EGL_BAD_MATCH"
+  show (EglException 0x300b) = "EGL_BAD_PARAMETER"
+  show (EglException 0x300c) = "EGL_BAD_NATIVE_PIXMAP"
+  show (EglException 0x300d) = "EGL_BAD_NATIVE_WINDOW"
+  show (EglException 0x300e) = "EGL_CONTEXT_LOST"
+  show _ = "Invalid EGL error number"
+
+loadEglExtensionFunctions :: IO ()
+loadEglExtensionFunctions =
+  [CU.block|
+    void {
+      eglQueryDevicesEXT = (PFNEGLQUERYDEVICESEXTPROC)eglGetProcAddress("eglQueryDevicesEXT");
+      eglQueryDeviceStringEXT = (PFNEGLQUERYDEVICESTRINGEXTPROC)eglGetProcAddress("eglQueryDeviceStringEXT");
+      // if (eglQueryDevicesEXT == NULL) {
+      //   return NULL;
+      // }
+    }
+  |]
+
+eglGetError :: IO EglException
+eglGetError = EglException <$> [CU.exp| EGLint { eglGetError() } |]
+
+initializeEgl :: IO ()
+initializeEgl = do
+  loadEglExtensionFunctions
+
+  deviceCount <- throwErrnoIfMinus1 "eglQueryDevicesEXT"
+    [CU.block|
+      EGLint {
+        EGLint count;
+        EGLBoolean result = eglQueryDevicesEXT(0, NULL, &count);
+        if (!result) {
+          return -1;
+        }
+        return count;
+      }
+    |]
+  traceIO $ "Available EGL devices: " <> show deviceCount
+
+  devices :: V.IOVector EGLDeviceEXT <- V.new (fromIntegral deviceCount)
+  V.unsafeWith devices \devicesPtr ->
+    throwErrnoIf_ (== 0) "eglQueryDevicesEXT"
+      [CU.block|
+        EGLBoolean {
+          EGLint count;
+          EGLBoolean result = eglQueryDevicesEXT($(EGLint deviceCount), $(EGLDeviceEXT* devicesPtr), &count);
+          if (count < $(EGLint deviceCount)) {
+            return EGL_FALSE;
+          }
+          return result;
+        }
+      |]
+
+  V.iforM_ devices \i device -> do
+    vendor <- eglQueryDeviceString device [CU.pure|EGLint { EGL_EXTENSIONS }|]
+    traceIO $ mconcat ["Device ", show i, ": ", vendor]
+    renderNode <- eglTryQueryDeviceString device [CU.pure|EGLint { EGL_DRM_RENDER_NODE_FILE_EXT }|]
+    traceIO $ mconcat ["Device ", show i, ": ", show renderNode]
+
+  traceIO "Using device 0"
+  device <- V.read devices 0
+
+  display <- throwErrnoIfNull "eglGetPlatformDisplay"
+    [CU.exp|EGLDisplay { eglGetPlatformDisplay(EGL_PLATFORM_DEVICE_EXT, $(EGLDeviceEXT device), NULL) }|]
+
+  (major :: EGLint, minor :: EGLint) <- C.withPtrs_ \(majorPtr, minorPtr) ->
+    throwErrnoIf_ (== 0) "eglInitialize"
+      [CU.exp|EGLBoolean { eglInitialize($(EGLDisplay display), $(EGLint* majorPtr), $(EGLint* minorPtr)) }|]
+
+  traceIO $ mconcat ["EGL ", show major, ".", show minor, " initialized"]
+
+  when (major == 1 && minor < 4) $ fail "Insufficient EGL version: EGL 1.4 is required"
+
+  traceIO . ("EGL version: " <>) =<< eglQueryString display [CU.pure|EGLint { EGL_VERSION }|]
+  traceIO . ("EGL vendor: " <>) =<< eglQueryString display [CU.pure|EGLint { EGL_VENDOR }|]
+  traceIO . ("EGL client apis: " <>) =<< eglQueryString display [CU.pure|EGLint { EGL_CLIENT_APIS }|]
+
+  eglExtensionString <- eglQueryString display [CU.pure|EGLint { EGL_EXTENSIONS }|]
+  traceIO $ mconcat ["EGL extensions: ", eglExtensionString]
+
+  let
+    eglExtensions = Set.fromList (words eglExtensionString)
+    requiredEglExtensions = Set.fromList [
+      "EGL_KHR_no_config_context",
+      "EGL_MESA_image_dma_buf_export",
+      "EGL_EXT_image_dma_buf_import",
+      "EGL_EXT_image_dma_buf_import_modifiers"
+      ]
+    missingEglExtensions = Set.difference requiredEglExtensions eglExtensions
+
+  unless (Set.null missingEglExtensions) $
+    fail $ "Missing EGL extensions: " <> intercalate " " missingEglExtensions
+
+  throwErrnoIf_ (== 0) "eglBindAPI"
+    [CU.exp| EGLBoolean { eglBindAPI(EGL_OPENGL_ES_API) } |]
+
+  -- Requires EGL_KHR_no_config_context
+  context <- throwErrnoIfNull "eglCreateContext"
+    [CU.block|
+      EGLContext {
+        static const EGLint attributes[] = {
+          EGL_CONTEXT_MAJOR_VERSION, 2,
+          // terminate list
+          EGL_NONE
+        };
+        return eglCreateContext($(EGLDisplay display), NULL, EGL_NO_CONTEXT, attributes);
+      }
+    |]
+
+  throwErrnoIf_ (== 0) "eglMakeCurrent"
+    [CU.exp|EGLBoolean { eglMakeCurrent($(EGLDisplay display), EGL_NO_SURFACE, EGL_NO_SURFACE, $(EGLContext context)) }|]
+
+
+eglQueryString :: EGLDisplay -> EGLint -> IO String
+eglQueryString display name =
+  peekCString =<< throwErrnoIfNull "eglQueryString"
+    [CU.exp|char const * { eglQueryString($(EGLDisplay display), $(EGLint name)) }|]
+
+eglQueryDeviceString :: EGLDeviceEXT -> EGLint -> IO String
+eglQueryDeviceString device name =
+  peekCString =<< throwErrnoIfNull "eglQueryDeviceStringEXT"
+    [CU.exp|char const * { eglQueryDeviceStringEXT($(EGLDeviceEXT device), $(EGLint name)) }|]
+
+eglTryQueryDeviceString :: EGLDeviceEXT -> EGLint -> IO (Maybe String)
+eglTryQueryDeviceString device name = do
+  cstr <- [CU.exp|char const * { eglQueryDeviceStringEXT($(EGLDeviceEXT device), $(EGLint name)) }|]
+  if cstr /= nullPtr
+    then Just <$> peekCString cstr
+    else pure Nothing
+
+splitExtensions :: String -> Set String
+splitExtensions = Set.fromList . words
+
+requireExtension :: Set String -> String -> IO ()
+requireExtension exts required = unless (elem required exts) $ fail ("Missing extension " <> required)

src/Glest/Egl/Types.hs

+module Glest.Egl.Types (
+  EGLint,
+  EGLBoolean,
+  EGLDisplay,
+  EGLConfig,
+  EGLContext,
+  EGLDeviceEXT,
+) where
+
+import Foreign
+import Quasar.Prelude
+
+type EGLint = Int32
+type EGLBoolean = Word32
+type EGLDisplay = Ptr ()
+type EGLConfig = Ptr ()
+type EGLContext = Ptr ()
+type EGLDeviceEXT = Ptr ()

src/Glest/Renderer.hs

+module Glest.Renderer (
+  testRenderer
+) where
+
+import Glest.Egl
+import Quasar.Prelude
+
+testRenderer :: IO ()
+testRenderer = initializeEgl

src/Glest/Utils/InlineC.hs

+{-# LANGUAGE TemplateHaskell #-}
+
+module Glest.Utils.InlineC (
+  ctx
+) where
+
+import Data.Map.Strict as Map
+import Glest.Egl.Types
+import Language.C.Inline.Context
+import Language.C.Types
+import Language.Haskell.TH
+import Quasar.Prelude
+import System.Posix.Types (COff(..))
+
+ctx :: Context
+ctx = baseCtx <> extraTypesCtx
+
+emptyCtx :: Context
+emptyCtx = Context {
+  ctxTypesTable = mempty,
+  ctxAntiQuoters = mempty,
+  ctxOutput = mempty,
+  ctxForeignSrcLang = Nothing,
+  ctxEnableCpp = False
+}
+
+extraTypesCtx :: Context
+extraTypesCtx =
+  emptyCtx {
+    ctxTypesTable = Map.fromList types
+  }
+
+types :: [(TypeSpecifier, TypeQ)]
+types = [
+  (TypeName "off_t", [t|COff|]),
+
+  (TypeName "EGLint", [t|EGLint|]),
+  (TypeName "EGLBoolean", [t|EGLBoolean|]),
+  (TypeName "EGLConfig", [t|EGLConfig|]),
+  (TypeName "EGLContext", [t|EGLContext|]),
+  (TypeName "EGLDisplay", [t|EGLDisplay|]),
+  (TypeName "EGLDeviceEXT", [t|EGLDeviceEXT|])
+  ]