From 9209a05d5d61458bf63af1f4b14c03dee934112a Mon Sep 17 00:00:00 2001 From: 3gg <3gg@shellblade.net> Date: Mon, 2 Oct 2023 09:03:53 -0700 Subject: First pass at render backend. --- Demos/Pong/Main.hs | 110 ++++++++++++++++++++++++++++++++--------------------- 1 file changed, 67 insertions(+), 43 deletions(-) (limited to 'Demos/Pong/Main.hs') 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 @@ module Main where -import Data.Maybe (mapMaybe) -import Graphics.Rendering.OpenGL.GL (($=)) -import qualified Graphics.Rendering.OpenGL.GL as GL -import Graphics.Rendering.OpenGL.GL.VertexSpec (currentColor) import Pong + import Spear.App import Spear.Game import Spear.Math.AABB +import Spear.Math.Matrix4 as Matrix4 hiding + (position) import Spear.Math.Spatial import Spear.Math.Spatial2 import Spear.Math.Vector +import Spear.Render.Core.Pipeline +import Spear.Render.Core.State +import Spear.Render.Immediate import Spear.Window +import Data.Maybe (mapMaybe) +import Graphics.Rendering.OpenGL.GL (($=)) +import qualified Graphics.Rendering.OpenGL.GL as GL +import Graphics.Rendering.OpenGL.GL.VertexSpec (currentColor) + + data GameState = GameState - { window :: Window, - world :: [GameObject] + { window :: Window + , renderCoreState :: RenderCoreState + , immRenderState :: ImmRenderState + , viewProjection :: Matrix4 + , world :: [GameObject] } app = App step render resize main = - withWindow (900, 600) (2, 0) (Just "Pong") initGame $ + withWindow (900, 600) (Just "Pong") initGame endGame $ loop app initGame :: Window -> Game () GameState -initGame window = return $ GameState window newWorld +initGame window = do + (immRenderState, renderCoreState) <- runSiblingGame newImmRenderer newRenderCoreState + return $ GameState window renderCoreState immRenderState Matrix4.id newWorld + +endGame :: Game GameState () +endGame = do + game <- getGameState + runSubGame' (deleteImmRenderer $ immRenderState game) (renderCoreState game) step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool step elapsed dt inputEvents = do @@ -38,47 +56,54 @@ step elapsed dt inputEvents = do return (not $ exitRequested inputEvents) render :: Game GameState () -render = getGameState >>= \gs -> gameIO . render' $ world gs +render = do + gameState <- getGameState + immRenderState' <- flip execSubGame (immRenderState gameState) $ do + immStart + immSetViewProjectionMatrix (viewProjection gameState) + -- Clear the background to a different colour than the playable area to make + -- the latter distinguishable. + gameIO $ do + setClearColour (0.2, 0.2, 0.2, 0.0) + clearBuffers [ColourBuffer] + render' $ world gameState + immEnd + saveGameState $ gameState { immRenderState = immRenderState' } -render' :: [GameObject] -> IO () +render' :: [GameObject] -> Game ImmRenderState () render' world = do - -- Clear the background to a different colour than the playable area to make - -- the latter distinguishable. - GL.clearColor $= GL.Color4 0.2 0.2 0.2 0.0 - GL.clear [GL.ColorBuffer] - GL.matrixMode $= GL.Modelview 0 - GL.loadIdentity + immLoadIdentity renderBackground -- Draw objects. - GL.currentColor $= GL.Color4 1.0 1.0 1.0 1.0 + immSetColour (vec4 1.0 1.0 1.0 1.0) mapM_ renderGO world -renderBackground :: IO () +renderBackground :: Game ImmRenderState () renderBackground = let pmin = 0 :: Float pmax = 1 :: Float in do - GL.currentColor $= GL.Color4 0.7 0.5 0.7 1.0 - GL.renderPrimitive GL.TriangleStrip $ do - GL.vertex (GL.Vertex2 pmin pmax) - GL.vertex (GL.Vertex2 pmin pmin) - GL.vertex (GL.Vertex2 pmax pmax) - GL.vertex (GL.Vertex2 pmax pmin) - -renderGO :: GameObject -> IO () + immSetColour (vec4 0.6 0.35 0.6 1.0) + immDrawQuads2d [ + (vec2 pmin pmin + ,vec2 pmax pmin + ,vec2 pmax pmax + ,vec2 pmin pmax)] + +renderGO :: GameObject -> Game ImmRenderState () renderGO go = do - let (AABB2 (Vector2 xmin' ymin') (Vector2 xmax' ymax')) = aabb go + let (AABB2 (Vector2 xmin ymin) (Vector2 xmax ymax)) = aabb go (Vector2 xcenter ycenter) = position go - (xmin, ymin, xmax, ymax) = (f2d xmin', f2d ymin', f2d xmax', f2d ymax') - GL.preservingMatrix $ do - GL.translate (GL.Vector3 (f2d xcenter) (f2d ycenter) 0) - GL.renderPrimitive GL.TriangleStrip $ do - GL.vertex (GL.Vertex2 xmin ymax) - GL.vertex (GL.Vertex2 xmin ymin) - GL.vertex (GL.Vertex2 xmax ymax) - GL.vertex (GL.Vertex2 xmax ymin) - -resize :: WindowEvent -> Game s () + immPreservingMatrix $ do + immTranslate (vec3 xcenter ycenter 0) + immDrawQuads2d [ + (vec2 xmin ymin + ,vec2 xmax ymin + ,vec2 xmax ymax + ,vec2 xmin ymax)] + +-- TODO: Fix the resize hang. +resize :: WindowEvent -> Game GameState () resize (ResizeEvent w h) = let r = fromIntegral w / fromIntegral h pad = if r > 1 then (r-1) / 2 else (1/r - 1) / 2 @@ -86,12 +111,11 @@ resize (ResizeEvent w h) = right = if r > 1 then 1 + pad else 1 bottom = if r > 1 then 0 else -pad top = if r > 1 then 1 else 1 + pad - in gameIO $ do - GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h)) - GL.matrixMode $= GL.Projection - GL.loadIdentity - GL.ortho left right bottom top (-1) 1 - GL.matrixMode $= GL.Modelview 0 + in do + gameIO $ setViewport 0 0 w h + modifyGameState $ \state -> state { + viewProjection = Matrix4.ortho left right bottom top (-1) 1 + } translateEvents = mapMaybe translateEvents' where translateEvents' (KeyDown KEY_LEFT) = Just MoveLeft -- cgit v1.2.3