From f09e348de82871da78ca3ec1c56be9e038cb619a Mon Sep 17 00:00:00 2001 From: andromeda Date: Fri, 27 Feb 2026 22:27:15 +0100 Subject: [PATCH] add example --- flake.nix | 61 ++++++-------------------- hs-rgfw.cabal | 4 +- src/LoadShaders.hs | 91 ++++++++++++++++++++++++++++++++++++++ src/Main.hs | 106 +++++++++++++++++++++++++++++++++------------ 4 files changed, 187 insertions(+), 75 deletions(-) create mode 100644 src/LoadShaders.hs diff --git a/flake.nix b/flake.nix index a315981..2fc3ff9 100644 --- a/flake.nix +++ b/flake.nix @@ -10,52 +10,6 @@ self, ... }: let - version = "0.1.0"; - package = { - # nix stuff - mkDerivation, - lib, - # haskell deps - base, - c-expr-runtime, - hs-bindgen-runtime, - # pkgconfig deps - libGL, - libX11, - libXcursor, - libXi, - xrandr, - # shell deps - clang, - hs-bindgen-cli, - tree, - }: - mkDerivation { - pname = "hs-rgfw"; - inherit version; - src = ./.; - libraryHaskellDepends = [ - base - c-expr-runtime - hs-bindgen-runtime - ]; - libraryPkgconfigDepends = [ - libGL - libX11 - libXcursor - libXi - xrandr - ]; - preConfigure = '' - set -x - export PATH=${clang}/bin:${hs-bindgen-cli}/bin:${tree}/bin:$PATH - ./generate.sh - set +x - ''; - homepage = "https://git.mtgmonkey.net/Andromeda/hs-rgfw"; - license = lib.licenses.gpl3Only; - platforms = ["x86_64-linux"]; - }; system = "x86_64-linux"; pkgs = import nixpkgs { inherit system; @@ -69,6 +23,8 @@ default = pkgs.mkShell { stdenv = pkgs.clangStdenv; packages = [ + pkgs.haskellPackages.ghcide + pkgs.haskellPackages.ormolu pkgs.clang pkgs.cabal-install pkgs.hs-bindgen-cli @@ -80,7 +36,18 @@ }; }; packages.${system} = { - default = pkgs.haskellPackages.callPackage package {}; + default = + (pkgs.haskell.packages.ghc912.callCabal2nix "hs-rgfw" ./. { + xi = pkgs.libxi; + gl = pkgs.libGL; + xcursor = pkgs.libxcursor; + xrandr = pkgs.xrandr; + }).overrideAttrs { + preConfigure = '' + export PATH=${pkgs.clang}/bin:${pkgs.hs-bindgen-cli}/bin:${pkgs.tree}/bin:$PATH + ./generate.sh + ''; + }; }; }; } diff --git a/hs-rgfw.cabal b/hs-rgfw.cabal index b0fd8a0..52d58c1 100644 --- a/hs-rgfw.cabal +++ b/hs-rgfw.cabal @@ -40,9 +40,11 @@ executable hs-rgfw main-is: Main.hs build-depends: , base - , hs-rgfw + , bytestring , c-expr-runtime , hs-bindgen-runtime + , hs-rgfw + , OpenGL pkgconfig-depends: , gl , x11 diff --git a/src/LoadShaders.hs b/src/LoadShaders.hs new file mode 100644 index 0000000..86ecc0f --- /dev/null +++ b/src/LoadShaders.hs @@ -0,0 +1,91 @@ +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- + +-- | +-- Module : LoadShaders +-- Copyright : (c) Sven Panne 2013 +-- License : BSD3 +-- +-- Maintainer : Sven Panne +-- Stability : stable +-- Portability : portable +-- +-- Utilities for shader handling, adapted from LoadShaders.cpp which is (c) The +-- Red Book Authors. +module LoadShaders + ( ShaderSource (..), + ShaderInfo (..), + loadShaders, + ) +where + +import Control.Exception +import Control.Monad +import qualified Data.ByteString as B +import Graphics.Rendering.OpenGL + +-------------------------------------------------------------------------------- + +-- | The source of the shader source code. +data ShaderSource + = -- | The shader source code is directly given as a 'B.ByteString'. + ByteStringSource B.ByteString + | -- | The shader source code is directly given as a 'String'. + StringSource String + | -- | The shader source code is located in the file at the given 'FilePath'. + FileSource FilePath + deriving (Eq, Ord, Show) + +getSource :: ShaderSource -> IO B.ByteString +getSource (ByteStringSource bs) = return bs +getSource (StringSource str) = return $ packUtf8 str +getSource (FileSource path) = B.readFile path + +-------------------------------------------------------------------------------- + +-- | A description of a shader: The type of the shader plus its source code. +data ShaderInfo + = ShaderInfo ShaderType ShaderSource + deriving (Eq, Ord, Show) + +-------------------------------------------------------------------------------- + +-- | Create a new program object from the given shaders, throwing an +-- 'IOException' if something goes wrong. +loadShaders :: [ShaderInfo] -> IO Program +loadShaders infos = + createProgram `bracketOnError` deleteObjectName $ \program -> do + loadCompileAttach program infos + linkAndCheck program + return program + +linkAndCheck :: Program -> IO () +linkAndCheck = checked linkProgram linkStatus programInfoLog "link" + +loadCompileAttach :: Program -> [ShaderInfo] -> IO () +loadCompileAttach _ [] = return () +loadCompileAttach program (ShaderInfo shType source : infos) = + createShader shType `bracketOnError` deleteObjectName $ \shader -> do + src <- getSource source + shaderSourceBS shader $= src + compileAndCheck shader + attachShader program shader + loadCompileAttach program infos + +compileAndCheck :: Shader -> IO () +compileAndCheck = checked compileShader compileStatus shaderInfoLog "compile" + +checked :: + (t -> IO ()) -> + (t -> GettableStateVar Bool) -> + (t -> GettableStateVar String) -> + String -> + t -> + IO () +checked action getStatus getInfoLog message object = do + action object + ok <- get (getStatus object) + unless ok $ do + infoLog <- get (getInfoLog object) + fail (message ++ " log: " ++ infoLog) diff --git a/src/Main.hs b/src/Main.hs index 0119f13..000a709 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,37 +1,89 @@ +{-# LANGUAGE MultilineStrings #-} + module Main where -import RGFW.Generated -import Foreign.C.Types (CChar) -import Foreign.C.String (newCString) -import Foreign.C.ConstPtr import Data.Bits ((.|.)) +import Foreign.C.ConstPtr +import Foreign.C.String (newCString) +import Foreign.C.Types (CChar) +import Foreign.Ptr (Ptr) +import Graphics.Rendering.OpenGL (($=)) +import qualified Graphics.Rendering.OpenGL as GL +import LoadShaders +import RGFW.Generated main :: IO () main = do - - -- disable wayland, can't be bothered - _ <- rGFW_useWayland_safe $ RGFW_bool 0 - - -- create window. This string does not need to be freed, the window stays open + putStrInfo "creating window" + -- string not freed; window remains open windowTitle_cstr <- newCString "window" - let - windowTitle_ptr = ConstPtr windowTitle_cstr - windowFlags = RGFW_windowFlags $ fromIntegral $ RGFW_windowCenter .|. RGFW_windowNoResize .|. RGFW_windowOpenGL + let windowTitle_ptr = ConstPtr windowTitle_cstr + windowFlags = RGFW_windowFlags $ fromIntegral $ RGFW_windowCenter .|. RGFW_windowNoResize .|. RGFW_windowOpenGL - window_ptr <- rGFW_createWindow_safe - windowTitle_ptr -- name - 100 -- x - 100 -- y - 100 -- w - 100 -- h - windowFlags -- flags - putDebug $ "windowFlags: " ++ (show $ unwrapU32 $ unwrapRGFW_windowFlags windowFlags) - putDebug $ "window_ptr: " ++ (show $ window_ptr) - putDebug "created window" - loop 0 + window <- + rGFW_createWindow_safe + windowTitle_ptr -- name + 0 -- x + 0 -- y + 300 -- w + 300 -- h + windowFlags -- flags + putStrDebug $ "windowFlags: " ++ (show $ unwrapU32 $ unwrapRGFW_windowFlags windowFlags) + putStrDebug $ "window: " ++ (show $ window) + putStrInfo "initialising shaders" + _ <- initResources + putStrInfo "entering loop" + loop window 0 -loop :: Int -> IO () -loop i = loop $ i + 1 +loop :: Ptr RGFW_window -> Int -> IO () +loop window i = do + view + rGFW_window_swapBuffers_OpenGL_safe window + loop window $ i + 1 -putDebug :: String -> IO () -putDebug a = putStrLn $ "[debug] " ++ a +putStrDebug :: String -> IO () +putStrDebug a = putStrLn $ "[debug]:" ++ a + +putStrInfo :: String -> IO () +putStrInfo a = putStrLn $ "[info]:" ++ a + +initResources :: IO GL.Program +initResources = do + program <- + loadShaders + [ ShaderInfo GL.VertexShader $ StringSource vertShader, + ShaderInfo GL.FragmentShader $ StringSource fragShader + ] + GL.currentProgram $= Just program + return program + where + vertShader = + """ + #version 330 core + layout (location = 0) in vec3 aPos; + + out vec4 vertexColor; + + void main() + { + gl_Position = vec4(aPos, 1.0); + vertexColor = vec4(0.5, 0.0, 0.0, 1.0); + } + """ + fragShader = + """ + #version 330 core + out vec4 FragColor; + + in vec4 vertexColor; + + void main() + { + FragColor = vertexColor; + } + """ + +view :: IO () +view = do + GL.clearColor $= GL.Color4 1 0 1 1 + GL.clear [GL.ColorBuffer, GL.DepthBuffer]