diff options
| -rw-r--r-- | Main.hs | 85 | ||||
| -rw-r--r-- | RGFW.hs | 10 | ||||
| -rw-r--r-- | shell.nix | 10 | ||||
| -rw-r--r-- | shim.c | 3 | ||||
| -rw-r--r-- | vktest.cabal | 26 |
5 files changed, 96 insertions, 38 deletions
@@ -1,26 +1,69 @@ +{-# LANGUAGE DuplicateRecordFields #-} + module Main (main) where -import qualified Vulkan.Core10 as Vk -import Vulkan.Zero (zero) -import Control.Exception (bracket) -import Data.Foldable (traverse_) +import Control.Exception (bracket) +import Data.Bits ((.|.)) +import Data.ByteString (ByteString, packCString) +import Data.Coerce (coerce) +import Data.Int (Int32) +import Data.Vector as V +import Data.Vector() +import Foreign.C +import Foreign.C.ConstPtr (ConstPtr(..)) +import Foreign.Marshal.Alloc (alloca) +import Foreign.Marshal.Array (advancePtr) +import Foreign.Ptr (Ptr) +import Foreign.Storable (peek) +import qualified RGFW as RGFW +import qualified Vulkan.Core10 as Vk +import Vulkan.Zero (zero) + +height :: Int32 +height = 400 +width :: Int32 +width = 800 main :: IO () -main = Vk.withInstance zero Nothing bracket $ \i -> do - putStrLn $ show i - (_, layers) <- Vk.enumerateInstanceLayerProperties - (_, extensions) <- Vk.enumerateInstanceExtensionProperties Nothing - putStrLn $ show layers - putStrLn $ show extensions - (_, devices) <- Vk.enumeratePhysicalDevices i - traverse_ deviceInfo devices +main = withRGFW "rgfw instance title" 0 $ \_ -> do + exts <- alloca $ \extension_count -> do + exts <- RGFW.rGFW_getRequiredInstanceExtensions_Vulkan extension_count + cexts <- peek extension_count + putStr $ show cexts + putStrLn " extensions required:" + vexts <- processExtensions cexts exts V.empty + putStrLn $ show vexts + return vexts + Vk.withInstance (zero {Vk.enabledExtensionNames = exts}) Nothing bracket $ \i -> do + putStrLn $ show i + withWindow "test window" 0 0 width height ((fromIntegral (RGFW.unwrapRGFW_windowFlags_enum RGFW.RGFW_windowCenter)) .|. (fromIntegral (RGFW.unwrapRGFW_windowFlags_enum RGFW.RGFW_windowNoResize))) $ \window -> do + res <- RGFW.rGFW_window_createSurface_Vulkan window i nullPtr + ret <- gameloop window 0 + putStr "gameloop returned with code: " + putStrLn $ show ret + + +processExtensions :: CSize -> Ptr (ConstPtr CChar) -> Vector ByteString -> IO (Vector ByteString) +processExtensions 0 _ extNames = return extNames +processExtensions count strs extNames = do + str <- peek strs + extName <- packCString (coerce str) + processExtensions (count - 1) (advancePtr strs 1) $ V.snoc extNames extName + +gameloop :: Ptr RGFW.RGFW_window -> RGFW.RGFW_bool -> IO () +gameloop window 0 = gameloop window =<< RGFW.rGFW_window_shouldClose window +gameloop _ _ = return () + +withWindow :: String -> Int32 -> Int32 -> Int32 -> Int32 -> RGFW.RGFW_windowFlags -> (Ptr RGFW.RGFW_window -> IO r) -> IO r +withWindow name x y w h flags io = withCString name $ \str -> do + window <- RGFW.rGFW_createWindow (ConstPtr str) (RGFW.I32 x) (RGFW.I32 y) (RGFW.I32 w) (RGFW.I32 h) flags + o0 <- io window + RGFW.rGFW_window_close window + return o0 -deviceInfo :: Vk.PhysicalDevice -> IO () -deviceInfo p = do - (_, extensions) <- Vk.enumerateDeviceExtensionProperties p Nothing - (_, layers) <- Vk.enumerateDeviceLayerProperties p - traverse_ (putStrLn . show) extensions - traverse_ (putStrLn . show) layers - (putStrLn . show) =<< Vk.getPhysicalDeviceFeatures p - (putStrLn . show) =<< Vk.getPhysicalDeviceProperties p - (putStrLn . show) =<< Vk.getPhysicalDeviceMemoryProperties p
\ No newline at end of file +withRGFW :: String -> RGFW.RGFW_initFlags -> (Int32 -> IO r) -> IO r +withRGFW title flags io = withCString title $ \str -> do + ret_code <- RGFW.rGFW_init (ConstPtr str) flags + o0 <- io $ fromIntegral ret_code + RGFW.rGFW_deinit + return o0
\ No newline at end of file @@ -24,8 +24,10 @@ module RGFW where import HsBindgen.Runtime.LibC import HsBindgen.TH -let - conf = def{clang = def{extraIncludeDirs = [Dir "include"]}} - confTH = def{verbosity = Verbosity Warning} +let conf = def{ + clang = def{ + extraIncludeDirs = [Dir "include"], + defineMacros = [ "RGFW_VULKAN=" ]}} + confTH = def{verbosity = Verbosity Warning} in - withHsBindgen conf confTH $ hashInclude "RGFW.h"
\ No newline at end of file + withHsBindgen conf confTH $ hashInclude "RGFW.h"
\ No newline at end of file @@ -6,12 +6,20 @@ pkgs.mkShell { pkgs.cabal-install pkgs.ghc pkgs.llvm - pkgs.libclang + pkgs.pkg-config pkgs.vulkan-headers pkgs.vulkan-loader + + pkgs.libX11 + pkgs.libXrandr + pkgs.libXcursor + pkgs.libXi + pkgs.libxcb + pkgs.libxdmcp ]; buildInputs = [ + pkgs.libclang pkgs.libllvm pkgs.vulkan-headers pkgs.vulkan-loader @@ -0,0 +1,3 @@ +#define RGFW_IMPLEMENTATION +#define RGFW_VULKAN +#include <RGFW.h> diff --git a/vktest.cabal b/vktest.cabal index 6f54f67..0447db0 100644 --- a/vktest.cabal +++ b/vktest.cabal @@ -9,22 +9,24 @@ category: Graphics build-type: Simple extra-doc-files: CHANGELOG.md -common warnings - ghc-options: -Wall executable vktest - import: warnings main-is: Main.hs - build-depends: base >= 4.20.2, - vulkan >= 3.27, - vktest, - hs-source-dirs: . - default-language: Haskell2010 -library - import: warnings - exposed-modules: RGFW - build-depends: base >= 4.20, + other-modules: RGFW + build-depends: base >= 4.20.2, + bytestring >= 0.12, + vector >= 0.13, + vulkan >= 3.27, hs-bindgen, hs-bindgen-runtime, + pkgconfig-depends: + x11, + xrandr, + xcursor, + xi, + xcb, + xdmcp, include-dirs: include hs-source-dirs: . + c-sources: shim.c + ghc-options: -Wall default-language: Haskell2010
\ No newline at end of file |