hypercubes but actually

2 files changed, 60 insertions, 35 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;",
+      "}"
+    ]
+
+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);",
+      "}"
+    ]
 
--- | 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"
+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
   }