Adapt rest of code to changes

Signed-off-by: magic_rb <richard@brezak.sk>

rpg/src/Engine.hs

@@ -24,7 +24,7 @@ import World
 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) ()
+  GameRendering :: (SharedSuffix es2 es, Renderer :> es2) => (forall r. Eff es2 r -> Eff es r) -> Game (Eff es) ()
 type instance DispatchOf Game = Dynamic
 
 data Engine :: Effect
@@ -36,7 +36,7 @@ gameInput = send GameInput
 gamePhysics :: (HasCallStack, Game :> es) => Eff es ()
 gamePhysics = send GamePhysics
 
-gameRendering :: forall es. (HasCallStack, Game :> es, SharedSuffix es es, RaylibDraw :> es, RaylibDraw2D :> es) => Eff es ()
+gameRendering :: forall es. (HasCallStack, Game :> es, SharedSuffix es es, Renderer :> es) => Eff es ()
 gameRendering = unsafeEff $ \env -> (`unEff` env) $ localSeqUnlift @_ @es (LocalEnv env) (\unlift -> send $ GameRendering unlift)
 
 class EngineConstraints where
@@ -72,9 +72,6 @@ startEngine = do
   gameInput
   applyVelocity'' @w
 
-  -- collisionAABB @w
-  -- resolveAABB @w
-
   gamePhysics
 
   c <- readVal @camera @RL.Camera2D
@@ -82,20 +79,9 @@ startEngine = do
 
   beginFrame c color
 
-  -- getFPS >>= unsafeEff_ . print
+  AE.cmapM_ @w @(BoxComponent, PositionComponent)
+    \(box, position) -> drawSprite (position, box)
 
-  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
+  gameRendering
 
   endFrame
-
--- renderBoundingBoxes @w
--- renderCollision @w
-
--- gameRendering

rpg/src/Executables/Minkowski.hs

@@ -9,12 +9,14 @@ import Apecs.Effectful qualified as AE
 import Common
 import Control.Lens hiding ((%=), (.=))
 import Control.Monad.Extra
+import Data.Maybe
 import Effectful
 import Effectful.Accessor
 import Effectful.Dispatch.Dynamic
 import Effectful.Raylib qualified as RL hiding (windowShouldClose)
 import Effectful.Reader.Static
 import Effectful.State.Static.Local
+import Effectful.State.Static.Local.Lens
 import Engine
 import Linear (normalize)
 import Linear.V2 (V2 (..), _x, _y)
@@ -119,44 +121,42 @@ runGame = interpret \env eff ->
   case eff of
     GameInput -> do
       camera <- readsCamera
-      pure ()
-    -- pos <- getMousePosition >>= \pos -> getScreenToWorld2D pos camera
+      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 ()
+      whenM
+        (wasMouseButtonJustPressed RL.MouseButtonLeft)
+        $ 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 ()
+      whenM (wasMouseButtonJustReleased RL.MouseButtonLeft) 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
 
-    -- 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 ()
+          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
@@ -166,7 +166,7 @@ runGame = interpret \env eff ->
       let collision = rayCollides box1Position (ray, ray) box2Position box2AABB
       case collision of
         Just collision -> localSeqUnlift env \unlift ->
-          unlift . unlift' $ RL.drawLine (box1Position ^. position . _x) (box1Position ^. position . _y) (collision ^. _x) (collision ^. _y) RL.blue
+          unlift . unlift' $ drawLine (box1Position ^. position) collision RL.blue
         Nothing -> pure ()
 
       minkowski' <- gets @GameState \s -> s.minkowski
@@ -175,7 +175,7 @@ runGame = interpret \env eff ->
       let collision = rayCollides (Position $ V2 0 0) (ray, ray) minkowskiPosition minkowskiAABB
       case collision of
         Just collision -> localSeqUnlift env \unlift ->
-          unlift . unlift' $ RL.drawLine 0 0 (collision ^. _x) (collision ^. _y) RL.blue
+          unlift . unlift' $ drawLine (pure 0) collision RL.blue
         Nothing -> pure ()
 
       pure ()

rpg/src/Executables/RPG.hs

@@ -101,17 +101,19 @@ spawnBox position color size = do
 initialise
   :: ( State GameState :> es
      , AE.ECS LocalWorld :> es
+     , Renderer :> es
      )
   => Eff es ()
 initialise = do
-  -- setTargetFPS 60
+  setTargetFPS 60
 
-  forM_ [-32 .. 32] \x -> do
-    forM_ [-32 .. 32] \y -> do
+  let range = 32
+  forM_ [-range .. range] \x -> do
+    forM_ [-range .. range] \y -> do
       let height = floorFloat $ (perlin (x / 5) (y / 5) * 0.5 + 0.5) * 255
       AE.newEntity_ @LocalWorld
-        ( Box (RL.Color height height height 255) (V2 0 0) (V2 1 1)
-        , Position $ V2 x y
+        ( Position $ V2 x y
+        , Box (RL.Color height height height 255) (V2 0 0) (V2 1 1)
         )
 
   player <- spawnPlayer RL.blue
@@ -183,9 +185,6 @@ runGame = interpret \_ eff ->
     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)
-
 main' :: IO ()
 main' = do
   let gameConfig =
@@ -204,7 +203,6 @@ main' = do
 
   print $ perlin 0 0
 
-  -- RL.setTraceLogLevel RL.LogWarning
   runEff
     . AE.runECS initWorld
     . evalState gameState

rpg/src/System/Physics.hs

@@ -117,7 +117,7 @@ applyVelocity' = do
     iterations <- get @Int
     put @Int $ iterations - 1
 
-    pure (iterations /= 0 && unVelocity newVelocity /= pure 0 && remainingTime > 0)
+    pure (iterations /= 0 && newVelocity ^. velocity /= pure 0 && remainingTime > 0)
 
 clampDown :: Float -> Float
 clampDown h
@@ -154,7 +154,7 @@ applyVelocity'' = do
     pairs xs = [(x, y) | (x : ys) <- tails (nub xs), y <- ys]
     entityPairings = pairs allEntities
 
-  evalState (1.0 :: Float) . evalState (16 :: Int) . whileM $ do
+  evalState (1.0 :: Float) . evalState (4 :: Int) . whileM $ do
     remainingTime <- get @Float
     fractions <- forM entityPairings \(entity1, entity2) -> do
       (position1, velocity1, aabb1, body1) <- AE.get @w @(PositionComponent, Maybe VelocityComponent, AABBComponent, BodyComponent) entity1
@@ -178,9 +178,9 @@ applyVelocity'' = do
       let
         velocity1' = fromMaybe (Velocity $ pure 0) velocity1
        in
-        if unVelocity velocity1' == pure 0 || maybe False (^. immovable) body1
+        if velocity1' ^. velocity == pure 0 || maybe False (^. immovable) body1
           then position1
-          else Position $ position1.position + unVelocity velocity1' * pure (clampDown minTime)
+          else Position $ position1.position + velocity1' ^. velocity * pure (clampDown minTime)
     case info of
       Just ((entityA, positionA, velocityA, aabbA, bodyA), (entityB, positionB, velocityB, aabbB, bodyB)) -> do
         do