Pong using proper AABB collision

Signed-off-by: magic_rb <richard@brezak.sk>
2024-11-22 07:44:20 +01:00 · 2023-10-12 20:29:21 +02:00 · 2023-10-12 20:29:21 +02:00 · ee69651f5a
parent 9c658ce9d4
commit ee69651f5a
10 changed files with 324 additions and 71 deletions
--- a/rpg/package.yaml
+++ b/rpg/package.yaml
@ -26,8 +26,11 @@ dependencies:
 - bytestring
 - text
 - lens
+- apecs
 - apecs-effectful
+- linear
 - extra
+- vector
 language: GHC2021
 default-extensions:
  - OverloadedStrings
--- a/rpg/rpg.cabal
+++ b/rpg/rpg.cabal
@ -26,6 +26,8 @@ source-repository head
 library
  exposed-modules:
      Common
+      Component.AABB
+      Component.Body
      Component.Box
      Component.Camera
      Component.Player
@ -54,14 +56,17 @@ library
      LambdaCase
  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
  build-depends:
-      apecs-effectful
+      apecs
+    , apecs-effectful
    , base >=4.7 && <5
    , bytestring
    , effectful
    , extra
    , h-raylib
    , lens
+    , linear
    , text
+    , vector
  default-language: GHC2021

 executable pong
@ -82,15 +87,18 @@ executable pong
      LambdaCase
  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
  build-depends:
-      apecs-effectful
+      apecs
+    , apecs-effectful
    , base >=4.7 && <5
    , bytestring
    , effectful
    , extra
    , h-raylib
    , lens
+    , linear
    , rpg
    , text
+    , vector
  default-language: GHC2021

 executable rpg-exe
@ -111,15 +119,18 @@ executable rpg-exe
      LambdaCase
  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
  build-depends:
-      apecs-effectful
+      apecs
+    , apecs-effectful
    , base >=4.7 && <5
    , bytestring
    , effectful
    , extra
    , h-raylib
    , lens
+    , linear
    , rpg
    , text
+    , vector
  default-language: GHC2021

 test-suite rpg-test
@ -141,13 +152,16 @@ test-suite rpg-test
      LambdaCase
  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
  build-depends:
-      apecs-effectful
+      apecs
+    , apecs-effectful
    , base >=4.7 && <5
    , bytestring
    , effectful
    , extra
    , h-raylib
    , lens
+    , linear
    , rpg
    , text
+    , vector
  default-language: GHC2021
--- a/rpg/src/Common.hs
+++ b/rpg/src/Common.hs
@ -1,3 +1,4 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 module Common ( getCamera ) where

 import qualified Apecs.Effectful as AE
@ -7,13 +8,17 @@ import qualified Raylib.Types as RL
 import GHC.Float

 getCamera
-  :: ( AE.ECS World :> es )
+  :: forall w es .
+     ( AE.Get w CameraComponent
+     , AE.Get w PositionComponent
+     , AE.ECS w :> es
+     )
  => Eff es AE.Entity
  -> (Int, Int)
  -> Eff es RL.Camera2D
 getCamera eff (dimX, dimY) = do
  entity <- eff
-  (c, p) <- AE.get @World @(CameraComponent, PositionComponent) entity
+  (c, p) <- AE.get @w @(CameraComponent, PositionComponent) entity
  pure $ RL.Camera2D
    { RL.camera2D'offset = RL.Vector2 (int2Float dimX / 2) (int2Float dimY / 2)
    , RL.camera2D'target = RL.Vector2 (p.x + fst c.offset) (p.y + snd c.offset)
--- a/rpg/src/Component/AABB.hs
+++ b/rpg/src/Component/AABB.hs
@ -0,0 +1,26 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module Component.AABB
+  ( AABBComponent(..)
+  , aabbBounds
+  ) where
+
+import Apecs.Effectful
+import Linear.V2
+import Linear.V4
+import Component.Position
+
+data AABBComponent
+  = AABB
+  { size :: V2 Float
+  , offset :: V2 Float
+  }
+  deriving Show
+instance Component AABBComponent where type Storage AABBComponent = Map AABBComponent
+
+aabbBounds :: PositionComponent -> AABBComponent -> V4 Float
+aabbBounds (Position posX posY) (AABB (V2 sizeX sizeY) (V2 offsetX offsetY)) =
+  V4 (posX + sizeX / 2 + offsetX)
+     (posX - sizeX / 2 + offsetX)
+     (posY + sizeY / 2 + offsetY)
+     (posY - sizeY / 2 + offsetY)
--- a/rpg/src/Component/Body.hs
+++ b/rpg/src/Component/Body.hs
@ -0,0 +1,10 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module Component.Body (BodyComponent(..)) where
+import Apecs.Effectful
+
+data BodyComponent
+  = Body
+  { }
+  deriving Show
+instance Component BodyComponent where type Storage BodyComponent = Map BodyComponent
--- a/rpg/src/Lib.hs
+++ b/rpg/src/Lib.hs
@ -39,6 +39,8 @@ import Effectful.State.Static.Local.Lens
 import Effectful.Raylib
 import System.Renderer
 import Common
+import Linear.V2
+import System.Physics

 data GameConfig
  = GameConfig
@ -52,6 +54,7 @@ data GameState
  , camera :: RL.Camera2D
  , playerEntity :: AE.Entity
  , cameraEntity :: AE.Entity
+  , boxes :: [AE.Entity]
  }
  deriving Show
 makeLensesFor [ ("dimX", "dimX")
@ -59,13 +62,14 @@ makeLensesFor [ ("dimX", "dimX")
              , ("camera", "camera")
              , ("playerEntity", "playerEntity")
              , ("cameraEntity", "cameraEntity")
+              , ("boxes", "boxes")
              ] ''GameState

 spawnPlayer
  :: ( AE.ECS World :> es )
  => RL.Color
  -> Eff es AE.Entity
-spawnPlayer color = AE.newEntity @World (Player, Position 0 0, Camera 20 (0, 0), Box color (-0.5, -0.5) (1, 1))
+spawnPlayer color = AE.newEntity @World (Player, Position 0 2, Camera 10 (0, 0), AABB (V2 1 1) (V2 0 0), Body, Box color (0, 0) (1, 1))

 movePlayer
  :: ( AE.ECS World :> es )
@ -83,7 +87,7 @@ spawnBox
  -> RL.Color
  -> (Float, Float)
  -> Eff es AE.Entity
-spawnBox (posx, posy) color size = AE.newEntity @World (Box color size (0, 0), Position posx posy)
+spawnBox (posx, posy) color size = AE.newEntity @World (Box color size (0, 0), Position posx posy, AABB (V2 1 1) (V2 0 0))

 initialise
  :: ( Raylib :> es
@ -97,6 +101,11 @@ initialise = do
  playerEntity .= player
  cameraEntity .= player

+  box1 <- AE.newEntity @World (Box RL.gray (0,0) (1,1), Position 0 0, AABB (V2 1 1) (V2 0 0))
+  -- box2 <- AE.newEntity @World (Box RL.gray (0,0) (1,1), Position 2 0, AABB (V2 1 1) (V2 0 0))
+  boxes .= [box1--, box2
+           ]
+
  pure ()

 runGame :: IO ()
@ -115,25 +124,26 @@ runGame = do

  RL.setTraceLogLevel RL.LogWarning
  runEff . AE.runECS initWorld . evalState gameState . runReader gameConfig . runRaylibWindow gameState.dimX gameState.dimY "App" $ initialise >> whileM do
+    collisionAABB @World
+
    isKeyDown RL.KeyA >>= flip when (movePlayer (gets @GameState (\s -> s.playerEntity)) (-0.1, 0))
    isKeyDown RL.KeyD >>= flip when (movePlayer (gets @GameState (\s -> s.playerEntity)) (0.1, 0))
    isKeyDown RL.KeyS >>= flip when (movePlayer (gets @GameState (\s -> s.playerEntity)) (0, 0.1))
    isKeyDown RL.KeyW >>= flip when (movePlayer (gets @GameState (\s -> s.playerEntity)) (0, -0.11))

-    cameraEntity <- (gets @GameState (\s -> s.cameraEntity))
+    cameraEntity <- gets @GameState (\s -> s.cameraEntity)
    isKeyDown RL.KeyKpAdd >>= flip when ( AE.modify @World @CameraComponent @CameraComponent cameraEntity (\c -> c { zoom = c.zoom + 1}))
    isKeyDown RL.KeyKpSubtract >>= flip when ( AE.modify @World @CameraComponent @CameraComponent cameraEntity (\c -> c { zoom = c.zoom - 1}))

    dims <- gets @GameState (\s -> (s.dimX, s.dimY))
-    c <- getCamera (gets @GameState (\s -> s.cameraEntity)) dims
-    liftIO $ print c
-    runDraw . runDraw2D c $ do
+    c <- getCamera @World (gets @GameState (\s -> s.cameraEntity)) dims

+    runDraw . runDraw2D c $ do
      clearBackground RL.rayWhite
-      -- drawText "Congrats! You created your first window!" 190 200 20 RL.lightGray
-      render
-      drawRectangle 0 0 1 1 RL.lightGray
-      drawRectangle 2 0 1 1 RL.lightGray
+
+      render @World
+      renderOrigins @World
+      renderBoundingBoxes @World
      not <$> windowShouldClose

  pure ()
--- a/rpg/src/Pong.hs
+++ b/rpg/src/Pong.hs
@ -1,3 +1,4 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 module Pong (pongGame) where

 import Effectful.State.Static.Local
@ -16,6 +17,7 @@ import Control.Lens hiding ((.=), (%=))
 import System.Renderer
 import GHC.Float
 import System.Physics
+import Linear.V2

 data GameState
  = GameState
@ -25,9 +27,14 @@ data GameState
  , player1 :: AE.Entity
  , player2 :: AE.Entity
  , ball :: AE.Entity
+  , goal1 :: AE.Entity
+  , goal2 :: AE.Entity
+  , bottom :: AE.Entity
+  , top :: AE.Entity
+  , score :: (Int, Int)
  }
  deriving Show
-makeLensesFor [("dimX", "dimX"), ("dimY", "dimY"), ("camera", "camera"), ("player1", "player1"), ("player2", "player2"), ("ball", "ball")] ''GameState
+makeLensesFor [("dimX", "dimX"), ("dimY", "dimY"), ("camera", "camera"), ("player1", "player1"), ("player2", "player2"), ("ball", "ball"), ("goal1", "goal1"), ("goal2", "goal2"), ("bottom", "bottom"), ("top", "top"), ("score", "score")] ''GameState

 data GameConfig
  = GameConfig
@ -37,8 +44,11 @@ data GameConfig
 makeLensesFor [("playArea", "playArea")] ''GameConfig

 playerMovement
-  :: ( Raylib :> es
-     , AE.ECS World :> es
+  :: forall w es .
+     ( Raylib :> es
+     , AE.Get w PositionComponent
+     , AE.Set w PositionComponent
+     , AE.ECS w :> es
     , Reader GameConfig :> es
     )
  => (RL.KeyboardKey, Float)
@ -48,9 +58,9 @@ playerMovement
 playerMovement (up, upSpeed) (down, downSpeed) entity = do
  playArea <- asks @GameConfig (\c -> c.playArea)
  isKeyDown up >>= flip when
-    (entity >>= flip (AE.modify @World @PositionComponent) (\p -> clampPosition playArea $ Position p.x (p.y + upSpeed)))
+    (entity >>= flip (AE.modify @w @PositionComponent) (\p -> clampPosition playArea $ Position p.x (p.y + upSpeed)))
  isKeyDown down >>= flip when
-    (entity >>= flip (AE.modify @World @PositionComponent) (\p -> clampPosition playArea $ Position p.x (p.y + downSpeed)))
+    (entity >>= flip (AE.modify @w @PositionComponent) (\p -> clampPosition playArea $ Position p.x (p.y + downSpeed)))
  where
    clampPosition
      :: Int
@ -62,73 +72,131 @@ playerMovement (up, upSpeed) (down, downSpeed) entity = do
      | otherwise = Position x y

 ballMovement
-  :: ( AE.ECS World :> es
+  :: forall es .
+     ( AE.ECS World :> es
     , Reader GameConfig :> es
     )
-  => Eff es AE.Entity
+  => Eff es Int
+  -> Eff es AE.Entity
+  -> Eff es AE.Entity
+  -> Eff es AE.Entity
  -> Eff es AE.Entity
  -> Eff es AE.Entity
  -> Eff es ()
-ballMovement player1 player2 ball = do
-  ballEntity <- ball
-  playArea <- asks @GameConfig (\c -> c.playArea)
-  player1Position <- player1 >>= AE.get @World
-  player2Position <- player2 >>= AE.get @World
-  ballPosition <- AE.get @World ballEntity
-  ballVelocity <- AE.get @World ballEntity
+ballMovement playArea player1 player2 ball top bottom = do
+  playArea' <- playArea
+  player1' <- player1
+  player2' <- player2
+  ball' <- ball
+  top' <- top
+  bottom' <- bottom

-  let newVelocity = ballMovement'
-        playArea
-        player1Position
-        player2Position
-        (ballPosition, ballVelocity)
+  ballVelocity <- ball >>= AE.get @World

-  AE.set @World ballEntity newVelocity
+  newVelocity <- ballMovement'
+        playArea'
+        player1'
+        player2'
+        ball'
+        bottom'
+        top'
+        ballVelocity
+
+  ball >>= \ballEntity -> AE.set @World ballEntity newVelocity

  where
    invertYVelocity
      :: VelocityComponent
      -> VelocityComponent
    invertYVelocity (Velocity x y) = Velocity x (-y)
+
    invertXVelocity
      :: VelocityComponent
      -> VelocityComponent
    invertXVelocity (Velocity x y) = Velocity (-x) y

    ballMovement'
-      :: Int
-      -> PositionComponent
-      -> PositionComponent
-      -> (PositionComponent, VelocityComponent)
+      :: ( AE.ECS World :> es
+         )
+      => Int
+      -> AE.Entity
+      -> AE.Entity
+      -> AE.Entity
+      -> AE.Entity
+      -> AE.Entity
      -> VelocityComponent
-    ballMovement' playArea player1 player2 (ballPosition, ballVelocity)
-      | ballPosition.y + 0.25 > int2Float playArea / 2 = invertYVelocity ballVelocity
-      | ballPosition.y - 0.25 < int2Float playArea / 2 * (-1) = invertYVelocity ballVelocity
-      | ballPosition.x + 0.75 > player2.x && ballPosition.x + 0.5 < player2.x && ballPosition.y >= player2.y - 1.25 && ballPosition.y <= player2.y + 1.25 = invertXVelocity ballVelocity
-      | ballPosition.x - 0.75 < player1.x && ballPosition.x - 0.5 > player1.x && ballPosition.y >= player1.y - 1.25 && ballPosition.y <= player1.y + 1.25 = invertXVelocity ballVelocity
-      | otherwise = ballVelocity
+      -> Eff es VelocityComponent
+    ballMovement' playArea player1 player2 ball bottom top ballVelocity = do
+      player1Collision <- collidesEntities @World (pure player1) (pure ball)
+      player2Collision <- collidesEntities @World (pure player2) (pure ball)
+      bottomCollision <- collidesEntities @World (pure bottom) (pure ball)
+      topCollision <- collidesEntities @World (pure top) (pure ball)
+
+      let ret
+            | player1Collision || player2Collision = invertXVelocity ballVelocity
+            | bottomCollision || topCollision = invertYVelocity ballVelocity
+            | otherwise = ballVelocity
+
+      pure ret
+
+
+ballRespawn
+  :: ( AE.ECS World :> es
+     , State GameState :> es
+     )
+  => Eff es AE.Entity
+  -> Eff es AE.Entity
+  -> Eff es AE.Entity
+  -> Eff es ()
+ballRespawn goal1 goal2 ball = do
+  goal1' <- goal1
+  ball' <- ball
+  goal2' <- goal2
+
+  goal1Collision <- collidesEntities @World (pure goal1') (pure ball')
+  goal2Collision <- collidesEntities @World (pure goal2') (pure ball')
+
+  let
+    respawn = AE.set @World ball' (Position 0 0)
+    ret
+      | goal1Collision = (score . _1) %= (+) 1 >> respawn
+      | goal2Collision = (score . _2) %= (+) 1 >> respawn
+      | otherwise = pure ()
+  ret

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

-  cameraEntity <- AE.newEntity @World (Camera 20 (0, 0), Position 0 0)
+  cameraEntity <- AE.newEntity @World (Camera playArea (0, 0), Position 0 0)
  camera .= cameraEntity

-  player1Entity <- AE.newEntity @World (Player, Position (-10) 0, Box RL.white (0, -1) (0.5, 2))
+  player1Entity <- AE.newEntity @World (Player, Position (-10) 0, Box RL.white (0, 0) (0.5, 2), AABB (V2 0.5 2) (V2 0 0))
  player1 .= player1Entity

-  player2Entity <- AE.newEntity @World (Player, Position 10 0, Box RL.white (-0.5, -1) (0.5, 2))
+  player2Entity <- AE.newEntity @World (Player, Position 10 0, Box RL.white (0, 0) (0.5, 2), AABB (V2 0.5 2) (V2 0 0))
  player2 .= player2Entity

-  ballEntity <- AE.newEntity @World (Position 0 0, Velocity 0.1 0.1, Box RL.white (-0.25, -0.25) (0.5, 0.5))
+  ballEntity <- AE.newEntity @World (Position 0 0, Velocity 0.1 0.1, Box RL.white (0, 0) (0.5, 0.5), AABB (V2 0.5 0.5) (V2 0 0))
  ball .= ballEntity

+  goal1Entity <- AE.newEntity @World (Position (int2Float (-playArea) / 2 - 1) 0, AABB (V2 0.1 (int2Float playArea)) (V2 0 0))
+  goal2Entity <- AE.newEntity @World (Position (int2Float playArea / 2 + 1) 0, AABB (V2 0.1 (int2Float playArea)) (V2 0 0))
+  goal1 .= goal1Entity
+  goal2 .= goal2Entity
+
+  topEntity <- AE.newEntity @World (Position 0 (int2Float (-playArea) / 2), AABB (V2 (int2Float playArea + 2) 0.1) (V2 0 0))
+  bottomEntity <- AE.newEntity @World (Position 0 (int2Float playArea / 2), AABB (V2 (int2Float playArea + 2) 0.1) (V2 0 0))
+  top .= topEntity
+  bottom .= bottomEntity
+
  pure ()

 pongGame :: IO ()
@ -141,6 +209,11 @@ pongGame = do
        , player2 = undefined
        , camera = undefined
        , ball = undefined
+        , goal1 = undefined
+        , goal2 = undefined
+        , top = undefined
+        , bottom = undefined
+        , score = (0, 0)
        }
      gameConfig
        = GameConfig
@ -148,30 +221,39 @@ pongGame = do
        }
  -- RL.setTraceLogLevel RL.LogWarning
  runEff . AE.runECS initWorld . evalState gameState . runReader gameConfig . runRaylibWindow gameState.dimX gameState.dimY "App" $ initialise >> whileM do
+    ballRespawn
+      (gets @GameState (\s -> s.goal2))
+      (gets @GameState (\s -> s.goal1))
+      (gets @GameState (\s -> s.ball))
+
    ballMovement
+      (asks @GameConfig (\c -> c.playArea))
      (gets @GameState (\s -> s.player1))
      (gets @GameState (\s -> s.player2))
      (gets @GameState (\s -> s.ball))
+      (gets @GameState (\s -> s.bottom))
+      (gets @GameState (\s -> s.top))

-    applyVelocity
+    applyVelocity @World

-    playerMovement
+    playerMovement @World
      (RL.KeyW, -0.2)
      (RL.KeyS, 0.2)
      (gets @GameState (\s -> s.player1))

-    playerMovement
+    playerMovement @World
      (RL.KeyUp, -0.2)
      (RL.KeyDown, 0.2)
      (gets @GameState (\s -> s.player2))

-    (gets @GameState (\s -> s.ball)) >>= AE.get @World @(PositionComponent, VelocityComponent) >>= liftIO . print
-
    dims <- gets @GameState (\s -> (s.dimX, s.dimY))
-    camera <- getCamera (gets @GameState (\s -> s.camera)) dims
+    camera <- getCamera @World (gets @GameState (\s -> s.camera)) dims
    runDraw . runDraw2D camera $ do
      clearBackground RL.gray

-      render
-      renderOrigins
+      (gets @GameState (\s -> s.score)) >>= liftIO . print
+
+      render @World
+      -- renderOrigins @World
+      -- renderBoundingBoxes @World
    not <$> windowShouldClose
--- a/rpg/src/System/Physics.hs
+++ b/rpg/src/System/Physics.hs
@ -1,13 +1,78 @@
-module System.Physics (applyVelocity) where
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE MonoLocalBinds #-}
+
+module System.Physics (applyVelocity, collides, collisionAABB, collidesEntities) where

 import World
 import qualified Apecs.Effectful as AE
+import qualified Apecs.Components as AE (EntityStore)
 import Effectful
+import Linear
+import Control.Lens
+import Effectful.Dispatch.Static (unsafeEff_)
+import qualified Apecs
+import qualified Apecs.Core
+import Apecs.Components (EntityStore)
+import Control.Monad.Extra

 applyVelocity
-  :: ( AE.ECS World :> es
+  :: forall w es .
+     ( AE.Get w PositionComponent
+     , AE.Get w VelocityComponent
+     , AE.Set w PositionComponent
+     , AE.ECS w :> es
     )
  => Eff es ()
 applyVelocity = do
-  AE.cmap @World @(PositionComponent, VelocityComponent) @_
+  AE.cmap @w @(PositionComponent, VelocityComponent) @_
    \(position, velocity) -> Position (position.x + velocity.x) (position.y + velocity.y)
+
+collides
+  :: PositionComponent -> AABBComponent
+  -> PositionComponent -> AABBComponent
+  -> Bool
+collides positionA aabbA positionB aabbB = do
+  -- V4 x -x y -y
+  let boundsA = aabbBounds positionA aabbA
+      boundsB = aabbBounds positionB aabbB
+
+  case (boundsA ^. _x > boundsB ^. _y, boundsB ^. _x > boundsA ^. _y, boundsA ^. _z > boundsB ^. _w, boundsB ^. _z > boundsA ^. _w) of
+    (True, True, True, True) -> True
+    _ -> False
+
+collidesEntities
+  :: forall w es .
+     ( AE.Get w PositionComponent
+     , AE.Get w AABBComponent
+     , AE.ECS w :> es )
+  => Eff es AE.Entity
+  -> Eff es AE.Entity
+  -> Eff es Bool
+collidesEntities a b = do
+  a' <- a
+  b' <- b
+  positionA <- AE.get @w a'
+  aabbA <- AE.get @w a'
+  positionB <- AE.get @w b'
+  aabbB <- AE.get @w b'
+
+  pure $ collides positionA aabbA positionB aabbB
+
+
+collisionAABB
+  :: forall w es .
+     ( AE.Get w PositionComponent
+     , AE.Get w VelocityComponent
+     , AE.Get w BodyComponent
+     , AE.Get w AABBComponent
+     , AE.ECS w :> es
+     )
+  => Eff es ()
+collisionAABB =
+  AE.cmapM @w @(AE.Entity, PositionComponent, BodyComponent, AABBComponent)
+  \(bodyEntity, bodyPosition, bodyBody, bodyAABB) ->
+    AE.cmapM @w @(AE.Entity, PositionComponent, AABBComponent)
+    \(colliderEntity, colliderPosition, colliderAABB) -> when (bodyEntity /= colliderEntity) do
+      let collision = collides bodyPosition bodyAABB colliderPosition colliderAABB
+      unsafeEff_ $ print collision
+      pure ()
--- a/rpg/src/System/Renderer.hs
+++ b/rpg/src/System/Renderer.hs
@ -1,28 +1,52 @@
-module System.Renderer (render, renderOrigins) where
+{-# LANGUAGE AllowAmbiguousTypes #-}
+module System.Renderer (render, renderOrigins, renderBoundingBoxes) where

 import Effectful
 import qualified Apecs.Effectful as AE
 import World
-import Component.Position
-import Component.Box
 import Effectful.Raylib
 import qualified Raylib.Util.Colors as RL
+import Linear.V4

 render
-  :: ( AE.ECS World :> es
+  :: forall w es .
+     ( AE.Get w PositionComponent
+     , AE.Get w BoxComponent
+     , AE.ECS w :> es
     , RaylibDraw2D :> es )
  => Eff es ()
 render = do
-  AE.cmapM_ @World @(PositionComponent, BoxComponent)
-    \(pos, Box color offset size) -> drawRectangle (pos.x + fst offset) (pos.y + snd offset) (fst size) (snd size) color
+  AE.cmapM_ @w @(PositionComponent, BoxComponent)
+    \(pos, Box color offset size) -> drawRectangle (pos.x + fst offset - fst size / 2) (pos.y + snd offset - snd size / 2) (fst size) (snd size) color
  pure ()

 renderOrigins
-  :: ( AE.ECS World :> es
+  :: forall w es .
+     ( AE.Get w PositionComponent
+     , AE.ECS w :> es
     , RaylibDraw2D :> es
     )
  => Eff es ()
 renderOrigins = do
-  AE.cmapM_ @World @PositionComponent
+  AE.cmapM_ @w @PositionComponent
    \pos -> drawLine (pos.x - 0.1) (pos.y - 0.1) (pos.x + 0.1) (pos.y + 0.1) RL.red >>
            drawLine (pos.x + 0.1) (pos.y - 0.1) (pos.x - 0.1) (pos.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 (V4 x nx y ny) = aabbBounds pos aabb
+      drawLine x y x ny RL.red
+      drawLine x ny nx ny RL.red
+      drawLine nx ny nx y RL.red
+      drawLine nx y x y RL.red
+      drawLine x y nx ny RL.red
+      drawLine nx y x ny RL.red
--- a/rpg/src/World.hs
+++ b/rpg/src/World.hs
@ -1,5 +1,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE FieldSelectors #-}
+{-# OPTIONS_GHC -Wno-deferred-out-of-scope-variables #-}

 module World
  ( World
@ -9,13 +10,26 @@ module World
  , module Component.Camera
  , module Component.Box
  , module Component.Velocity
+  , module Component.AABB
+  , module Component.Body
  ) where

-import Apecs.Effectful
 import Component.Position
 import Component.Player
 import Component.Camera
 import Component.Box
 import Component.Velocity
+import Component.AABB
+import Component.Body
+import Apecs
+import qualified Apecs.Effectful as AE
+import Apecs.Core
+import Apecs.Components
+import Data.Vector.Unboxed

-makeWorld "World" [''PositionComponent, ''PlayerComponent, ''CameraComponent, ''BoxComponent, ''VelocityComponent]
+makeWorld "World" [''PositionComponent, ''PlayerComponent, ''CameraComponent, ''BoxComponent, ''VelocityComponent, ''AABBComponent, ''BodyComponent]
+
+instance Monad m => ExplMembers m EntityStore where
+  explMembers :: EntityStore -> m (Vector Int)
+  explMembers _ = do
+    pure $ generate 10000 ((-) 1)