105 fps +-

Signed-off-by: magic_rb <richard@brezak.sk>
2024-11-21 23:34:21 +01:00 · 2024-01-26 20:17:53 +01:00 · 2024-01-26 20:17:53 +01:00 · 2972b5b048
parent 885bf8943b
commit 2972b5b048
15 changed files with 343 additions and 225 deletions
--- a/flake.nix
+++ b/flake.nix
@ -41,6 +41,7 @@
                    hPkgs.ghc
                    hPkgs.implicit-hie
                    hPkgs.haskell-language-server
+                    hPkgs.profiterole
                    SDL2
                    SDL2_image
                    libtiff
--- a/rpg/cbits/raylib_batch.c
+++ b/rpg/cbits/raylib_batch.c
@ -0,0 +1,7 @@
+#include "raylib_batch.h"
+
+void draw_rectangles_batch(const rectangle_info_t* rectangles, size_t count) {
+  for (size_t i = 0; i < count; i++) {
+    DrawRectangleV(rectangles[i].position, rectangles[i].size, rectangles[i].color);
+  }
+}
--- a/rpg/cbits/raylib_batch.h
+++ b/rpg/cbits/raylib_batch.h
@ -0,0 +1,10 @@
+#include <raylib.h>
+#include <stddef.h>
+
+typedef struct rectangle_info {
+  Vector2 position;
+  Vector2 size;
+  Color color;
+} rectangle_info_t;
+
+void draw_rectangles_batch(const rectangle_info_t* rectangles, size_t count);
--- a/rpg/package.yaml
+++ b/rpg/package.yaml
@ -38,6 +38,8 @@ dependencies:
 - containers
 - GLFW-b
 - OpenGL
+- derive-storable
+- derive-storable-plugin

 language: GHC2021
 default-extensions:
@ -62,6 +64,8 @@ ghc-options:

 library:
  source-dirs: src
+  c-sources: cbits/*.c
+  include-dirs: cbits

 executables:
  rpg-exe:
--- a/rpg/rpg.cabal
+++ b/rpg/rpg.cabal
@ -65,6 +65,10 @@ library
      TemplateHaskell
      LambdaCase
  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
+  include-dirs:
+      cbits
+  c-sources:
+      cbits/raylib_batch.c
  build-depends:
      GLFW-b
    , OpenGL
@ -73,6 +77,8 @@ library
    , base >=4.7 && <5
    , bytestring
    , containers
+    , derive-storable
+    , derive-storable-plugin
    , effectful
    , effectful-core
    , extra
@ -111,6 +117,8 @@ executable minkowski
    , base >=4.7 && <5
    , bytestring
    , containers
+    , derive-storable
+    , derive-storable-plugin
    , effectful
    , effectful-core
    , extra
@ -150,6 +158,8 @@ executable pong
    , base >=4.7 && <5
    , bytestring
    , containers
+    , derive-storable
+    , derive-storable-plugin
    , effectful
    , effectful-core
    , extra
@ -189,6 +199,8 @@ executable rpg-exe
    , base >=4.7 && <5
    , bytestring
    , containers
+    , derive-storable
+    , derive-storable-plugin
    , effectful
    , effectful-core
    , extra
@ -229,6 +241,8 @@ test-suite rpg-test
    , base >=4.7 && <5
    , bytestring
    , containers
+    , derive-storable
+    , derive-storable-plugin
    , effectful
    , effectful-core
    , extra
--- a/rpg/rpg/Main.hs
+++ b/rpg/rpg/Main.hs
@ -2,4 +2,4 @@ module Main where

 import Executables.RPG

-main = runGame
+main = main'
--- a/rpg/src/Common.hs
+++ b/rpg/src/Common.hs
@ -5,11 +5,11 @@ module Common (getCamera, playerMovement) where
 import Apecs.Effectful qualified as AE
 import Control.Lens
 import Effectful
-import Effectful.Raylib
 import GHC.Float
 import Linear (normalize)
 import Linear.V2
 import Raylib.Types qualified as RL
+import System.Renderer
 import World

 getCamera
@ -36,9 +36,9 @@ getCamera eff (dimX, dimY) = do

 playerMovement
  :: forall w es
-   . ( Raylib :> es
-     , AE.ECS w :> es
+   . ( AE.ECS w :> es
     , AE.Get w VelocityComponent
+     , Renderer :> es
     )
  => AE.Entity
  -> ( RL.KeyboardKey
--- a/rpg/src/Effectful/Raylib.hs
+++ b/rpg/src/Effectful/Raylib.hs
@ -108,11 +108,11 @@ drawRectangle posX posY width height color = send (DrawRectangle posX posY width
 drawLine :: (HasCallStack, RaylibDraw2D :> es) => Float -> Float -> Float -> Float -> RL.Color -> Eff es ()
 drawLine posX posY endX endY color = send (DrawLine posX posY endX endY color)

-runRaylibWindow :: (IOE :> es) => Int -> Int -> Text -> Eff (Raylib : es) () -> Eff es ()
+runRaylibWindow :: (IOE :> es) => Int -> Int -> Text -> Eff (Raylib : es) a -> Eff es a
 runRaylibWindow width height name effect = do
  window <- liftIO $ RL.initWindow width height (T.unpack name)

-  interpret' effect $ \env eff -> localSeqUnlift env \unlift ->
+  res <- interpret' effect $ \env eff -> localSeqUnlift env \unlift ->
    case eff of
      WindowShouldClose -> liftIO RL.windowShouldClose
      GetFontDefault -> liftIO RL.getFontDefault
@ -129,6 +129,7 @@ runRaylibWindow width height name effect = do
      GetFPS -> liftIO RL.getFPS

  liftIO $ RL.closeWindow window
+  pure res
 where
  runRaylibDrawing :: (IOE :> es) => Eff (RaylibDraw : es) a -> Eff es a
  runRaylibDrawing effect' = do
--- a/rpg/src/Engine.hs
+++ b/rpg/src/Engine.hs
@ -3,7 +3,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}

-module Engine (Engine (..), engineInput, enginePhysics, engineRendering, initialEngine, EngineConstraint, startEngine) where
+module Engine (Game (..), EngineConstraint, startEngine) where

 import Apecs.Effectful qualified as AE
 import Data.Kind
@ -12,33 +12,32 @@ import Effectful.Accessor
 import Effectful.Dispatch.Dynamic
 import Effectful.Dispatch.Static
 import Effectful.Internal.Monad
-import Effectful.Raylib
+import Effectful.Raylib hiding (drawLine)
 import GHC.Exts
+import Linear.V2
 import Raylib.Types qualified as RL
+import Raylib.Util.Colors qualified as RL
 import System.Physics
 import System.Renderer
 import World

-data EngineOps es = EngineOps
-  { input :: Eff es ()
-  , physics :: Eff es ()
-  , rendering :: Eff es ()
-  }
+data Game :: Effect where
+  GameInput :: Game (Eff es) ()
+  GamePhysics :: Game (Eff es) ()
+  GameRendering :: (SharedSuffix es2 es, RaylibDraw :> es2, RaylibDraw2D :> es2) => (forall r. Eff es2 r -> Eff es r) -> Game (Eff es) ()
+type instance DispatchOf Game = Dynamic

-data Engine :: Effect where
-  EngineInput :: Engine (Eff es) ()
-  EnginePhysics :: Engine (Eff es) ()
-  EngineRendering :: (SharedSuffix es2 es, RaylibDraw :> es2, RaylibDraw2D :> es2) => (forall r. Eff es2 r -> Eff es r) -> Engine (Eff es) ()
-type instance DispatchOf Engine = Dynamic
+data Engine :: Effect
+type instance DispatchOf Engine = Static WithSideEffects

-engineInput :: (HasCallStack, Engine :> es) => Eff es ()
-engineInput = send EngineInput
+gameInput :: (HasCallStack, Game :> es) => Eff es ()
+gameInput = send GameInput

-enginePhysics :: (HasCallStack, Engine :> es) => Eff es ()
-enginePhysics = send EnginePhysics
+gamePhysics :: (HasCallStack, Game :> es) => Eff es ()
+gamePhysics = send GamePhysics

-engineRendering :: forall es. (HasCallStack, Engine :> es, SharedSuffix es es, RaylibDraw :> es, RaylibDraw2D :> es) => Eff es ()
-engineRendering = unsafeEff $ \env -> (`unEff` env) $ localSeqUnlift @_ @es (LocalEnv env) (\unlift -> send $ EngineRendering unlift)
+gameRendering :: forall es. (HasCallStack, Game :> es, SharedSuffix es es, RaylibDraw :> es, RaylibDraw2D :> es) => Eff es ()
+gameRendering = unsafeEff $ \env -> (`unEff` env) $ localSeqUnlift @_ @es (LocalEnv env) (\unlift -> send $ GameRendering unlift)

 class EngineConstraints where
  type EngineConstraint (camera :: Symbol) (backgroundColor :: Symbol) (es :: [Effect]) (w :: Type) :: Constraint
@ -55,41 +54,10 @@ instance EngineConstraints where
      , Reads camera RL.Camera2D :> es
      , Reads backgroundColor RL.Color :> es
      , IOE :> es
-      , Raylib :> es
+      , Renderer :> es
      , AE.ECS w :> es
      )

-initialEngine
-  :: forall (es :: [Effect])
-   . EngineOps es
-initialEngine =
-  EngineOps
-    { input = pure ()
-    , physics = pure ()
-    , rendering = pure ()
-    }
-
-- inlineBracket
--     (consEnv e dummyRelinker es0)
--     unconsEnv
--     (\es -> unEff m es)
-
-injectEngine :: forall xs ys. (Subset xs ys) => EngineOps xs -> EngineOps ys
-injectEngine engine =
-  EngineOps
-    { input = inject engine.input
-    , physics = inject engine.physics
-    , rendering = inject engine.rendering
-    }
-
-raiseEngine :: forall e es. EngineOps es -> EngineOps (e : es)
-raiseEngine engine =
-  EngineOps
-    { input = raise engine.input
-    , physics = raise engine.physics
-    , rendering = raise engine.rendering
-    }
-
 startEngine
  :: forall
    (camera :: Symbol)
@ -97,29 +65,37 @@ startEngine
    (w :: Type)
    es
   . ( EngineConstraint camera backgroundColor es w
-     , Engine :> es
+     , Game :> es
     )
  => Eff es ()
 startEngine = do
-  engineInput
+  gameInput
  applyVelocity'' @w

  -- collisionAABB @w
  -- resolveAABB @w

-  enginePhysics
+  gamePhysics

  c <- readVal @camera @RL.Camera2D
-
-  runDraw . runDraw2D c $ do
  color <- readVal @backgroundColor @RL.Color
-    clearBackground color

-    getFPS >>= unsafeEff_ . print
+  beginFrame c color

-    render @w
-    -- renderOrigins @w
-    -- renderBoundingBoxes @w
-    -- renderCollision @w
+  -- getFPS >>= unsafeEff_ . print

-    engineRendering
+  AE.cmapM_ @w @(PositionComponent, BoxComponent)
+    drawSprite
+  -- AE.cmapM_
+  --   @w
+  --   @PositionComponent
+  --   \(Position (V2 x y)) ->
+  --     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
+
+-- renderBoundingBoxes @w
+-- renderCollision @w
+
+-- gameRendering
--- a/rpg/src/Executables/Minkowski.hs
+++ b/rpg/src/Executables/Minkowski.hs
@ -13,8 +13,8 @@ import Data.Maybe (isJust)
 import Effectful
 import Effectful.Accessor
 import Effectful.Dispatch.Dynamic
-import Effectful.Raylib
-import Effectful.Raylib qualified as RL
+import Effectful.Raylib hiding (windowShouldClose)
+import Effectful.Raylib qualified as RL hiding (windowShouldClose)
 import Effectful.Reader.Static
 import Effectful.State.Static.Local
 import Effectful.State.Static.Local.Lens
@ -24,6 +24,7 @@ import Linear.V2 (V2 (..), _x, _y)
 import Raylib.Types qualified as RL
 import Raylib.Util.Colors qualified as RL
 import System.Physics
+import System.Renderer
 import World

 data GameState = GameState
@ -115,50 +116,51 @@ readsCamera = do
    (pure camera)
    windowDimensions

-runEngine :: forall es. (IOE :> es, AE.ECS World :> es, State GameState :> es, Raylib :> es) => Eff (Engine : es) () -> Eff es ()
-runEngine = interpret \env eff ->
+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
-    EngineInput -> do
+    GameInput -> do
      camera <- readsCamera
-      pos <- getMousePosition >>= \pos -> getScreenToWorld2D pos camera
+      pure ()
+    -- pos <- getMousePosition >>= \pos -> getScreenToWorld2D pos camera

-      isMouseButtonPressed RL.MouseButtonLeft >>= \case
-        True -> do
-          AE.cfold @World @(AE.Entity, PositionComponent, AABBComponent)
-            (\acc (entity, position, aabb) -> (pointCollides pos position aabb <&> (,entity)) : acc)
-            []
-            <&> filter isJust
-            >>= \case
-              Just (offset, entity) : _ -> selectedBox .= Just (offset, entity)
-              _ -> pure ()
-        False -> pure ()
-      isMouseButtonReleased RL.MouseButtonLeft >>= \case
-        True -> do
-          selectedBox' <- gets @GameState \s -> s.selectedBox
-          case selectedBox' of
-            Just (_, boxEntity) ->
-              AE.set @World @VelocityComponent boxEntity (Velocity $ V2 0 0)
-            Nothing -> pure ()
-          selectedBox .= Nothing
-        False -> pure ()
+    -- isMouseButtonPressed RL.MouseButtonLeft >>= \case
+    --   True -> do
+    --     AE.cfold @World @(AE.Entity, PositionComponent, AABBComponent)
+    --       (\acc (entity, position, aabb) -> (pointCollides pos position aabb <&> (,entity)) : acc)
+    --       []
+    --       <&> filter isJust
+    --       >>= \case
+    --         Just (offset, entity) : _ -> selectedBox .= Just (offset, entity)
+    --         _ -> pure ()
+    --   False -> pure ()
+    -- isMouseButtonReleased RL.MouseButtonLeft >>= \case
+    --   True -> do
+    --     selectedBox' <- gets @GameState \s -> s.selectedBox
+    --     case selectedBox' of
+    --       Just (_, boxEntity) ->
+    --         AE.set @World @VelocityComponent boxEntity (Velocity $ V2 0 0)
+    --       Nothing -> pure ()
+    --     selectedBox .= Nothing
+    --   False -> pure ()

-      box <- gets @GameState \s -> s.selectedBox
-      (box1, box2) <- gets @GameState \s -> s.boxes
-      box1' <- AE.get @World @(PositionComponent, AABBComponent) box1
-      box2' <- AE.get @World @(PositionComponent, AABBComponent) box2
-      minkowski' <- gets @GameState \s -> s.minkowski
+    -- box <- gets @GameState \s -> s.selectedBox
+    -- (box1, box2) <- gets @GameState \s -> s.boxes
+    -- box1' <- AE.get @World @(PositionComponent, AABBComponent) box1
+    -- box2' <- AE.get @World @(PositionComponent, AABBComponent) box2
+    -- minkowski' <- gets @GameState \s -> s.minkowski

-      case box of
-        Just (_, box') -> do
-          Position bpos <- AE.get @World @PositionComponent box'
-          let offset = pos - bpos
-          let (mpos, maabb) = aabbFromBounds (minkowskiDifference box1' box2') (V2 0 0)
+    -- case box of
+    --   Just (_, box') -> do
+    --     Position bpos <- AE.get @World @PositionComponent box'
+    --     let offset = pos - bpos
+    --     let (mpos, maabb) = aabbFromBounds (minkowskiDifference box1' box2') (V2 0 0)

-          AE.set @World minkowski' (mpos, maabb)
-          AE.set @World box' (Velocity $ V2 (offset ^. _x) (offset ^. _y))
-        Nothing -> pure ()
-    EnginePhysics -> pure ()
-    EngineRendering unlift' -> do
+    --     AE.set @World minkowski' (mpos, maabb)
+    --     AE.set @World box' (Velocity $ V2 (offset ^. _x) (offset ^. _y))
+    --   Nothing -> pure ()
+    GamePhysics -> pure ()
+    GameRendering unlift' -> do
      (box1, box2) <- gets @GameState \s -> s.boxes
      box1Position <- AE.get @World @PositionComponent box1
      (box2Position, box2AABB) <- AE.get @World @(PositionComponent, AABBComponent) box2
@ -181,10 +183,12 @@ runEngine = interpret \env eff ->
      pure ()

 initialize
-  :: (Raylib :> es)
+  :: (Renderer :> es)
  => Eff es ()
 initialize = do
-  setTargetFPS 60
+  pure ()
+
+-- setTargetFPS 60

 main' :: IO ()
 main' = do
@ -193,8 +197,8 @@ main' = do
    . runGameState
    . runGameConfig
    $ gets @GameState (\s -> (s ^. windowDimensions . _x, s ^. windowDimensions . _y)) >>= \(dimX, dimY) ->
-      runRaylibWindow dimX dimY "App"
-        . runEngine
+      runRaylibRenderer dimX dimY "App"
+        . runGame
        $ initialize >> whileM do
          engineEnv $ startEngine @"state.camera" @"config.backgroundColor" @World
          not <$> windowShouldClose
--- a/rpg/src/Executables/Pong.hs
+++ b/rpg/src/Executables/Pong.hs
@ -9,7 +9,7 @@ import Control.Monad.Extra
 import Data.Text qualified as T
 import Effectful
 import Effectful.Dispatch.Static
-import Effectful.Raylib
+import Effectful.Raylib hiding (isKeyDown, windowShouldClose)
 import Effectful.Reader.Static
 import Effectful.State.Static.Local
 import Effectful.State.Static.Local.Lens
@ -65,7 +65,7 @@ makeLensesFor

 playerMovement
  :: forall w es
-   . ( Raylib :> es
+   . ( Renderer :> es
     , AE.Get w PositionComponent
     , AE.Set w VelocityComponent
     , AE.ECS w :> es
@ -111,14 +111,14 @@ ballRespawn goal1 goal2 ball = do
  ret

 initialise
-  :: ( Raylib :> es
+  :: ( Renderer :> es
     , State GameState :> es
     , Reader GameConfig :> es
     , AE.ECS World :> es
     )
  => Eff es ()
 initialise = do
-  setTargetFPS 60
+  -- setTargetFPS 60
  playArea <- asks @GameConfig (\s -> s.playArea)

  cameraEntity <-
@ -202,14 +202,14 @@ initialise = do
  topBorder .= topEntity
  bottomBorder .= bottomEntity

-  font <- getFontDefault
-  separatorEntity <-
-    AE.newEntity @World
-      ( Position $ V2 0 0
-      , Box RL.darkGray (0, 0) (0.1, int2Float playArea)
-      , TextBox font "" 3 0.1 RL.darkGray
-      )
-  separator .= separatorEntity
+  -- font <- getFontDefault
+  -- separatorEntity <-
+  --   AE.newEntity @World
+  --     ( Position $ V2 0 0
+  --     , Box RL.darkGray (0, 0) (0.1, int2Float playArea)
+  --     , TextBox font "" 3 0.1 RL.darkGray
+  --     )
+  -- separator .= separatorEntity

  pure ()

@ -235,7 +235,7 @@ pongGame = do
          { playArea = 20
          }
  -- RL.setTraceLogLevel RL.LogWarning
-  runEff . AE.runECS initWorld . evalState gameState . runReader gameConfig . runRaylibWindow gameState.dimX gameState.dimY "App" $
+  runEff . AE.runECS initWorld . evalState gameState . runReader gameConfig . runRaylibRenderer gameState.dimX gameState.dimY "App" $
    initialise >> whileM do
      playerMovement @World
        (RL.KeyW, -0.2)
@ -267,18 +267,18 @@ pongGame = do
      --   when (collision.colliders /= []) $ liftIO $ print (show entity <> " with " <> show collision.colliders <> " at " <> show position)

      score' <- gets @GameState (\s -> s.score)
-      gets @GameState (\s -> s.separator) >>= flip (AE.modify @World @TextBoxComponent) \textBox ->
-        textBox{text = T.pack $ show score'}
+      -- gets @GameState (\s -> s.separator) >>= flip (AE.modify @World @TextBoxComponent) \textBox ->
+      --   textBox{text = T.pack $ show score'}

      dims <- gets @GameState (\s -> (s.dimX, s.dimY))
      camera <- getCamera @World (gets @GameState (\s -> s.camera)) dims
-      getFPS >>= unsafeEff_ . print
-      runDraw . runDraw2D camera $ do
-        clearBackground RL.gray
+      -- getFPS >>= unsafeEff_ . print
+      beginFrame camera RL.white
+      AE.cmapM_ @World @(PositionComponent, BoxComponent) drawSprite

      -- (gets @GameState (\s -> s.score)) >>= liftIO . print

-        render @World
-        renderOrigins @World
-        renderBoundingBoxes @World
+      -- render @World
+      -- renderOrigins @World
+      -- renderBoundingBoxes @World
      not <$> windowShouldClose
--- a/rpg/src/Executables/RPG.hs
+++ b/rpg/src/Executables/RPG.hs
@ -14,7 +14,7 @@
 {-# LANGUAGE UndecidableInstances #-}

 module Executables.RPG (
-  runGame,
+  main',
 ) where

 import Apecs.Effectful qualified as AE
@ -30,7 +30,7 @@ import Effectful
 import Effectful.Accessor
 import Effectful.Dispatch.Dynamic
 import Effectful.Dispatch.Static
-import Effectful.Raylib
+import Effectful.Raylib hiding (isKeyDown, windowShouldClose)
 import Effectful.Reader.Dynamic
 import Effectful.State.Static.Local
 import Effectful.State.Static.Local.Lens
@ -38,9 +38,9 @@ import Engine
 import GHC.Float (float2Int, floorFloat)
 import Linear.V2
 import Noise.Perlin
-import Raylib.Core qualified as RL
 import Raylib.Types qualified as RL
 import Raylib.Util.Colors qualified as RL
+import System.Renderer
 import World

 type LocalWorld = World
@ -83,7 +83,7 @@ spawnPlayer color =
    )

 spawnBox
-  :: (AE.ECS LocalWorld :> es, Raylib :> es)
+  :: (AE.ECS LocalWorld :> es)
  => (Float, Float)
  -> RL.Color
  -> (Float, Float)
@ -96,18 +96,17 @@ spawnBox (posx, posy) color size = do
      , Body 0.0 0.0 True
      , AABB (V2 1 1) (V2 0 0)
      )
-  font <- getFontDefault
-  AE.set @LocalWorld entity (TextBox font (T.pack $ show (AE.unEntity entity)) 0.3 0.1 RL.yellow)
+  -- font <- getFontDefault
+  -- AE.set @LocalWorld entity (TextBox font (T.pack $ show (AE.unEntity entity)) 0.3 0.1 RL.yellow)
  pure entity

 initialise
-  :: ( Raylib :> es
-     , State GameState :> es
+  :: ( State GameState :> es
     , AE.ECS LocalWorld :> es
     )
  => Eff es ()
 initialise = do
-  setTargetFPS 60
+  -- setTargetFPS 60

  forM_ [-32 .. 32] \x -> do
    forM_ [-32 .. 32] \y -> do
@ -152,17 +151,17 @@ initialise = do

  pure ()

-runEngine
+runGame
  :: forall es
   . ( AE.ECS LocalWorld :> es
-     , Raylib :> es
+     , Renderer :> es
     , State GameState :> es
     )
-  => Eff (Engine : es) ()
+  => Eff (Game : es) ()
  -> Eff es ()
-runEngine = interpret \_ eff ->
+runGame = interpret \_ eff ->
  case eff of
-    EngineInput -> do
+    GameInput -> do
      playerEntity <- gets @GameState (\s -> s.playerEntity)
      -- AE.modify @LocalWorld @(Maybe (TagComponent Int)) @(TagComponent Int) playerEntity \case
      --   Just (Tag n) -> Tag (n + 1)
@ -182,15 +181,15 @@ runEngine = interpret \_ eff ->
      isKeyDown RL.KeyKpAdd >>= 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 ()
-    EnginePhysics -> pure ()
-    EngineRendering _ -> do
+    GamePhysics -> pure ()
+    GameRendering _ -> do
      pure ()

 -- AE.cmapM_ @World @(AE.Entity, PositionComponent, CollisionComponent) \(entity, position, collision) ->
 --   when (collision.colliders /= []) $ liftIO $ print (show entity <> " with " <> show collision.colliders <> " at " <> show position)

-runGame :: IO ()
-runGame = do
+main' :: IO ()
+main' = do
  let gameConfig =
        GameConfig
          {
@ -207,17 +206,17 @@ runGame = do

  print $ perlin 0 0

-  RL.setTraceLogLevel RL.LogWarning
+  -- RL.setTraceLogLevel RL.LogWarning
  runEff
    . AE.runECS initWorld
    . evalState gameState
    . runReader gameConfig
-    . runRaylibWindow gameState.dimX gameState.dimY "App"
+    . runRaylibRenderer gameState.dimX gameState.dimY "App"
    . runReads @"config.camera" @RL.Camera2D do
      dims <- gets @GameState (\s -> (s.dimX, s.dimY))
      getCamera @LocalWorld (gets @GameState (\s -> s.cameraEntity)) dims
    . runReads @"config.backgroundColor" @RL.Color (pure RL.white)
-    . runEngine
+    . runGame
    $ initialise >> whileM do
      startEngine @"config.camera" @"config.backgroundColor" @LocalWorld
      not <$> windowShouldClose
--- a/rpg/src/System/Renderer.hs
+++ b/rpg/src/System/Renderer.hs
@ -1,84 +1,178 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE CApiFFI #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -fplugin-opt=Foreign.Storable.Generic.Plugin:-v1 #-}
+{-# OPTIONS_GHC -fplugin=Foreign.Storable.Generic.Plugin #-}

-module System.Renderer (render, renderOrigins, renderBoundingBoxes, renderCollision) 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 (PrimState)
+import Data.IORef
+import Data.Text (Text)
+import Data.Vector.Storable qualified as VS hiding (unsafeToForeignPtr)
+import Data.Vector.Storable.Mutable qualified as VS
 import Effectful
-import Effectful.Raylib
+import Effectful.Dispatch.Dynamic
+import Effectful.Raylib hiding (drawLine, isKeyDown, windowShouldClose)
+import Effectful.State.Static.Local
+import Foreign (Storable, withForeignPtr)
+import Foreign.C.Types
+import Foreign.Ptr
+import Foreign.Storable.Generic
+import GHC.Generics (Generic)
 import Linear.V2 (V2 (..), _x, _y)
+import Raylib.Core qualified as RL
+import Raylib.Core.Shapes qualified as RL
+import Raylib.Types qualified as RL
 import Raylib.Util.Colors qualified as RL
 import World

-render
-  :: forall w es
-   . ( AE.Get w PositionComponent
-     , AE.Get w BoxComponent
-     , AE.Get w TextBoxComponent
-     , AE.ECS w :> es
-     , RaylibDraw2D :> es
-     )
-  => Eff es ()
-render = do
-  AE.cmapM_ @w @(PositionComponent, BoxComponent)
-    \(Position (V2 x y), Box color offset (dx, dy)) ->
-      drawRectangle (x + fst offset - dx / 2) (y + snd offset - dy / 2) dx dy color
-  AE.cmapM_ @w @(PositionComponent, TextBoxComponent)
-    \(Position position, TextBox font text fontSize spacing color) -> do
-      -- size <- measureText font text fontSize spacing
-      -- let size = V2 0 0
-      -- drawText font text (V2 (position ^. _x - size ^. _y / 2) (position ^. _y - size ^. _y / 2)) fontSize spacing color
-      pure ()
+data Renderer :: Effect where
+  BeginFrame :: RL.Camera2D -> RL.Color -> Renderer (Eff es) ()
+  DrawSprite :: (PositionComponent, BoxComponent) -> Renderer (Eff es) ()
+  DrawLine :: V2 Float -> V2 Float -> RL.Color -> Renderer (Eff es) ()
+  WindowShouldClose :: Renderer (Eff es) Bool
+  IsKeyDown :: RL.KeyboardKey -> Renderer (Eff es) Bool
+  EndFrame :: Renderer (Eff es) ()
+type instance DispatchOf Renderer = Dynamic

-renderCollision
-  :: forall w es
-   . ( AE.Get w PositionComponent
-     , AE.Get w CollisionComponent
-     , AE.Get w BoxComponent
-     , AE.ECS w :> es
-     , RaylibDraw2D :> es
-     )
-  => Eff es ()
-renderCollision =
-  AE.cmapM_ @w @(PositionComponent, CollisionComponent, BoxComponent)
-    \(Position (V2 x y), Collision colliders, _) ->
-      forM_
-        colliders
-        ( \(Collider _ (V2 overlapX overlapY) (V2 offsetX offsetY) _) -> do
-            drawLine x y (x + offsetX) (y + offsetY) RL.green
-            drawLine (x + offsetX / 2) (y + offsetY / 2) (x + offsetX / 2 + overlapX / 2) (y + offsetY / 2 + overlapY / 2) RL.yellow
-            drawLine (x + offsetX / 2) (y + offsetY / 2) (x + offsetX / 2 - overlapX / 2) (y + offsetY / 2 - overlapY / 2) RL.orange
-        )
+beginFrame :: (HasCallStack, Renderer :> es) => RL.Camera2D -> RL.Color -> Eff es ()
+beginFrame camera color = send (BeginFrame camera color)

-renderOrigins
-  :: forall w es
-   . ( AE.Get w PositionComponent
-     , AE.ECS w :> es
-     , RaylibDraw2D :> es
-     )
-  => Eff es ()
-renderOrigins = do
-  AE.cmapM_ @w @PositionComponent
-    \(Position (V2 x y)) ->
-      drawLine (x - 0.1) (y - 0.1) (x + 0.1) (y + 0.1) RL.red
-        >> drawLine (x + 0.1) (y - 0.1) (x - 0.1) (y + 0.1) RL.red
+drawSprite :: (HasCallStack, Renderer :> es) => (PositionComponent, BoxComponent) -> Eff es ()
+drawSprite d = send (DrawSprite d)

-renderBoundingBoxes
-  :: forall w es
-   . ( AE.Get w PositionComponent
-     , AE.Get w AABBComponent
-     , RaylibDraw2D :> es
-     , AE.ECS w :> es
+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 ()
+
+runRaylibRenderer :: (IOE :> es) => Int -> Int -> Text -> Eff (Renderer : es) a -> Eff es a
+runRaylibRenderer dimX dimY title go = do
+  vectorRef <- liftIO $ VS.new @_ @RectangleInfo 4279 >>= newIORef
+  indexRef <-
+    liftIO $
+      newIORef
+        (0 :: Int)
+  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
+
+          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 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 -> 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
    )
-  => Eff es ()
-renderBoundingBoxes =
-  AE.cmapM_ @w @(PositionComponent, AABBComponent)
-    \(pos, aabb) -> do
-      let (AABBBounds left right top bottom) = aabbBounds pos aabb
-      drawLine right bottom right top RL.red
-      drawLine right top left top RL.red
-      drawLine left top left bottom RL.red
-      drawLine left bottom right bottom RL.red
-      drawLine right bottom left top RL.red
-      drawLine left bottom right top RL.red
+    go
+
+-- render
+--   :: forall w es
+--    . ( AE.Get w PositionComponent
+--      , AE.Get w BoxComponent
+--      , AE.Get w TextBoxComponent
+--      , AE.ECS w :> es
+--      , RaylibDraw2D :> es
+--      )
+--   => Eff es ()
+-- render = do
+--   AE.cmapM_ @w @(PositionComponent, BoxComponent)
+--     \(Position (V2 x y), Box color offset (dx, dy)) ->
+--       drawRectangle (x + fst offset - dx / 2) (y + snd offset - dy / 2) dx dy color
+--   AE.cmapM_ @w @(PositionComponent, TextBoxComponent)
+--     \(Position position, TextBox font text fontSize spacing color) -> do
+--       -- size <- measureText font text fontSize spacing
+--       -- let size = V2 0 0
+--       -- drawText font text (V2 (position ^. _x - size ^. _y / 2) (position ^. _y - size ^. _y / 2)) fontSize spacing color
+--       pure ()
+
+-- renderCollision
+--   :: forall w es
+--    . ( AE.Get w PositionComponent
+--      , AE.Get w CollisionComponent
+--      , AE.Get w BoxComponent
+--      , AE.ECS w :> es
+--      , RaylibDraw2D :> es
+--      )
+--   => Eff es ()
+-- renderCollision =
+--   AE.cmapM_ @w @(PositionComponent, CollisionComponent, BoxComponent)
+--     \(Position (V2 x y), Collision colliders, _) ->
+--       forM_
+--         colliders
+--         ( \(Collider _ (V2 overlapX overlapY) (V2 offsetX offsetY) _) -> do
+--             drawLine x y (x + offsetX) (y + offsetY) RL.green
+--             drawLine (x + offsetX / 2) (y + offsetY / 2) (x + offsetX / 2 + overlapX / 2) (y + offsetY / 2 + overlapY / 2) RL.yellow
+--             drawLine (x + offsetX / 2) (y + offsetY / 2) (x + offsetX / 2 - overlapX / 2) (y + offsetY / 2 - overlapY / 2) RL.orange
+--         )
+
+-- renderOrigins
+--   :: forall w es
+--    . ( AE.Get w PositionComponent
+--      , AE.ECS w :> es
+--      , RaylibDraw2D :> es
+--      )
+--   => Eff es ()
+-- renderOrigins = do
+--   AE.cmapM_ @w @PositionComponent
+--     \(Position (V2 x y)) ->
+--       drawLine (x - 0.1) (y - 0.1) (x + 0.1) (y + 0.1) RL.red
+--         >> drawLine (x + 0.1) (y - 0.1) (x - 0.1) (y + 0.1) RL.red
+
+-- renderBoundingBoxes
+--   :: forall w es
+--    . ( AE.Get w PositionComponent
+--      , AE.Get w AABBComponent
+--      , RaylibDraw2D :> es
+--      , AE.ECS w :> es
+--      )
+--   => Eff es ()
+-- renderBoundingBoxes =
+--   AE.cmapM_ @w @(PositionComponent, AABBComponent)
+--     \(pos, aabb) -> do
+--       let (AABBBounds left right top bottom) = aabbBounds pos aabb
+--       drawLine right bottom right top RL.red
+--       drawLine right top left top RL.red
+--       drawLine left top left bottom RL.red
+--       drawLine left bottom right bottom RL.red
+--       drawLine right bottom left top RL.red
+--       drawLine left bottom right top RL.red
--- a/stack.yaml
+++ b/stack.yaml
@ -48,6 +48,7 @@ extra-deps:
  - lens-5.2.2@sha256:e01d5732173645b80f23a189a0f7e1f5cd0b2286de0ce20baf941cbf5c3b8435,15158
  - effectful-2.2.2.0@sha256:1d5682727c2d5ebd83f7a7ae0ef809369422ccd37d4157ae7e2084f2a1cf6cfd,6044
  - effectful-core-2.2.2.2@sha256:ebbf61f024a08c7bb5e569b1c6856c0ca92687d6a5ff01d24d28567948c402fc,3477
+  - derive-storable-plugin-0.2.3.7@sha256:f82b5cc67d7affbb41040d3a5812e6a587894e232e7a5d5ccb33103836e51fa6,2868

 # Override default flag values for local packages and extra-deps
 flags:
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@ -47,6 +47,13 @@ packages:
      size: 1918
  original:
    hackage: effectful-core-2.2.2.2@sha256:ebbf61f024a08c7bb5e569b1c6856c0ca92687d6a5ff01d24d28567948c402fc,3477
+- completed:
+    hackage: derive-storable-plugin-0.2.3.7@sha256:f82b5cc67d7affbb41040d3a5812e6a587894e232e7a5d5ccb33103836e51fa6,2868
+    pantry-tree:
+      sha256: b11fd39df181394cc3cb37d4cc43149ef776ab2c079413c84ad59f3904ff557f
+      size: 1411
+  original:
+    hackage: derive-storable-plugin-0.2.3.7@sha256:f82b5cc67d7affbb41040d3a5812e6a587894e232e7a5d5ccb33103836e51fa6,2868
 snapshots:
 - completed:
    sha256: 93137bc0122de394fa2c43e933971b2996cd7dc600989b721ad971810b9a2f3f