From 2a3c9bdafb22f0ee5353c8ca7761e897b09f1e83 Mon Sep 17 00:00:00 2001 From: andromeda Date: Fri, 6 Feb 2026 01:18:36 +0100 Subject: hypercube, format ig --- src/Game/Internal.hs | 157 +++++++++++++++++++++++++++++---------------------- 1 file changed, 89 insertions(+), 68 deletions(-) (limited to 'src/Game/Internal.hs') diff --git a/src/Game/Internal.hs b/src/Game/Internal.hs index 39f3fd4..e606505 100644 --- a/src/Game/Internal.hs +++ b/src/Game/Internal.hs @@ -1,28 +1,27 @@ -{-# LANGUAGE DisambiguateRecordFields, NamedFieldPuns, OverloadedRecordDot #-} - -{- | - - Module : Game.Internal - - Description : internal functions - - Copyright : 2025 Andromeda - - License : BSD 3-clause - - Maintainer : Matrix @Andromeda:tchncs.de - - Stability : Experimental - -} +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedRecordDot #-} + +-- | +-- - Module : Game.Internal +-- - Description : internal functions +-- - Copyright : 2025 Andromeda +-- - License : BSD 3-clause +-- - Maintainer : Matrix @Andromeda:tchncs.de +-- - Stability : Experimental module Game.Internal - ( cursorPosHandler - , drawObjects - , initResources - , keyPressed - , loop - , resizeWindow - , shutdownWindow - , updateCursorPos - , updateKeyPressed - , updateKeyReleased - ) where - -import Game.Internal.LoadShaders -import Game.Internal.Types + ( cursorPosHandler, + drawObjects, + initResources, + keyPressed, + loop, + resizeWindow, + shutdownWindow, + updateCursorPos, + updateKeyPressed, + updateKeyReleased, + ) +where import Control.Concurrent (threadDelay) import Control.Monad (when) @@ -32,53 +31,56 @@ import Foreign.Marshal.Array (withArray) import Foreign.Ptr (nullPtr, plusPtr) import Foreign.Storable (Storable, sizeOf) import GHC.Float (double2Float) - -import qualified Graphics.Rendering.OpenGL as GL +import Game.Internal.LoadShaders +import Game.Internal.Types import Graphics.Rendering.OpenGL (($=)) +import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.UI.GLFW as GLFW - -import Linear (V3(..)) +import Linear (V3 (..), V4 (..)) -------------------------------------------------------------------------------- -- Shader creation and object initialisation -------------------------------------------------------------------------------- --- | loads models, shaders -initResources :: [[V3 GL.GLfloat]] -> IO ([Object], GL.Program) + +initResources :: [[V4 GL.GLfloat]] -> IO ([Object], GL.Program) initResources arrays = do - -- create objects - objects <- listIOsToIOlist [ createObject arr 3 GL.TriangleStrip | arr <- arrays ] [] - -- load shaders + objects <- + listIOsToIOlist + [createObject arr 4 GL.TriangleStrip (GL.AttribLocation 0) | arr <- arrays] + [] program <- loadShaders - [ ShaderInfo GL.VertexShader (StringSource vertShader) - , ShaderInfo GL.FragmentShader (StringSource fragShader) + [ ShaderInfo GL.VertexShader (StringSource vertShader), + ShaderInfo GL.FragmentShader (StringSource fragShader) ] GL.currentProgram $= Just program return (objects, program) listIOsToIOlist :: [IO a] -> [a] -> IO [a] listIOsToIOlist [] out = return out -listIOsToIOlist (io:ios) out = do +listIOsToIOlist (io : ios) out = do ioVal <- io - listIOsToIOlist ios (ioVal:out) + listIOsToIOlist ios (ioVal : out) -- a_ vertex shader input -- v_ varying -- u_ uniform -- o_ fragment shader output + -- | vertex shader vertShader :: String vertShader = "#version 330 core\n" - ++ "layout (location = 0) in vec3 a_vPos;\n" + ++ "layout (location = 0) in vec4 a_vPos;\n" ++ "uniform mat4 u_view;\n" ++ "uniform mat4 u_projection;\n" ++ "out vec3 v_pos;\n" + ++ glslProjectTo3d ++ "void main()\n" ++ "{\n" - ++ " gl_Position = u_projection * u_view * vec4(a_vPos.xyz, 1.0);\n" - ++ " v_pos = a_vPos;\n" - ++ "}" + ++ " gl_Position = u_projection * u_view * vec4(projectTo3d(a_vPos), 1.0);\n" + ++ " v_pos = a_vPos.xyz;\n" + ++ "}\n" -- | fragment shader fragShader :: String @@ -89,23 +91,32 @@ fragShader = ++ "void main()\n" ++ "{\n" ++ " o_vColor = vec4(0.5 + 0.5 * normalize(v_pos), 1);\n" - ++ "}" + ++ "}\n" + +glslProjectTo3d :: String +glslProjectTo3d = + "vec3 projectTo3d(vec4 point)\n" + ++ "{\n" + ++ " float perspective = 1.0 / (1.0 + point.w);\n" + ++ " return perspective * point.xyz;\n" + ++ "}\n" -------------------------------------------------------------------------------- -- Objects -------------------------------------------------------------------------------- + -- | calculates the size in memory of an array sizeOfArray :: (Storable a, Num b) => [a] -> b sizeOfArray [] = 0 -sizeOfArray (x:xs) = fromIntegral $ (*) (1 + length xs) $ sizeOf x +sizeOfArray (x : xs) = fromIntegral $ (*) (1 + length xs) $ sizeOf x -- | loads a given array into a given attribute index createVBO :: - Storable (a GL.GLfloat) - => [a GL.GLfloat] - -> GL.NumComponents - -> GL.AttribLocation - -> IO GL.BufferObject + (Storable (a GL.GLfloat)) => + [a GL.GLfloat] -> + GL.NumComponents -> + GL.AttribLocation -> + IO GL.BufferObject createVBO array numComponents attribLocation = do -- vbo for buffer buffer <- GL.genObjectName @@ -115,37 +126,45 @@ createVBO array numComponents attribLocation = do GL.bufferData GL.ArrayBuffer $= (sizeOfArray array, ptr, GL.StaticDraw) -- create attribute pointer to buffer GL.vertexAttribPointer attribLocation - $= ( GL.ToFloat - , GL.VertexArrayDescriptor numComponents GL.Float 0 (plusPtr nullPtr 0)) + $= ( GL.ToFloat, + GL.VertexArrayDescriptor numComponents GL.Float 0 (plusPtr nullPtr 0) + ) GL.vertexAttribArray attribLocation $= GL.Enabled return buffer -- | creates an object from a given array; deals with vbos and everything createObject :: - Storable (a GL.GLfloat) - => [a GL.GLfloat] - -> GL.NumComponents - -> GL.PrimitiveMode - -> IO Object -createObject array numComponents primitiveMode = do + (Storable (a GL.GLfloat)) => + [a GL.GLfloat] -> + GL.NumComponents -> + GL.PrimitiveMode -> + GL.AttribLocation -> + IO Object +createObject array numComponents primitiveMode attrLocation = do -- vao for object vao <- GL.genObjectName GL.bindVertexArrayObject $= Just vao -- vbo for vertices - _ <- createVBO array numComponents $ GL.AttribLocation 0 + _ <- createVBO array numComponents attrLocation return (Object vao (fromIntegral $ length array) numComponents primitiveMode) -------------------------------------------------------------------------------- -- Elm-like data structures -------------------------------------------------------------------------------- + -- | gameloop loop :: - GLFW.Window -- ^ window to display on - -> Float -- ^ dt - -> (Float -> Model -> Model) -- ^ update function - -> (GLFW.Window -> Model -> IO ()) -- ^ view function - -> IORef Model -- ^ model - -> IO () + -- | window to display on + GLFW.Window -> + -- | dt + Float -> + -- | update function + (Float -> Model -> Model) -> + -- | view function + (GLFW.Window -> Model -> IO ()) -> + -- | model + IORef Model -> + IO () loop window dt update view modelRef = do -- start frame timer Just frameStart <- GLFW.getTime @@ -183,16 +202,17 @@ updateCursorPos x y model = (((fst model.cursorPos) - x) ** 2 + ((snd model.cursorPos) - y) ** 2) ** 0.5 in if pyth < 16 - then model - { cursorPos = (x, y) - , cursorDeltaPos = applyToTuples (-) model.cursorPos (x, y) - } + then + model + { cursorPos = (x, y), + cursorDeltaPos = applyToTuples (-) model.cursorPos (x, y) + } else model {cursorPos = (x, y)} -- | draws objects drawObjects :: [Object] -> IO ([Object]) drawObjects [] = return [] -drawObjects ((Object vao numVertices _ primitiveMode):objects) = do +drawObjects ((Object vao numVertices _ primitiveMode) : objects) = do GL.bindVertexArrayObject $= Just vao GL.drawArrays primitiveMode 0 numVertices drawObjects objects @@ -200,6 +220,7 @@ drawObjects ((Object vao numVertices _ primitiveMode):objects) = do -------------------------------------------------------------------------------- -- interrupts -------------------------------------------------------------------------------- + -- | shuts down GLFW shutdownWindow :: GLFW.WindowCloseCallback shutdownWindow window = do -- cgit v1.3.1