From bc5e556371531004076b960911fb5f7b9f0138d9 Mon Sep 17 00:00:00 2001 From: mtgmonkey Date: Thu, 27 Nov 2025 19:55:56 +0100 Subject: [PATCH] Regenbogendreiecken --- frag.glsl | 6 ++- src/IO.hs | 102 ++++++++++++++++++++++----------------------- src/LoadShaders.hs | 89 +++++++++++++++++++++++++++++++++++++++ src/Main.hs | 1 - vert.glsl | 9 +++- 5 files changed, 151 insertions(+), 56 deletions(-) create mode 100644 src/LoadShaders.hs diff --git a/frag.glsl b/frag.glsl index cf3bcda..e7dd9a7 100644 --- a/frag.glsl +++ b/frag.glsl @@ -1,8 +1,10 @@ #version 450 core -out vec4 FragColor; +in vec4 fragColor_in; + +out vec4 fragColor_out; void main() { - FragColor = vec4(1.0f, 0.5f, 0.2f, 1.0f); + fragColor_out = fragColor_in; } diff --git a/src/IO.hs b/src/IO.hs index 3d70a00..354625e 100644 --- a/src/IO.hs +++ b/src/IO.hs @@ -5,7 +5,6 @@ module IO (Descriptor, openWindow, shutdownWindow, view) where -- IMPORTS -- -import qualified Data.ByteString as BS import qualified Graphics.Rendering.OpenGL as GL import Graphics.Rendering.OpenGL (($=)) import qualified Graphics.UI.GLFW as GLFW @@ -16,6 +15,7 @@ import Foreign.Ptr import Foreign.Marshal.Array import Foreign.Storable +import LoadShaders import Relude import Model @@ -30,26 +30,13 @@ view window descriptor@(Descriptor vertices firstIndex numVertices) model = do GLFW.swapBuffers window GLFW.pollEvents --- SHADER DATA STRUCTURES -- +-- SHADER STUFF -- -data Descriptor - = Descriptor - { vertexArray :: GL.VertexArrayObject - , firstindex :: GL.ArrayIndex - , numArrayIndicies :: GL.NumArrayIndices - } - -data ShaderInfo - = ShaderInfo - GL.ShaderType - ShaderSource - deriving (Eq, Ord, Show) - -data ShaderSource - = ByteStringSource BS.ByteString - | StringSource String - | FileSource FilePath - deriving (Eq, Ord, Show) +data Descriptor = + Descriptor + GL.VertexArrayObject + GL.ArrayIndex + GL.NumArrayIndices -- INIT RENDERER -- @@ -58,6 +45,8 @@ bufferOffset integral = plusPtr nullPtr $ fromIntegral integral initResources :: IO Descriptor initResources = do + + -- vertices array verticesGLArray <- GL.genObjectName GL.bindVertexArrayObject $= Just verticesGLArray let @@ -70,8 +59,8 @@ initResources = do , GL.Vertex2 0.85 (-0.9) ] :: [GL.Vertex2 GL.GLfloat] numVertices = length verticesArray - arrayBuffer <- GL.genObjectName - GL.bindBuffer GL.ArrayBuffer $= Just arrayBuffer + vertexBuffer <- GL.genObjectName + GL.bindBuffer GL.ArrayBuffer $= Just vertexBuffer withArray verticesArray $ \ptr -> do let size @@ -83,43 +72,54 @@ initResources = do Nothing -> (GL.Vertex2 0 0) :: (GL.Vertex2 GL.GLfloat) Just a -> a GL.bufferData GL.ArrayBuffer $= (size, ptr, GL.StaticDraw) - program <- loadShaders - [ ShaderInfo GL.VertexShader (FileSource "vert.glsl") - , ShaderInfo GL.FragmentShader (FileSource "frag.glsl") - ] - GL.currentProgram $= Just program let firstIndex = 0 vPosition = GL.AttribLocation 0 GL.vertexAttribPointer vPosition $= (GL.ToFloat, GL.VertexArrayDescriptor 2 GL.Float 0 (bufferOffset firstIndex)) GL.vertexAttribArray vPosition $= GL.Enabled + + -- colors array + + let + rgba = + [ GL.Color4 1.0 0.0 0.0 1.0 + , GL.Color4 0.0 1.0 0.0 1.0 + , GL.Color4 0.0 0.0 1.0 1.0 + , GL.Color4 1.0 0.0 0.0 1.0 + , GL.Color4 0.0 1.0 0.0 1.0 + , GL.Color4 0.0 0.0 1.0 1.0 + ] :: [GL.Color4 GL.GLfloat] + colorBuffer <- GL.genObjectName + GL.bindBuffer GL.ArrayBuffer $= Just colorBuffer + withArray rgba $ \ptr -> do + let + size + = fromIntegral + $ (*) + numVertices + $ sizeOf + $ case viaNonEmpty head rgba of + Nothing -> + (GL.Color4 0.0 0.0 0.0 0.0) :: (GL.Color4 GL.GLfloat) + Just a -> + a + GL.bufferData GL.ArrayBuffer $= (size, ptr, GL.StaticDraw) + let + firstIndex = 0 + vPosition = GL.AttribLocation 1 + GL.vertexAttribPointer vPosition $= + (GL.ToFloat, GL.VertexArrayDescriptor 4 GL.Float 0 (bufferOffset firstIndex)) + GL.vertexAttribArray vPosition $= GL.Enabled + + program <- loadShaders + [ ShaderInfo GL.VertexShader (FileSource "vert.glsl") + , ShaderInfo GL.FragmentShader (FileSource "frag.glsl") + ] + GL.currentProgram $= Just program + return $ Descriptor verticesGLArray firstIndex $ fromIntegral numVertices --- LOAD SHADERS -- - -getSource :: ShaderSource -> IO BS.ByteString -getSource (ByteStringSource bs) = return bs -getSource (StringSource str) = return $ GL.packUtf8 str -getSource (FileSource path) = BS.readFile path - -loadShaders :: [ShaderInfo] -> IO GL.Program -loadShaders infos = - GL.createProgram `bracketOnError` GL.deleteObjectName $ \program -> do - loadCompileAttach program infos - GL.linkProgram program - return program - -loadCompileAttach :: GL.Program -> [ShaderInfo] -> IO () -loadCompileAttach _ [] = return () -loadCompileAttach program (ShaderInfo shType source : infos) = - GL.createShader shType `bracketOnError` GL.deleteObjectName $ \shader -> do - src <- getSource source - GL.shaderSourceBS shader $= src - GL.compileShader shader - GL.attachShader program shader - loadCompileAttach program infos - -- INPUT -- keyPressed :: GLFW.KeyCallback diff --git a/src/LoadShaders.hs b/src/LoadShaders.hs new file mode 100644 index 0000000..ae9339d --- /dev/null +++ b/src/LoadShaders.hs @@ -0,0 +1,89 @@ +-------------------------------------------------------------------------------- +-- | +-- 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 = + ByteStringSource B.ByteString + -- ^ The shader source code is directly given as a 'B.ByteString'. + | StringSource String + -- ^ The shader source code is directly given as a 'String'. + | FileSource FilePath + -- ^ The shader source code is located in the file at the given '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 0bf3e05..6731852 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -18,7 +18,6 @@ main :: IO () main = do (window, descriptor) <- openWindow "window :)" - putTextLn "has window" _ <- loop window descriptor update view model return () diff --git a/vert.glsl b/vert.glsl index 65a9f2b..f206195 100644 --- a/vert.glsl +++ b/vert.glsl @@ -1,8 +1,13 @@ #version 450 core -layout (location = 0) in vec3 aPos; +layout (location = 0) in vec4 vertexPosition; +layout (location = 1) in vec4 vertexColor; + +out vec4 fragColor_in; void main() { - gl_Position = vec4(aPos.x, aPos.y, aPos.z, 1.0); + gl_Position = vertexPosition; + + fragColor_in = vertexColor; }