blob: b0dccb9c0a1bda3ae27fee0e1143d57d399a9861 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
-- |
-- - Module : Game
-- - Description : runs game
-- - Copyright : 2025 Andromeda
-- - License : BSD 3-clause
-- - Maintainer : Matrix @Andromeda:tchncs.de
-- - Stability : Experimental
module Main
( main,
)
where
import Control.Lens ((^.))
import Data.IORef (newIORef)
import Data.List (nub)
import GHC.Float (double2Float)
import Game.Internal
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 (..), (*^), _w, _xyz, _y)
import qualified Linear as L
-- | Main function runs game
main :: IO ()
main = do
_ <- GLFW.init
GLFW.defaultWindowHints
-- OpenGL core >=3.3
GLFW.windowHint $ GLFW.WindowHint'ContextVersionMajor 3
GLFW.windowHint $ GLFW.WindowHint'ContextVersionMinor 3
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
GLFW.makeContextCurrent $ Just window
-- add callbacks
GLFW.setWindowCloseCallback window $ Just shutdownWindow
GLFW.setWindowSizeCallback window $ Just resizeWindow
GLFW.setKeyCallback window $ Just (keyPressed Nothing)
GLFW.setCursorInputMode window GLFW.CursorInputMode'Hidden
GLFW.setCursorPosCallback window $ Just (cursorPosHandler Nothing)
loop window 0 update view modelRef
--------------------------------------------------------------------------------
-- Elm-like data structures
--------------------------------------------------------------------------------
-- | update function
update :: Float -> Model -> Model
update dt model = model
-- | views the model
view :: GLFW.Window -> Model -> IO ()
view window model = do
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
-- TODO optimise this inefficient pos
let objarr = map (v3tov4 camw) $ sliceW camw $ initArr
(obj, program) <- initResources objarr
-- fit viewport to window
(w, h) <- GLFW.getFramebufferSize window
GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h))
-- clear screen
GL.clearColor $= GL.Color4 1 0 1 1
GL.clear [GL.ColorBuffer, GL.DepthBuffer]
-- depth
GL.depthFunc $= Just GL.Less
-- apply transforms
let pitch = model.camera.camPitch
yaw = model.camera.camYaw
forward = V3 (cos pitch * sin yaw) (sin pitch) (cos pitch * cos yaw)
viewMatrix =
L.lookAt
(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 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 program "u_projection"
GL.uniform projectionLocation $= projectionGLMatrix
camWLocation <- GL.get $ GL.uniformLocation program "u_cam"
GL.uniform camWLocation $= GL.Vector4 camx camy camz camw
-- draw objects; returns IO []
_ <- drawObjects [obj]
-- swap to current buffer
GLFW.swapBuffers window
-- check for interrupts
GLFW.pollEvents
|
