From 602507a60567faded8f9d2e0f9d173a4e3ab481b Mon Sep 17 00:00:00 2001
From: andromeda <andromeda@lenovo>
Date: Sun, 8 Feb 2026 15:08:46 +0100
Subject: better projection, transparency; 4d camera, controls r/f for +/-w

---
 src/Game/Internal.hs | 127 ++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 85 insertions(+), 42 deletions(-)

(limited to 'src/Game/Internal.hs')

diff --git a/src/Game/Internal.hs b/src/Game/Internal.hs
index 4a41c8f..e05a907 100644
--- a/src/Game/Internal.hs
+++ b/src/Game/Internal.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE MultilineStrings #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedRecordDot #-}
 
@@ -42,19 +43,24 @@ import Linear (V3 (..), V4 (..))
 -- Shader creation and object initialisation
 --------------------------------------------------------------------------------
 
-initResources :: [[V4 GL.GLfloat]] -> IO ([Object], GL.Program)
-initResources arrays = do
-  objects <-
-    listIOsToIOlist
-      [createObject arr 4 GL.Triangles (GL.AttribLocation 0) | arr <- arrays]
-      []
+initResources :: [V4 GL.GLfloat] -> IO (Object, GL.Program)
+initResources arr = do
+  object <-
+    createObject arr 4 GL.Triangles (GL.AttribLocation 0)
+
+  -- compile shader program
   program <-
     loadShaders
       [ ShaderInfo GL.VertexShader (StringSource vertShader),
         ShaderInfo GL.FragmentShader (StringSource fragShader)
       ]
   GL.currentProgram $= Just program
-  return (objects, program)
+
+  -- alpha
+  GL.blend $= GL.Enabled
+  GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha)
+
+  return (object, program)
 
 listIOsToIOlist :: [IO a] -> [a] -> IO [a]
 listIOsToIOlist [] out = return out
@@ -69,44 +75,81 @@ listIOsToIOlist (io : ios) out = do
 
 vertShader :: String
 vertShader =
-  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;",
-      "}"
-    ]
+  """
+  #version 330 core
+
+  layout (location = 0) in vec4 a_vPos;
+
+  uniform mat4 u_view;
+  uniform mat4 u_projection;
+  uniform vec4 u_cam;
+
+  out vec3 v_pos;
+  out float v_w;
+  out float v_alpha;
+
+  vec3 orthoFrom4d(vec4 point)
+  {
+    return point.xyz;
+  }
+
+  // creates a simple 3d coordinate from a 4d
+  vec3 projectFrom4d(vec4 point)
+  {
+    // TODO don't do camera ops in shader, prefer linear algebra
+    // also use a reasonable projection for god's sake
+    vec4 view = abs(u_cam - point);
+    float perspective = 1.0 / abs(u_cam.w - view.w);
+
+    return perspective * (point.xyz);
+  }
+
+  void main()
+  {
+    vec3 vPos = orthoFrom4d(a_vPos);
+
+    // TODO don't set constant inside of shader :/
+    float wHorizon = 3;
+    float alpha = (wHorizon - abs(u_cam.w - a_vPos.w)) / wHorizon;
+
+    // cull invisible things
+    if (alpha < -1) {
+      gl_Position = vec4(0.0);
+      alpha = 0.0;
+    } else {
+      alpha = max(alpha, 0.0);
+      gl_Position = u_projection * u_view * vec4(vPos, 1.0);
+    }
+
+    v_pos = vPos;
+    v_w = a_vPos.w;
+    v_alpha = alpha;
+  }
+  """
 
 fragShader :: String
 fragShader =
-  unlines
-    [ "#version 330 core",
-      "out vec4 o_vColor;",
-      "in vec3 v_pos;",
-      "void main()",
-      "{",
-      "  // 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);",
-      "}"
-    ]
-
-glslProjectTo3d :: String
-glslProjectTo3d =
-  unlines
-    [ "vec3 projectTo3d(vec4 point)",
-      "{",
-      "  float perspective = 1.0 / (1.0 + point.w);",
-      "  return perspective * point.xyz;",
-      "}"
-    ]
+  """
+  #version 330 core
+
+  uniform vec4 u_cam;
+
+  out vec4 o_vColor;
+
+  in vec3 v_pos;
+  in float v_w;
+  in float v_alpha;
+
+  void main()
+  {
+    // the normal vector of the face
+    // 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)));
+
+    // creates a color based on the normal direction
+    o_vColor = vec4((0.5 + 0.5 * norm) / 2, v_alpha);
+  }
+  """
 
 --------------------------------------------------------------------------------
 -- Objects
-- 
cgit v1.3.1