diff options
author | 3gg <3gg@shellblade.net> | 2023-10-02 09:03:53 -0700 |
---|---|---|
committer | 3gg <3gg@shellblade.net> | 2023-10-02 09:03:53 -0700 |
commit | 9209a05d5d61458bf63af1f4b14c03dee934112a (patch) | |
tree | 1ea32832ffb860c6495f80c9aaefc282509278ad /Demos/Pong/Main.hs | |
parent | df04706413ca2bba4017c5b2d19bc992aa985110 (diff) |
First pass at render backend.
Diffstat (limited to 'Demos/Pong/Main.hs')
-rw-r--r-- | Demos/Pong/Main.hs | 110 |
1 files changed, 67 insertions, 43 deletions
diff --git a/Demos/Pong/Main.hs b/Demos/Pong/Main.hs index ac0feab..c82b67e 100644 --- a/Demos/Pong/Main.hs +++ b/Demos/Pong/Main.hs | |||
@@ -1,31 +1,49 @@ | |||
1 | module Main where | 1 | module Main where |
2 | 2 | ||
3 | import Data.Maybe (mapMaybe) | ||
4 | import Graphics.Rendering.OpenGL.GL (($=)) | ||
5 | import qualified Graphics.Rendering.OpenGL.GL as GL | ||
6 | import Graphics.Rendering.OpenGL.GL.VertexSpec (currentColor) | ||
7 | import Pong | 3 | import Pong |
4 | |||
8 | import Spear.App | 5 | import Spear.App |
9 | import Spear.Game | 6 | import Spear.Game |
10 | import Spear.Math.AABB | 7 | import Spear.Math.AABB |
8 | import Spear.Math.Matrix4 as Matrix4 hiding | ||
9 | (position) | ||
11 | import Spear.Math.Spatial | 10 | import Spear.Math.Spatial |
12 | import Spear.Math.Spatial2 | 11 | import Spear.Math.Spatial2 |
13 | import Spear.Math.Vector | 12 | import Spear.Math.Vector |
13 | import Spear.Render.Core.Pipeline | ||
14 | import Spear.Render.Core.State | ||
15 | import Spear.Render.Immediate | ||
14 | import Spear.Window | 16 | import Spear.Window |
15 | 17 | ||
18 | import Data.Maybe (mapMaybe) | ||
19 | import Graphics.Rendering.OpenGL.GL (($=)) | ||
20 | import qualified Graphics.Rendering.OpenGL.GL as GL | ||
21 | import Graphics.Rendering.OpenGL.GL.VertexSpec (currentColor) | ||
22 | |||
23 | |||
16 | data GameState = GameState | 24 | data GameState = GameState |
17 | { window :: Window, | 25 | { window :: Window |
18 | world :: [GameObject] | 26 | , renderCoreState :: RenderCoreState |
27 | , immRenderState :: ImmRenderState | ||
28 | , viewProjection :: Matrix4 | ||
29 | , world :: [GameObject] | ||
19 | } | 30 | } |
20 | 31 | ||
21 | app = App step render resize | 32 | app = App step render resize |
22 | 33 | ||
23 | main = | 34 | main = |
24 | withWindow (900, 600) (2, 0) (Just "Pong") initGame $ | 35 | withWindow (900, 600) (Just "Pong") initGame endGame $ |
25 | loop app | 36 | loop app |
26 | 37 | ||
27 | initGame :: Window -> Game () GameState | 38 | initGame :: Window -> Game () GameState |
28 | initGame window = return $ GameState window newWorld | 39 | initGame window = do |
40 | (immRenderState, renderCoreState) <- runSiblingGame newImmRenderer newRenderCoreState | ||
41 | return $ GameState window renderCoreState immRenderState Matrix4.id newWorld | ||
42 | |||
43 | endGame :: Game GameState () | ||
44 | endGame = do | ||
45 | game <- getGameState | ||
46 | runSubGame' (deleteImmRenderer $ immRenderState game) (renderCoreState game) | ||
29 | 47 | ||
30 | step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool | 48 | step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool |
31 | step elapsed dt inputEvents = do | 49 | step elapsed dt inputEvents = do |
@@ -38,47 +56,54 @@ step elapsed dt inputEvents = do | |||
38 | return (not $ exitRequested inputEvents) | 56 | return (not $ exitRequested inputEvents) |
39 | 57 | ||
40 | render :: Game GameState () | 58 | render :: Game GameState () |
41 | render = getGameState >>= \gs -> gameIO . render' $ world gs | 59 | render = do |
60 | gameState <- getGameState | ||
61 | immRenderState' <- flip execSubGame (immRenderState gameState) $ do | ||
62 | immStart | ||
63 | immSetViewProjectionMatrix (viewProjection gameState) | ||
64 | -- Clear the background to a different colour than the playable area to make | ||
65 | -- the latter distinguishable. | ||
66 | gameIO $ do | ||
67 | setClearColour (0.2, 0.2, 0.2, 0.0) | ||
68 | clearBuffers [ColourBuffer] | ||
69 | render' $ world gameState | ||
70 | immEnd | ||
71 | saveGameState $ gameState { immRenderState = immRenderState' } | ||
42 | 72 | ||
43 | render' :: [GameObject] -> IO () | 73 | render' :: [GameObject] -> Game ImmRenderState () |
44 | render' world = do | 74 | render' world = do |
45 | -- Clear the background to a different colour than the playable area to make | 75 | immLoadIdentity |
46 | -- the latter distinguishable. | ||
47 | GL.clearColor $= GL.Color4 0.2 0.2 0.2 0.0 | ||
48 | GL.clear [GL.ColorBuffer] | ||
49 | GL.matrixMode $= GL.Modelview 0 | ||
50 | GL.loadIdentity | ||
51 | renderBackground | 76 | renderBackground |
52 | -- Draw objects. | 77 | -- Draw objects. |
53 | GL.currentColor $= GL.Color4 1.0 1.0 1.0 1.0 | 78 | immSetColour (vec4 1.0 1.0 1.0 1.0) |
54 | mapM_ renderGO world | 79 | mapM_ renderGO world |
55 | 80 | ||
56 | renderBackground :: IO () | 81 | renderBackground :: Game ImmRenderState () |
57 | renderBackground = | 82 | renderBackground = |
58 | let pmin = 0 :: Float | 83 | let pmin = 0 :: Float |
59 | pmax = 1 :: Float | 84 | pmax = 1 :: Float |
60 | in do | 85 | in do |
61 | GL.currentColor $= GL.Color4 0.7 0.5 0.7 1.0 | 86 | immSetColour (vec4 0.6 0.35 0.6 1.0) |
62 | GL.renderPrimitive GL.TriangleStrip $ do | 87 | immDrawQuads2d [ |
63 | GL.vertex (GL.Vertex2 pmin pmax) | 88 | (vec2 pmin pmin |
64 | GL.vertex (GL.Vertex2 pmin pmin) | 89 | ,vec2 pmax pmin |
65 | GL.vertex (GL.Vertex2 pmax pmax) | 90 | ,vec2 pmax pmax |
66 | GL.vertex (GL.Vertex2 pmax pmin) | 91 | ,vec2 pmin pmax)] |
67 | 92 | ||
68 | renderGO :: GameObject -> IO () | 93 | renderGO :: GameObject -> Game ImmRenderState () |
69 | renderGO go = do | 94 | renderGO go = do |
70 | let (AABB2 (Vector2 xmin' ymin') (Vector2 xmax' ymax')) = aabb go | 95 | let (AABB2 (Vector2 xmin ymin) (Vector2 xmax ymax)) = aabb go |
71 | (Vector2 xcenter ycenter) = position go | 96 | (Vector2 xcenter ycenter) = position go |
72 | (xmin, ymin, xmax, ymax) = (f2d xmin', f2d ymin', f2d xmax', f2d ymax') | 97 | immPreservingMatrix $ do |
73 | GL.preservingMatrix $ do | 98 | immTranslate (vec3 xcenter ycenter 0) |
74 | GL.translate (GL.Vector3 (f2d xcenter) (f2d ycenter) 0) | 99 | immDrawQuads2d [ |
75 | GL.renderPrimitive GL.TriangleStrip $ do | 100 | (vec2 xmin ymin |
76 | GL.vertex (GL.Vertex2 xmin ymax) | 101 | ,vec2 xmax ymin |
77 | GL.vertex (GL.Vertex2 xmin ymin) | 102 | ,vec2 xmax ymax |
78 | GL.vertex (GL.Vertex2 xmax ymax) | 103 | ,vec2 xmin ymax)] |
79 | GL.vertex (GL.Vertex2 xmax ymin) | 104 | |
80 | 105 | -- TODO: Fix the resize hang. | |
81 | resize :: WindowEvent -> Game s () | 106 | resize :: WindowEvent -> Game GameState () |
82 | resize (ResizeEvent w h) = | 107 | resize (ResizeEvent w h) = |
83 | let r = fromIntegral w / fromIntegral h | 108 | let r = fromIntegral w / fromIntegral h |
84 | pad = if r > 1 then (r-1) / 2 else (1/r - 1) / 2 | 109 | pad = if r > 1 then (r-1) / 2 else (1/r - 1) / 2 |
@@ -86,12 +111,11 @@ resize (ResizeEvent w h) = | |||
86 | right = if r > 1 then 1 + pad else 1 | 111 | right = if r > 1 then 1 + pad else 1 |
87 | bottom = if r > 1 then 0 else -pad | 112 | bottom = if r > 1 then 0 else -pad |
88 | top = if r > 1 then 1 else 1 + pad | 113 | top = if r > 1 then 1 else 1 + pad |
89 | in gameIO $ do | 114 | in do |
90 | GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h)) | 115 | gameIO $ setViewport 0 0 w h |
91 | GL.matrixMode $= GL.Projection | 116 | modifyGameState $ \state -> state { |
92 | GL.loadIdentity | 117 | viewProjection = Matrix4.ortho left right bottom top (-1) 1 |
93 | GL.ortho left right bottom top (-1) 1 | 118 | } |
94 | GL.matrixMode $= GL.Modelview 0 | ||
95 | 119 | ||
96 | translateEvents = mapMaybe translateEvents' | 120 | translateEvents = mapMaybe translateEvents' |
97 | where translateEvents' (KeyDown KEY_LEFT) = Just MoveLeft | 121 | where translateEvents' (KeyDown KEY_LEFT) = Just MoveLeft |