diff options
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 74 |
1 files changed, 59 insertions, 15 deletions
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 |