better colors

src/Game/Internal.hs

@@ -48,7 +48,11 @@ initResources arrays = do
     listIOsToIOlist
       [createObject arr 4 GL.Triangles (GL.AttribLocation 0) | arr <- arrays]
       []
-  program <- loadColorShader
+  program <-
+    loadShaders
+      [ ShaderInfo GL.VertexShader (StringSource vertShader),
+        ShaderInfo GL.FragmentShader (StringSource fragShader)
+      ]
   GL.currentProgram $= Just program
   return (objects, program)
 
@@ -63,20 +67,6 @@ listIOsToIOlist (io : ios) out = do
 -- u_ uniform
 -- o_ fragment shader output
 
-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 =
   unlines
@@ -94,26 +84,17 @@ vertShader =
       "}"
     ]
 
-colorFragShader :: String
-colorFragShader =
+fragShader :: String
+fragShader =
   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);",
+      "  // yoinked from https://stackoverflow.com/questions/14980712/how-to-get-flat-normals-on-a-cube/14981446#14981446",
+      "  vec3 norm = normalize(cross(dFdx(v_pos), dFdy(v_pos)));",
+      "  o_vColor = vec4((0.5 + 0.5 * norm) / 2, 1.0);",
       "}"
     ]
 

src/Main.hs

@@ -48,9 +48,8 @@ main = do
   GLFW.setCursorPosCallback window $ Just (cursorPosHandler Nothing)
   (objects, program) <-
     initResources $
-      [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]
+      [map (\v -> (V4 a 0 a 0) + (rotate4 0 3 (a * g90 / 6) v)) hCube | a <- take 100 [0, 2 ..]]
+        ++ [map (+ V4 a 0 0 0) hCube | a <- take 100 [0, (-2) ..]]
 
   let model =
         mkModel