aboutsummaryrefslogtreecommitdiff
path: root/Demos/Pong/Main.hs
diff options
context:
space:
mode:
author3gg <3gg@shellblade.net>2023-10-02 09:03:53 -0700
committer3gg <3gg@shellblade.net>2023-10-02 09:03:53 -0700
commit9209a05d5d61458bf63af1f4b14c03dee934112a (patch)
tree1ea32832ffb860c6495f80c9aaefc282509278ad /Demos/Pong/Main.hs
parentdf04706413ca2bba4017c5b2d19bc992aa985110 (diff)
First pass at render backend.
Diffstat (limited to 'Demos/Pong/Main.hs')
-rw-r--r--Demos/Pong/Main.hs110
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 @@
1module Main where 1module Main where
2 2
3import Data.Maybe (mapMaybe)
4import Graphics.Rendering.OpenGL.GL (($=))
5import qualified Graphics.Rendering.OpenGL.GL as GL
6import Graphics.Rendering.OpenGL.GL.VertexSpec (currentColor)
7import Pong 3import Pong
4
8import Spear.App 5import Spear.App
9import Spear.Game 6import Spear.Game
10import Spear.Math.AABB 7import Spear.Math.AABB
8import Spear.Math.Matrix4 as Matrix4 hiding
9 (position)
11import Spear.Math.Spatial 10import Spear.Math.Spatial
12import Spear.Math.Spatial2 11import Spear.Math.Spatial2
13import Spear.Math.Vector 12import Spear.Math.Vector
13import Spear.Render.Core.Pipeline
14import Spear.Render.Core.State
15import Spear.Render.Immediate
14import Spear.Window 16import Spear.Window
15 17
18import Data.Maybe (mapMaybe)
19import Graphics.Rendering.OpenGL.GL (($=))
20import qualified Graphics.Rendering.OpenGL.GL as GL
21import Graphics.Rendering.OpenGL.GL.VertexSpec (currentColor)
22
23
16data GameState = GameState 24data 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
21app = App step render resize 32app = App step render resize
22 33
23main = 34main =
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
27initGame :: Window -> Game () GameState 38initGame :: Window -> Game () GameState
28initGame window = return $ GameState window newWorld 39initGame window = do
40 (immRenderState, renderCoreState) <- runSiblingGame newImmRenderer newRenderCoreState
41 return $ GameState window renderCoreState immRenderState Matrix4.id newWorld
42
43endGame :: Game GameState ()
44endGame = do
45 game <- getGameState
46 runSubGame' (deleteImmRenderer $ immRenderState game) (renderCoreState game)
29 47
30step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool 48step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool
31step elapsed dt inputEvents = do 49step 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
40render :: Game GameState () 58render :: Game GameState ()
41render = getGameState >>= \gs -> gameIO . render' $ world gs 59render = 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
43render' :: [GameObject] -> IO () 73render' :: [GameObject] -> Game ImmRenderState ()
44render' world = do 74render' 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
56renderBackground :: IO () 81renderBackground :: Game ImmRenderState ()
57renderBackground = 82renderBackground =
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
68renderGO :: GameObject -> IO () 93renderGO :: GameObject -> Game ImmRenderState ()
69renderGO go = do 94renderGO 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.
81resize :: WindowEvent -> Game s () 106resize :: WindowEvent -> Game GameState ()
82resize (ResizeEvent w h) = 107resize (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
96translateEvents = mapMaybe translateEvents' 120translateEvents = mapMaybe translateEvents'
97 where translateEvents' (KeyDown KEY_LEFT) = Just MoveLeft 121 where translateEvents' (KeyDown KEY_LEFT) = Just MoveLeft