Revert "Non effectful renderer"

This reverts commit afe32a1b0d.

rpg/src/Common.hs

@@ -35,13 +35,12 @@ getCamera eff (dimX, dimY) = do
       }
 
 playerMovement
-  :: forall w es r
+  :: forall w es
    . ( AE.ECS w :> es
      , AE.Get w VelocityComponent
-     , Renderer (Eff es) r
+     , Renderer :> es
      )
-  => r
+  => AE.Entity
-  -> AE.Entity
   -> ( RL.KeyboardKey
      , RL.KeyboardKey
      , RL.KeyboardKey
@@ -49,14 +48,14 @@ playerMovement
      )
   -> Float
   -> Eff es ()
-playerMovement renderer player (left, right, up, down) speed = do
+playerMovement player (left, right, up, down) speed = do
   directions <-
     mapM
       (\tuple -> fst tuple <&> (,snd tuple))
-      [ (isKeyDown renderer left, V2 (-1.0) 0)
+      [ (isKeyDown left, V2 (-1.0) 0)
-      , (isKeyDown renderer right, V2 1.0 0)
+      , (isKeyDown right, V2 1.0 0)
-      , (isKeyDown renderer down, V2 0 1.0)
+      , (isKeyDown down, V2 0 1.0)
-      , (isKeyDown renderer up, V2 0 (-1.0))
+      , (isKeyDown up, V2 0 (-1.0))
       ]
   let movement = foldl (+) (V2 0 0) $ map snd $ filter fst directions
   AE.set @w @VelocityComponent player (Velocity (normalize movement * pure speed))

rpg/src/Engine.hs

@@ -54,6 +54,7 @@ instance EngineConstraints where
       , Reads camera RL.Camera2D :> es
       , Reads backgroundColor RL.Color :> es
       , IOE :> es
+      , Renderer :> es
       , AE.ECS w :> es
       )
 
@@ -63,14 +64,11 @@ startEngine
     (backgroundColor :: Symbol)
     (w :: Type)
     es
-    r
    . ( EngineConstraint camera backgroundColor es w
      , Game :> es
-     , Renderer (Eff es) r
      )
-  => r
+  => Eff es ()
-  -> Eff es ()
+startEngine = do
-startEngine renderer = do
   gameInput
   applyVelocity'' @w
 
@@ -82,12 +80,12 @@ startEngine renderer = do
   c <- readVal @camera @RL.Camera2D
   color <- readVal @backgroundColor @RL.Color
 
-  beginFrame renderer c color
+  beginFrame c color
 
   -- getFPS >>= unsafeEff_ . print
 
   AE.cmapM_ @w @(PositionComponent, BoxComponent)
-    (drawSprite renderer)
+    drawSprite
   -- AE.cmapM_
   --   @w
   --   @PositionComponent
@@ -95,7 +93,7 @@ startEngine renderer = do
   --     drawLine (V2 (x - 0.1) (y - 0.1)) (V2 (x + 0.1) (y + 0.1)) RL.red
   --       >> drawLine (V2 (x + 0.1) (y - 0.1)) (V2 (x - 0.1) (y + 0.1)) RL.red
 
-  endFrame renderer
+  endFrame
 
 -- renderBoundingBoxes @w
 -- renderCollision @w

rpg/src/Executables/Minkowski.hs

@@ -116,7 +116,7 @@ readsCamera = do
     (pure camera)
     windowDimensions
 
-runGame :: forall es. (IOE :> es, AE.ECS World :> es, State GameState :> es) => Eff (Game : es) () -> Eff es ()
+runGame :: forall es. (IOE :> es, AE.ECS World :> es, State GameState :> es, Renderer :> es) => Eff (Game : es) () -> Eff es ()
 runGame = interpret \env eff ->
   case eff of
     GameInput -> do
@@ -183,7 +183,8 @@ runGame = interpret \env eff ->
       pure ()
 
 initialize
-  :: Eff es ()
+  :: (Renderer :> es)
+  => Eff es ()
 initialize = do
   pure ()
 
@@ -196,11 +197,11 @@ main' = do
     . runGameState
     . runGameConfig
     $ gets @GameState (\s -> (s ^. windowDimensions . _x, s ^. windowDimensions . _y)) >>= \(dimX, dimY) ->
-      runGame $
+      runRaylibRenderer dimX dimY "App"
-        withRaylibRenderer dimX dimY "App" \renderer ->
+        . runGame
-          initialize >> whileM do
+        $ initialize >> whileM do
-            engineEnv $ startEngine @"state.camera" @"config.backgroundColor" @World renderer
+          engineEnv $ startEngine @"state.camera" @"config.backgroundColor" @World
-            not <$> windowShouldClose renderer
+          not <$> windowShouldClose
  where
   readsBackgroundColor
     :: (Reader GameConfig :> es)

rpg/src/Executables/Pong.hs

@@ -64,23 +64,22 @@ makeLensesFor
   ''GameConfig
 
 playerMovement
-  :: forall w es r
+  :: forall w es
-   . ( Renderer (Eff es) r
+   . ( Renderer :> es
      , AE.Get w PositionComponent
      , AE.Set w VelocityComponent
      , AE.ECS w :> es
      , Reader GameConfig :> es
      )
-  => r
+  => (RL.KeyboardKey, Float)
-  -> (RL.KeyboardKey, Float)
   -> (RL.KeyboardKey, Float)
   -> Eff es AE.Entity
   -> Eff es ()
-playerMovement renderer (up, upSpeed) (down, downSpeed) entity = do
+playerMovement (up, upSpeed) (down, downSpeed) entity = do
   entity' <- entity
 
-  down <- isKeyDown renderer down
+  down <- isKeyDown down
-  up <- isKeyDown renderer up
+  up <- isKeyDown up
   AE.set @w entity' $
     case (down, up) of
       (True, False) -> Velocity $ V2 0 downSpeed
@@ -112,14 +111,13 @@ ballRespawn goal1 goal2 ball = do
   ret
 
 initialise
-  :: ( State GameState :> es
+  :: ( Renderer :> es
+     , State GameState :> es
      , Reader GameConfig :> es
      , AE.ECS World :> es
-     , Renderer (Eff es) r
      )
-  => r
+  => Eff es ()
-  -> Eff es ()
+initialise = do
-initialise renderere = do
   -- setTargetFPS 60
   playArea <- asks @GameConfig (\s -> s.playArea)
 
@@ -237,53 +235,50 @@ pongGame = do
           { playArea = 20
           }
   -- RL.setTraceLogLevel RL.LogWarning
-  withRaylibRenderer gameState.dimX gameState.dimY "App" $ \renderer ->
+  runEff . AE.runECS initWorld . evalState gameState . runReader gameConfig . runRaylibRenderer gameState.dimX gameState.dimY "App" $
-    runEff . AE.runECS initWorld . evalState gameState . runReader gameConfig $
+    initialise >> whileM do
-      initialise renderer >> whileM do
+      playerMovement @World
-        playerMovement @World
+        (RL.KeyW, -0.2)
-          renderer
+        (RL.KeyS, 0.2)
-          (RL.KeyW, -0.2)
+        (gets @GameState (\s -> s.player1))
-          (RL.KeyS, 0.2)
-          (gets @GameState (\s -> s.player1))
 
-        playerMovement @World
+      playerMovement @World
-          renderer
+        (RL.KeyUp, -0.2)
-          (RL.KeyUp, -0.2)
+        (RL.KeyDown, 0.2)
-          (RL.KeyDown, 0.2)
+        (gets @GameState (\s -> s.player2))
-          (gets @GameState (\s -> s.player2))
 
-        -- ballMovement
+      -- ballMovement
-        --   (gets @GameState (\s -> s.player1))
+      --   (gets @GameState (\s -> s.player1))
-        --   (gets @GameState (\s -> s.player2))
+      --   (gets @GameState (\s -> s.player2))
-        --   (gets @GameState (\s -> s.ball))
+      --   (gets @GameState (\s -> s.ball))
-        --   (gets @GameState (\s -> s.bottom))
+      --   (gets @GameState (\s -> s.bottom))
-        --   (gets @GameState (\s -> s.top))
+      --   (gets @GameState (\s -> s.top))
 
-        ballRespawn
+      ballRespawn
-          (gets @GameState (\s -> s.goal2))
+        (gets @GameState (\s -> s.goal2))
-          (gets @GameState (\s -> s.goal1))
+        (gets @GameState (\s -> s.goal1))
-          (gets @GameState (\s -> s.ball))
+        (gets @GameState (\s -> s.ball))
 
-        collisionAABB @World
+      collisionAABB @World
-        applyVelocity'' @World
+      applyVelocity'' @World
-        resolveAABB @World
+      resolveAABB @World
 
-        -- AE.cmapM_ @World @(AE.Entity, PositionComponent, CollisionComponent) \(entity, position, collision) ->
+      -- AE.cmapM_ @World @(AE.Entity, PositionComponent, CollisionComponent) \(entity, position, collision) ->
-        --   when (collision.colliders /= []) $ liftIO $ print (show entity <> " with " <> show collision.colliders <> " at " <> show position)
+      --   when (collision.colliders /= []) $ liftIO $ print (show entity <> " with " <> show collision.colliders <> " at " <> show position)
 
-        score' <- gets @GameState (\s -> s.score)
+      score' <- gets @GameState (\s -> s.score)
-        -- gets @GameState (\s -> s.separator) >>= flip (AE.modify @World @TextBoxComponent) \textBox ->
+      -- gets @GameState (\s -> s.separator) >>= flip (AE.modify @World @TextBoxComponent) \textBox ->
-        --   textBox{text = T.pack $ show score'}
+      --   textBox{text = T.pack $ show score'}
 
-        dims <- gets @GameState (\s -> (s.dimX, s.dimY))
+      dims <- gets @GameState (\s -> (s.dimX, s.dimY))
-        camera <- getCamera @World (gets @GameState (\s -> s.camera)) dims
+      camera <- getCamera @World (gets @GameState (\s -> s.camera)) dims
-        -- getFPS >>= unsafeEff_ . print
+      -- getFPS >>= unsafeEff_ . print
-        beginFrame renderer camera RL.white
+      beginFrame camera RL.white
-        AE.cmapM_ @World @(PositionComponent, BoxComponent) (drawSprite renderer)
+      AE.cmapM_ @World @(PositionComponent, BoxComponent) drawSprite
 
-        -- (gets @GameState (\s -> s.score)) >>= liftIO . print
+      -- (gets @GameState (\s -> s.score)) >>= liftIO . print
 
-        -- render @World
+      -- render @World
-        -- renderOrigins @World
+      -- renderOrigins @World
-        -- renderBoundingBoxes @World
+      -- renderBoundingBoxes @World
-        not <$> windowShouldClose renderer
+      not <$> windowShouldClose

rpg/src/Executables/RPG.hs

@@ -152,15 +152,14 @@ initialise = do
   pure ()
 
 runGame
-  :: forall es r
+  :: forall es
    . ( AE.ECS LocalWorld :> es
+     , Renderer :> es
      , State GameState :> es
-     , Renderer (Eff es) r
      )
-  => r
+  => Eff (Game : es) ()
-  -> Eff (Game : es) ()
   -> Eff es ()
-runGame renderer = interpret \_ eff ->
+runGame = interpret \_ eff ->
   case eff of
     GameInput -> do
       playerEntity <- gets @GameState (\s -> s.playerEntity)
@@ -169,7 +168,6 @@ runGame renderer = interpret \_ eff ->
       --   Nothing -> Tag 0
       -- AE.get @LocalWorld @(TagComponent Int) playerEntity >>= unsafeEff_ . print
       playerMovement @LocalWorld
-        renderer
         playerEntity
         ( RL.KeyA
         , RL.KeyD
@@ -180,8 +178,8 @@ runGame renderer = interpret \_ eff ->
 
       cameraEntity <- gets @GameState (\s -> s.cameraEntity)
 
-      isKeyDown renderer RL.KeyKpAdd >>= flip when (AE.modify @LocalWorld @CameraComponent @CameraComponent cameraEntity (\c -> c{zoom = c.zoom + 1}))
+      isKeyDown RL.KeyKpAdd >>= flip when (AE.modify @LocalWorld @CameraComponent @CameraComponent cameraEntity (\c -> c{zoom = c.zoom + 1}))
-      isKeyDown renderer RL.KeyKpSubtract >>= flip when (AE.modify @LocalWorld @CameraComponent @CameraComponent cameraEntity (\c -> c{zoom = c.zoom - 1}))
+      isKeyDown RL.KeyKpSubtract >>= flip when (AE.modify @LocalWorld @CameraComponent @CameraComponent cameraEntity (\c -> c{zoom = c.zoom - 1}))
       pure ()
     GamePhysics -> pure ()
     GameRendering _ -> do
@@ -209,18 +207,18 @@ main' = do
   print $ perlin 0 0
 
   -- RL.setTraceLogLevel RL.LogWarning
-  withRaylibRenderer gameState.dimX gameState.dimY "App" \renderer ->
+  runEff
-    runEff
+    . AE.runECS initWorld
-      . AE.runECS initWorld
+    . evalState gameState
-      . evalState gameState
+    . runReader gameConfig
-      . runReader gameConfig
+    . runRaylibRenderer gameState.dimX gameState.dimY "App"
-      . runReads @"config.camera" @RL.Camera2D do
+    . runReads @"config.camera" @RL.Camera2D do
-        dims <- gets @GameState (\s -> (s.dimX, s.dimY))
+      dims <- gets @GameState (\s -> (s.dimX, s.dimY))
-        getCamera @LocalWorld (gets @GameState (\s -> s.cameraEntity)) dims
+      getCamera @LocalWorld (gets @GameState (\s -> s.cameraEntity)) dims
-      . runReads @"config.backgroundColor" @RL.Color (pure RL.white)
+    . runReads @"config.backgroundColor" @RL.Color (pure RL.white)
-      . runGame renderer
+    . runGame
-      $ initialise >> whileM do
+    $ initialise >> whileM do
-        startEngine @"config.camera" @"config.backgroundColor" @LocalWorld renderer
+      startEngine @"config.camera" @"config.backgroundColor" @LocalWorld
-        not <$> windowShouldClose renderer
+      not <$> windowShouldClose
 
   pure ()

rpg/src/System/Renderer.hs

@@ -7,15 +7,14 @@
 {-# OPTIONS_GHC -fplugin-opt=Foreign.Storable.Generic.Plugin:-v1 #-}
 {-# OPTIONS_GHC -fplugin=Foreign.Storable.Generic.Plugin #-}
 
-module System.Renderer (Renderer (..), withRaylibRenderer, beginFrame, drawSprite, drawLine, isKeyDown, windowShouldClose, endFrame) where
+module System.Renderer (Renderer (..), runRaylibRenderer, beginFrame, drawSprite, drawLine, isKeyDown, windowShouldClose, endFrame) where
 
 import Apecs.Effectful qualified as AE
 import Control.Lens
 import Control.Monad
-import Control.Monad.Primitive
+import Control.Monad.Primitive (PrimState)
 import Data.IORef
 import Data.Text (Text)
-import Data.Text qualified as T
 import Data.Vector.Storable qualified as VS hiding (unsafeToForeignPtr)
 import Data.Vector.Storable.Mutable qualified as VS
 import Effectful
@@ -34,59 +33,77 @@ import Raylib.Types qualified as RL
 import Raylib.Util.Colors qualified as RL
 import World
 
-class Renderer m a where
+data Renderer :: Effect where
-  beginFrame :: a -> RL.Camera2D -> RL.Color -> m ()
+  BeginFrame :: RL.Camera2D -> RL.Color -> Renderer (Eff es) ()
-  drawSprite :: a -> (PositionComponent, BoxComponent) -> m ()
+  DrawSprite :: (PositionComponent, BoxComponent) -> Renderer (Eff es) ()
-  drawLine :: a -> V2 Float -> V2 Float -> RL.Color -> m ()
+  DrawLine :: V2 Float -> V2 Float -> RL.Color -> Renderer (Eff es) ()
-  windowShouldClose :: a -> m Bool
+  WindowShouldClose :: Renderer (Eff es) Bool
-  isKeyDown :: a -> RL.KeyboardKey -> m Bool
+  IsKeyDown :: RL.KeyboardKey -> Renderer (Eff es) Bool
-  endFrame :: a -> m ()
+  EndFrame :: Renderer (Eff es) ()
+type instance DispatchOf Renderer = Dynamic
+
+beginFrame :: (HasCallStack, Renderer :> es) => RL.Camera2D -> RL.Color -> Eff es ()
+beginFrame camera color = send (BeginFrame camera color)
+
+drawSprite :: (HasCallStack, Renderer :> es) => (PositionComponent, BoxComponent) -> Eff es ()
+drawSprite d = send (DrawSprite d)
+
+drawLine :: (HasCallStack, Renderer :> es) => V2 Float -> V2 Float -> RL.Color -> Eff es ()
+drawLine start end color = send (DrawLine start end color)
+
+windowShouldClose :: (HasCallStack, Renderer :> es) => Eff es Bool
+windowShouldClose = send WindowShouldClose
+
+isKeyDown :: (HasCallStack, Renderer :> es) => RL.KeyboardKey -> Eff es Bool
+isKeyDown key = send (IsKeyDown key)
+
+endFrame :: (HasCallStack, Renderer :> es) => Eff es ()
+endFrame = send EndFrame
 
 data RectangleInfo = RectangleInfo {position :: V2 Float, size :: V2 Float, color :: RL.Color}
   deriving (Generic, GStorable)
 
 foreign import capi safe "raylib_batch.h" draw_rectangles_batch :: Ptr RectangleInfo -> CSize -> IO ()
 
-data RaylibRenderer = RaylibRenderer {indexRef :: IORef Int, vectorRef :: IORef (VS.MVector (PrimState IO) RectangleInfo)}
+runRaylibRenderer :: (IOE :> es) => Int -> Int -> Text -> Eff (Renderer : es) a -> Eff es a
-
+runRaylibRenderer dimX dimY title go = do
-withRaylibRenderer :: forall m a. (MonadIO m) => Int -> Int -> Text -> (RaylibRenderer -> m a) -> m a
+  vectorRef <- liftIO $ VS.new @_ @RectangleInfo 4279 >>= newIORef
-withRaylibRenderer dimX dimY title go = do
-  winRes <- liftIO $ RL.initWindow dimX dimY (T.unpack title)
-  vectorRef <- liftIO (VS.new @_ @RectangleInfo 4279) >>= liftIO . newIORef
   indexRef <-
     liftIO $
       newIORef
         (0 :: Int)
-  go (RaylibRenderer indexRef vectorRef)
+  reinterpret
+    (runRaylibWindow dimX dimY title)
+    ( \_ -> \case
+        BeginFrame camera color -> do
+          liftIO $ RL.getFPS >>= liftIO . print
+          liftIO $ writeIORef indexRef 0
+          liftIO $ RL.beginDrawing
+          liftIO $ RL.clearBackground color
+          liftIO $ RL.beginMode2D camera
+        DrawSprite (Position position, Box{color, offset, size}) -> do
+          vector <- liftIO $ readIORef vectorRef
+          index <- liftIO $ readIORef indexRef
+          liftIO $ VS.write vector index (RectangleInfo position (V2 (size ^. _1) (size ^. _2)) color)
+          liftIO $ writeIORef indexRef (index + 1)
+         where
+          -- liftIO $ RL.drawRectangleV rlPosition rlSize color
 
-instance (MonadIO m) => Renderer m RaylibRenderer where
+          rlPosition = RL.Vector2 (position ^. _x + fst offset - (size ^. _1) / 2) (position ^. _y + snd offset - size ^. _2 / 2)
-  beginFrame (RaylibRenderer{indexRef}) camera color = do
+          rlSize = RL.Vector2 (size ^. _1) (size ^. _2)
-    liftIO $ RL.getFPS >>= liftIO . print
+        DrawLine start end color ->
-    liftIO $ writeIORef indexRef 0
+          liftIO $ RL.drawLineV (RL.Vector2 (start ^. _x) (start ^. _y)) (RL.Vector2 (end ^. _x) (end ^. _y)) color
-    liftIO $ RL.beginDrawing
+        WindowShouldClose -> liftIO RL.windowShouldClose
-    liftIO $ RL.clearBackground color
+        IsKeyDown key -> liftIO $ RL.isKeyDown key
-    liftIO $ RL.beginMode2D camera
+        EndFrame -> do
-  drawSprite (RaylibRenderer{indexRef, vectorRef}) (Position position, Box{color, offset, size}) = do
+          vector <- liftIO $ readIORef vectorRef
-    vector <- liftIO $ readIORef vectorRef
+          index <- liftIO $ readIORef indexRef
-    index <- liftIO $ readIORef indexRef
+          let (fptr, offset, length) = (VS.unsafeToForeignPtr vector)
-    liftIO $ VS.write vector index (RectangleInfo position (V2 (size ^. _1) (size ^. _2)) color)
+          liftIO $ withForeignPtr fptr \ptr -> draw_rectangles_batch (plusPtr ptr offset) (fromIntegral length)
-    liftIO $ writeIORef indexRef (index + 1)
+          liftIO RL.endMode2D
-   where
+          liftIO RL.endDrawing
-    -- liftIO $ RL.drawRectangleV rlPosition rlSize color
+    )
-
+    go
-    rlPosition = RL.Vector2 (position ^. _x + fst offset - (size ^. _1) / 2) (position ^. _y + snd offset - size ^. _2 / 2)
-    rlSize = RL.Vector2 (size ^. _1) (size ^. _2)
-  drawLine (RaylibRenderer{}) start end color =
-    liftIO $ RL.drawLineV (RL.Vector2 (start ^. _x) (start ^. _y)) (RL.Vector2 (end ^. _x) (end ^. _y)) color
-  windowShouldClose _ = liftIO RL.windowShouldClose
-  isKeyDown _ key = liftIO $ RL.isKeyDown key
-  endFrame (RaylibRenderer{vectorRef, indexRef}) = do
-    vector <- liftIO $ readIORef vectorRef
-    index <- liftIO $ readIORef indexRef
-    let (fptr, offset, length) = (VS.unsafeToForeignPtr vector)
-    liftIO $ withForeignPtr fptr \ptr -> draw_rectangles_batch (plusPtr ptr offset) (fromIntegral length)
-    liftIO RL.endMode2D
-    liftIO RL.endDrawing
 
 -- render
 --   :: forall w es