summaryrefslogtreecommitdiff
path: root/src/Game/Internal.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Game/Internal.hs')
-rw-r--r--src/Game/Internal.hs155
1 files changed, 88 insertions, 67 deletions
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 #-}
+{-# 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
+-- - 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
generated by cgit v1.3.1 (git 2.54.0) at 2026-09-04 02:34:17 +0000