diff --git a/flake.nix b/flake.nix index 526a535..a54fd25 100644 --- a/flake.nix +++ b/flake.nix @@ -11,7 +11,9 @@ pkgs = nixpkgs.legacyPackages.${system}; in { packages.${system} = { - default = pkgs.haskellPackages.callCabal2nix "hs-game" ./. {}; + default = + pkgs.haskell.packages.ghc912.callCabal2nix "hs-game" ./. { + }; }; devShells.${system} = { default = pkgs.mkShell { 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);", - "}" - ] + """ + #version 330 core -glslProjectTo3d :: String -glslProjectTo3d = - unlines - [ "vec3 projectTo3d(vec4 point)", - "{", - " float perspective = 1.0 / (1.0 + point.w);", - " return perspective * point.xyz;", - "}" - ] + 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 diff --git a/src/Game/Internal/Types.hs b/src/Game/Internal/Types.hs index 61173db..0a713d7 100644 --- a/src/Game/Internal/Types.hs +++ b/src/Game/Internal/Types.hs @@ -83,7 +83,7 @@ mkModel camera objects program wprop = -- | camera data Camera = Camera { -- | position in world space - camPos :: V3 Float, + camPos :: V4 Float, -- | pitch in radians, up positive camPitch :: Float, -- | yaw in radians, right positive @@ -107,7 +107,7 @@ data Camera = Camera -- | smart constructor for Camera mkCamera :: - V3 Float -> + V4 Float -> Float -> Float -> V3 Float -> diff --git a/src/Main.hs b/src/Main.hs index 62ec2c4..4d25357 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 (..), (*^), _w, _xyz, _y) import qualified Linear as L -- | Main function runs game @@ -36,6 +36,7 @@ main = do GLFW.windowHint $ GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Core -- MSAA GLFW.windowHint $ GLFW.WindowHint'Samples $ Just 8 + -- alpha -- create window monitor <- GLFW.getPrimaryMonitor Just window <- GLFW.createWindow 256 256 "hs-game" monitor Nothing @@ -46,15 +47,22 @@ main = do GLFW.setKeyCallback window $ Just (keyPressed Nothing) GLFW.setCursorInputMode window GLFW.CursorInputMode'Hidden GLFW.setCursorPosCallback window $ Just (cursorPosHandler Nothing) - (objects, program) <- + (object, program) <- initResources $ - [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) ..]] + concat + ( [hCube] + ++ [map (\v -> (V4 a 0 0 a) + (rotate4 0 1 (a * g90 / 24) v)) hCube | a <- take 1000 [0, 2 ..]] + ++ [map (\v -> (V4 a 2 0 a) + (rotate4 0 2 (a * g90 / 24) v)) hCube | a <- take 1000 [0, 2 ..]] + ++ [map (\v -> (V4 a 4 0 a) + (rotate4 0 3 (a * g90 / 24) v)) hCube | a <- take 1000 [0, 2 ..]] + ++ [map (\v -> (V4 a (-2) 0 a) + (rotate4 1 0 (a * g90 / 24) v)) hCube | a <- take 1000 [0, 2 ..]] + ++ [map (\v -> (V4 a (-4) 0 a) + (rotate4 2 0 (a * g90 / 24) v)) hCube | a <- take 1000 [0, 2 ..]] + ++ [map (\v -> (V4 a (-6) 0 a) + (rotate4 3 0 (a * g90 / 24) v)) hCube | a <- take 1000 [0, 2 ..]] + ) let model = mkModel ( mkCamera - (V3 0 0 3) -- camPos + (V4 0 0 3 0) -- camPos 0 -- pitch 0 -- yaw (V3 0 0 (-1)) -- reference vector @@ -63,7 +71,7 @@ main = do 16 -- strafe strength 12 -- jump strength ) - objects + [object] program (mkWorldProperties 2 0.16 (V3 0 1 0)) modelRef <- newIORef model @@ -173,10 +181,32 @@ hCube = -- | update function update :: Float -> Model -> Model update dt model = - updateVelocity dt $ - updateAcceleration dt $ - updateSpeed dt $ - updateCameraAngle dt model + updateW dt $ + updateVelocity dt $ + updateAcceleration dt $ + updateSpeed dt $ + updateCameraAngle dt model + +updateW :: Float -> Model -> Model +updateW dt model = + if elem GLFW.Key'R model.keys + then + model + { camera = + model.camera + { camPos = model.camera.camPos + (V4 0 0 0 (dt * dt * model.camera.strafeStrength)) + } + } + else + if elem GLFW.Key'F model.keys + then + model + { camera = + model.camera + { camPos = model.camera.camPos - (V4 0 0 0 (dt * dt * model.camera.strafeStrength)) + } + } + else model updateSpeed :: Float -> Model -> Model updateSpeed dt model = @@ -230,7 +260,7 @@ updateAcceleration dt model = then V3 0 (0 - model.wprop.g * model.camera.airTime) 0 else V3 0 0 0 camVel' = friction * (model.camera.camVel + movement' + jump) - aboveGround = (model.camera.camPos + dt L.*^ camVel') ^. _y > 0 + aboveGround = ((model.camera.camPos ^. _xyz) + dt L.*^ camVel') ^. _y > 0 in if (elem GLFW.Key'Space model.keys) && (model.camera.hasJumped == False) then updateAcceleration dt $ @@ -261,7 +291,7 @@ updateAcceleration dt model = model.camera { airTime = 0, camVel = camVel' * (V3 1 0 1), - camPos = model.camera.camPos * (V3 1 0 1), + camPos = model.camera.camPos * (V4 1 0 1 1), hasJumped = aboveGround } } @@ -271,7 +301,7 @@ updateVelocity dt model = model { camera = model.camera - { camPos = model.camera.camPos + dt L.*^ model.camera.camVel + { camPos = V4 1 1 1 (model.camera.camPos ^. _w) * (L.point $ (model.camera.camPos ^. _xyz) + dt L.*^ model.camera.camVel) } } @@ -314,23 +344,37 @@ view window model = do forward = V3 (cos pitch * sin yaw) (sin pitch) (cos pitch * cos yaw) viewMatrix = L.lookAt - model.camera.camPos - (model.camera.camPos - forward) + (model.camera.camPos ^. _xyz) + ((model.camera.camPos ^. _xyz) - forward) model.wprop.up projectionMatrix = L.perspective 1.2 (fromIntegral w / fromIntegral h) 0.01 1000 + viewGLMatrix <- GL.newMatrix GL.RowMajor $ toGLMatrix viewMatrix :: IO (GL.GLmatrix GL.GLfloat) + + -- load 3d view matrix viewLocation <- GL.get $ GL.uniformLocation model.program "u_view" GL.uniform viewLocation $= viewGLMatrix + projectionGLMatrix <- GL.newMatrix GL.RowMajor $ toGLMatrix projectionMatrix :: IO (GL.GLmatrix GL.GLfloat) + + -- load 3d projection matrix projectionLocation <- GL.get $ GL.uniformLocation model.program "u_projection" GL.uniform projectionLocation $= projectionGLMatrix + + let camx = (\(V4 x _ _ _) -> x) model.camera.camPos + camy = (\(V4 _ y _ _) -> y) model.camera.camPos + camz = (\(V4 _ _ z _) -> z) model.camera.camPos + camw = (\(V4 _ _ _ w) -> w) model.camera.camPos + camWLocation <- GL.get $ GL.uniformLocation model.program "u_cam" + GL.uniform camWLocation $= GL.Vector4 camx camy camz camw + -- draw objects; returns IO [] _ <- drawObjects model.objects -- swap to current buffer