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')

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