From 5474012f893debd21eb1f84aa7390ea9c6eeafd2 Mon Sep 17 00:00:00 2001 From: andromeda Date: Sat, 7 Feb 2026 17:37:05 +0100 Subject: [PATCH] hypercubes but actually --- src/Game/Internal.hs | 92 ++++++++++++++++---------- src/Game/Internal/Types.hs | 3 +- src/Main.hs | 130 +++++++++++++++++++++---------------- 3 files changed, 133 insertions(+), 92 deletions(-) diff --git a/src/Game/Internal.hs b/src/Game/Internal.hs index e606505..3556df0 100644 --- a/src/Game/Internal.hs +++ b/src/Game/Internal.hs @@ -46,13 +46,9 @@ initResources :: [[V4 GL.GLfloat]] -> IO ([Object], GL.Program) initResources arrays = do objects <- listIOsToIOlist - [createObject arr 4 GL.TriangleStrip (GL.AttribLocation 0) | arr <- arrays] + [createObject arr 4 GL.Triangles (GL.AttribLocation 0) | arr <- arrays] [] - program <- - loadShaders - [ ShaderInfo GL.VertexShader (StringSource vertShader), - ShaderInfo GL.FragmentShader (StringSource fragShader) - ] + program <- loadColorShader GL.currentProgram $= Just program return (objects, program) @@ -67,39 +63,69 @@ listIOsToIOlist (io : ios) out = do -- u_ uniform -- o_ fragment shader output --- | vertex shader +loadBlackShader :: IO GL.Program +loadBlackShader = + loadShaders + [ ShaderInfo GL.VertexShader (StringSource vertShader), + ShaderInfo GL.FragmentShader (StringSource blackFragShader) + ] + +loadColorShader :: IO GL.Program +loadColorShader = + loadShaders + [ ShaderInfo GL.VertexShader (StringSource vertShader), + ShaderInfo GL.FragmentShader (StringSource colorFragShader) + ] + vertShader :: String vertShader = - "#version 330 core\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(projectTo3d(a_vPos), 1.0);\n" - ++ " v_pos = a_vPos.xyz;\n" - ++ "}\n" + unlines + [ "#version 330 core", + "layout (location = 0) in vec4 a_vPos;", + "uniform mat4 u_view;", + "uniform mat4 u_projection;", + "out vec3 v_pos;", + glslProjectTo3d, + "void main()", + "{", + " vec3 vPos = projectTo3d(a_vPos);", + " gl_Position = u_projection * u_view * vec4(vPos, 1.0);", + " v_pos = vPos;", + "}" + ] --- | fragment shader -fragShader :: String -fragShader = - "#version 330 core\n" - ++ "out vec4 o_vColor;\n" - ++ "in vec3 v_pos;\n" - ++ "void main()\n" - ++ "{\n" - ++ " o_vColor = vec4(0.5 + 0.5 * normalize(v_pos), 1);\n" - ++ "}\n" +colorFragShader :: String +colorFragShader = + unlines + [ "#version 330 core", + "out vec4 o_vColor;", + "in vec3 v_pos;", + "void main()", + "{", + " o_vColor = vec4((0.5 + 0.5 * normalize(v_pos)) / 2, 1.0);", + "}" + ] + +blackFragShader :: String +blackFragShader = + unlines + [ "#version 330 core", + "out vec4 o_vColor;", + "void main()", + "{", + " o_vColor = vec4(0.0, 0.0, 0.0, 1.0);", + "}" + ] glslProjectTo3d :: String glslProjectTo3d = - "vec3 projectTo3d(vec4 point)\n" - ++ "{\n" - ++ " float perspective = 1.0 / (1.0 + point.w);\n" - ++ " return perspective * point.xyz;\n" - ++ "}\n" + unlines + [ "vec3 projectTo3d(vec4 point)", + "{", + " float perspective = 1.0 / (1.0 + point.w);", + " return perspective * point.xyz;", + "}" + ] -------------------------------------------------------------------------------- -- Objects diff --git a/src/Game/Internal/Types.hs b/src/Game/Internal/Types.hs index b8e7229..61173db 100644 --- a/src/Game/Internal/Types.hs +++ b/src/Game/Internal/Types.hs @@ -11,7 +11,7 @@ module Game.Internal.Types ( Object (..), toGLMatrix, - Model (camera, objects, cursorDeltaPos, cursorPos, program, keys, wprop), + Model (camera, objects, cursorDeltaPos, cursorPos, keys, program, wprop), mkModel, Camera (camPos, camPitch, camYaw, camReference, mouseSensitivity, camVel, strafeStrength, jumpStrength, hasJumped, airTime), mkCamera, @@ -70,7 +70,6 @@ data Model = Model keys :: [GLFW.Key], -- | draw calls objects :: [Object], - -- | shader program program :: GL.Program, wprop :: WorldProperties } diff --git a/src/Main.hs b/src/Main.hs index 2786f86..16029b4 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -22,7 +22,7 @@ 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 (..), V4 (..), _y) +import Linear (V3 (..), V4 (..), (*^), _y) import qualified Linear as L -- | Main function runs game @@ -48,8 +48,9 @@ main = do GLFW.setCursorPosCallback window $ Just (cursorPosHandler Nothing) (objects, program) <- initResources $ - -- [map (v3tov4 0) $ map (+ V3 a 0 0) cube | a <- take 100 [0, 2 ..]] - [hCube] + [map (v3tov4 0) $ map (+ V3 a 0 0) cube | a <- take 100 [4, 6 ..]] + ++ [hCube] + ++ [map (\v -> rotate4 0 3 (g90 / 3) (v + V4 0 3 0 0)) hCube] let model = mkModel @@ -75,34 +76,13 @@ main = do -------------------------------------------------------------------------------- -- Arrays -------------------------------------------------------------------------------- -top :: [V3 GL.GLfloat] -top = - [ V3 p 0 p, - V3 p 0 m, - V3 m 0 p, - V3 m 0 m - ] - -side :: [V3 GL.GLfloat] -side = - [ V3 0 p p, - V3 0 p m, - V3 0 m p, - V3 0 m m - ] - -front :: [V3 GL.GLfloat] -front = - [ V3 p p 0, - V3 p m 0, - V3 m p 0, - V3 m m 0 - ] m = (0 - p) p = 0.5 +g90 = pi / 2 + v3tov4 :: GL.GLfloat -> V3 GL.GLfloat -> V4 GL.GLfloat v3tov4 w (V3 x y z) = V4 x y z w @@ -115,41 +95,77 @@ v3tov4'' w (V3 x y z) = V4 x w y z v3tov4''' :: GL.GLfloat -> V3 GL.GLfloat -> V4 GL.GLfloat v3tov4''' w (V3 x y z) = V4 w x y z --- | TODO optimise cube -cube :: [V3 GL.GLfloat] -cube = - [ V3 p p p, -- front - V3 p m p, - V3 m p p, - V3 m m p, -- down - V3 m m m, - V3 p m p, - V3 p m m, -- right - V3 p p m, - V3 p m p, - V3 p p p, -- up - V3 m p p, - V3 p p m, - V3 m p m, -- back - V3 p m m, - V3 p p m, - V3 m m m, -- left - V3 m p m, - V3 m m p, - V3 m p p +rotate :: V3 GL.GLfloat -> GL.GLfloat -> V3 GL.GLfloat -> V3 GL.GLfloat +rotate axis angle point = L.fromQuaternion (L.axisAngle axis angle) L.!* point + +rotate4 :: Int -> Int -> GL.GLfloat -> V4 GL.GLfloat -> V4 GL.GLfloat +rotate4 i0 i1 angle (V4 x y z w) = + let coords = [x, y, z, w] + cos' = cos angle + sin' = sin angle + xi = coords !! i0 + xj = coords !! i1 + coords' = + [ if k == i0 + then cos' * xi - sin' * xj + else + if k == i1 + then sin' * xi + cos' * xj + else coords !! k + | k <- [0 .. 3] + ] + in V4 (coords' !! 0) (coords' !! 1) (coords' !! 2) (coords' !! 3) + +cycle3r :: V3 GL.GLfloat -> V3 GL.GLfloat +cycle3r (V3 a b c) = V3 c a b + +cycle3l :: V3 GL.GLfloat -> V3 GL.GLfloat +cycle3l (V3 a b c) = V3 b c a + +face :: [V3 GL.GLfloat] +face = + [ V3 m m 0, + V3 p m 0, + V3 m p 0, + V3 m p 0, + V3 p m 0, + V3 p p 0 ] --- | TODO optimise hCube +-- | cube, side length 1, centered on 0 0 0 +cube :: [V3 GL.GLfloat] +cube = + concatMap + ( \faceSpec -> + map + (\v -> (rotate (fst faceSpec) g90 v) L.^+^ (rotate (fst faceSpec) g90 (snd faceSpec))) + face + ) + [ (V3 0 0 1, V3 0 0 p), + (V3 0 1 0, V3 0 0 p), + (V3 1 0 0, V3 0 0 p), + (V3 0 0 (-1), V3 0 0 m), -- no clue + (V3 0 (-1) 0, V3 0 0 p), + (V3 (-1) 0 0, V3 0 0 p) + ] + hCube :: [V4 GL.GLfloat] hCube = - (map (v3tov4 m) cube) - ++ (map (v3tov4 p) cube) - ++ (map (v3tov4' m) cube) - ++ (map (v3tov4' p) cube) - ++ (map (v3tov4'' m) cube) - ++ (map (v3tov4'' p) cube) - ++ (map (v3tov4''' m) cube) - ++ (map (v3tov4''' p) cube) + concatMap + ( \(w, i0, i1) -> + map + (rotate4 i0 i1 g90 . v3tov4 w) + cube + ) + [ (p, 3, 0), + (p, 0, 3), + (p, 1, 3), + (p, 2, 3), + (m, 3, 0), + (m, 0, 3), + (m, 1, 3), + (m, 2, 3) + ] -------------------------------------------------------------------------------- -- Elm-like data structures