mirror of
https://git.sr.ht/~magic_rb/haskell-games
synced 2024-11-22 15:44:21 +01:00
Non effectful renderer
Signed-off-by: magic_rb <richard@brezak.sk>
This commit is contained in:
parent
2972b5b048
commit
afe32a1b0d
|
|
@ -35,12 +35,13 @@ getCamera eff (dimX, dimY) = do
|
|||
}
|
||||
|
||||
playerMovement
|
||||
:: forall w es
|
||||
:: forall w es r
|
||||
. ( AE.ECS w :> es
|
||||
, AE.Get w VelocityComponent
|
||||
, Renderer :> es
|
||||
, Renderer (Eff es) r
|
||||
)
|
||||
=> AE.Entity
|
||||
=> r
|
||||
-> AE.Entity
|
||||
-> ( RL.KeyboardKey
|
||||
, RL.KeyboardKey
|
||||
, RL.KeyboardKey
|
||||
|
|
@ -48,14 +49,14 @@ playerMovement
|
|||
)
|
||||
-> Float
|
||||
-> Eff es ()
|
||||
playerMovement player (left, right, up, down) speed = do
|
||||
playerMovement renderer player (left, right, up, down) speed = do
|
||||
directions <-
|
||||
mapM
|
||||
(\tuple -> fst tuple <&> (,snd tuple))
|
||||
[ (isKeyDown left, V2 (-1.0) 0)
|
||||
, (isKeyDown right, V2 1.0 0)
|
||||
, (isKeyDown down, V2 0 1.0)
|
||||
, (isKeyDown up, V2 0 (-1.0))
|
||||
[ (isKeyDown renderer left, V2 (-1.0) 0)
|
||||
, (isKeyDown renderer right, V2 1.0 0)
|
||||
, (isKeyDown renderer down, V2 0 1.0)
|
||||
, (isKeyDown renderer 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))
|
||||
|
|
|
|||
|
|
@ -54,7 +54,6 @@ instance EngineConstraints where
|
|||
, Reads camera RL.Camera2D :> es
|
||||
, Reads backgroundColor RL.Color :> es
|
||||
, IOE :> es
|
||||
, Renderer :> es
|
||||
, AE.ECS w :> es
|
||||
)
|
||||
|
||||
|
|
@ -64,11 +63,14 @@ startEngine
|
|||
(backgroundColor :: Symbol)
|
||||
(w :: Type)
|
||||
es
|
||||
r
|
||||
. ( EngineConstraint camera backgroundColor es w
|
||||
, Game :> es
|
||||
, Renderer (Eff es) r
|
||||
)
|
||||
=> Eff es ()
|
||||
startEngine = do
|
||||
=> r
|
||||
-> Eff es ()
|
||||
startEngine renderer = do
|
||||
gameInput
|
||||
applyVelocity'' @w
|
||||
|
||||
|
|
@ -80,12 +82,12 @@ startEngine = do
|
|||
c <- readVal @camera @RL.Camera2D
|
||||
color <- readVal @backgroundColor @RL.Color
|
||||
|
||||
beginFrame c color
|
||||
beginFrame renderer c color
|
||||
|
||||
-- getFPS >>= unsafeEff_ . print
|
||||
|
||||
AE.cmapM_ @w @(PositionComponent, BoxComponent)
|
||||
drawSprite
|
||||
(drawSprite renderer)
|
||||
-- AE.cmapM_
|
||||
-- @w
|
||||
-- @PositionComponent
|
||||
|
|
@ -93,7 +95,7 @@ startEngine = 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
|
||||
endFrame renderer
|
||||
|
||||
-- renderBoundingBoxes @w
|
||||
-- renderCollision @w
|
||||
|
|
|
|||
|
|
@ -116,7 +116,7 @@ readsCamera = do
|
|||
(pure camera)
|
||||
windowDimensions
|
||||
|
||||
runGame :: forall es. (IOE :> es, AE.ECS World :> es, State GameState :> es, Renderer :> es) => Eff (Game : es) () -> Eff es ()
|
||||
runGame :: forall es. (IOE :> es, AE.ECS World :> es, State GameState :> es) => Eff (Game : es) () -> Eff es ()
|
||||
runGame = interpret \env eff ->
|
||||
case eff of
|
||||
GameInput -> do
|
||||
|
|
@ -183,8 +183,7 @@ runGame = interpret \env eff ->
|
|||
pure ()
|
||||
|
||||
initialize
|
||||
:: (Renderer :> es)
|
||||
=> Eff es ()
|
||||
:: Eff es ()
|
||||
initialize = do
|
||||
pure ()
|
||||
|
||||
|
|
@ -197,11 +196,11 @@ main' = do
|
|||
. runGameState
|
||||
. runGameConfig
|
||||
$ gets @GameState (\s -> (s ^. windowDimensions . _x, s ^. windowDimensions . _y)) >>= \(dimX, dimY) ->
|
||||
runRaylibRenderer dimX dimY "App"
|
||||
. runGame
|
||||
$ initialize >> whileM do
|
||||
engineEnv $ startEngine @"state.camera" @"config.backgroundColor" @World
|
||||
not <$> windowShouldClose
|
||||
runGame $
|
||||
withRaylibRenderer dimX dimY "App" \renderer ->
|
||||
initialize >> whileM do
|
||||
engineEnv $ startEngine @"state.camera" @"config.backgroundColor" @World renderer
|
||||
not <$> windowShouldClose renderer
|
||||
where
|
||||
readsBackgroundColor
|
||||
:: (Reader GameConfig :> es)
|
||||
|
|
|
|||
|
|
@ -64,22 +64,23 @@ makeLensesFor
|
|||
''GameConfig
|
||||
|
||||
playerMovement
|
||||
:: forall w es
|
||||
. ( Renderer :> es
|
||||
:: forall w es r
|
||||
. ( Renderer (Eff es) r
|
||||
, AE.Get w PositionComponent
|
||||
, AE.Set w VelocityComponent
|
||||
, AE.ECS w :> es
|
||||
, Reader GameConfig :> es
|
||||
)
|
||||
=> (RL.KeyboardKey, Float)
|
||||
=> r
|
||||
-> (RL.KeyboardKey, Float)
|
||||
-> (RL.KeyboardKey, Float)
|
||||
-> Eff es AE.Entity
|
||||
-> Eff es ()
|
||||
playerMovement (up, upSpeed) (down, downSpeed) entity = do
|
||||
playerMovement renderer (up, upSpeed) (down, downSpeed) entity = do
|
||||
entity' <- entity
|
||||
|
||||
down <- isKeyDown down
|
||||
up <- isKeyDown up
|
||||
down <- isKeyDown renderer down
|
||||
up <- isKeyDown renderer up
|
||||
AE.set @w entity' $
|
||||
case (down, up) of
|
||||
(True, False) -> Velocity $ V2 0 downSpeed
|
||||
|
|
@ -111,13 +112,14 @@ ballRespawn goal1 goal2 ball = do
|
|||
ret
|
||||
|
||||
initialise
|
||||
:: ( Renderer :> es
|
||||
, State GameState :> es
|
||||
:: ( State GameState :> es
|
||||
, Reader GameConfig :> es
|
||||
, AE.ECS World :> es
|
||||
, Renderer (Eff es) r
|
||||
)
|
||||
=> Eff es ()
|
||||
initialise = do
|
||||
=> r
|
||||
-> Eff es ()
|
||||
initialise renderere = do
|
||||
-- setTargetFPS 60
|
||||
playArea <- asks @GameConfig (\s -> s.playArea)
|
||||
|
||||
|
|
@ -235,50 +237,53 @@ pongGame = do
|
|||
{ playArea = 20
|
||||
}
|
||||
-- RL.setTraceLogLevel RL.LogWarning
|
||||
runEff . AE.runECS initWorld . evalState gameState . runReader gameConfig . runRaylibRenderer gameState.dimX gameState.dimY "App" $
|
||||
initialise >> whileM do
|
||||
playerMovement @World
|
||||
(RL.KeyW, -0.2)
|
||||
(RL.KeyS, 0.2)
|
||||
(gets @GameState (\s -> s.player1))
|
||||
withRaylibRenderer gameState.dimX gameState.dimY "App" $ \renderer ->
|
||||
runEff . AE.runECS initWorld . evalState gameState . runReader gameConfig $
|
||||
initialise renderer >> whileM do
|
||||
playerMovement @World
|
||||
renderer
|
||||
(RL.KeyW, -0.2)
|
||||
(RL.KeyS, 0.2)
|
||||
(gets @GameState (\s -> s.player1))
|
||||
|
||||
playerMovement @World
|
||||
(RL.KeyUp, -0.2)
|
||||
(RL.KeyDown, 0.2)
|
||||
(gets @GameState (\s -> s.player2))
|
||||
playerMovement @World
|
||||
renderer
|
||||
(RL.KeyUp, -0.2)
|
||||
(RL.KeyDown, 0.2)
|
||||
(gets @GameState (\s -> s.player2))
|
||||
|
||||
-- ballMovement
|
||||
-- (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))
|
||||
-- ballMovement
|
||||
-- (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))
|
||||
|
||||
ballRespawn
|
||||
(gets @GameState (\s -> s.goal2))
|
||||
(gets @GameState (\s -> s.goal1))
|
||||
(gets @GameState (\s -> s.ball))
|
||||
ballRespawn
|
||||
(gets @GameState (\s -> s.goal2))
|
||||
(gets @GameState (\s -> s.goal1))
|
||||
(gets @GameState (\s -> s.ball))
|
||||
|
||||
collisionAABB @World
|
||||
applyVelocity'' @World
|
||||
resolveAABB @World
|
||||
collisionAABB @World
|
||||
applyVelocity'' @World
|
||||
resolveAABB @World
|
||||
|
||||
-- AE.cmapM_ @World @(AE.Entity, PositionComponent, CollisionComponent) \(entity, position, collision) ->
|
||||
-- when (collision.colliders /= []) $ liftIO $ print (show entity <> " with " <> show collision.colliders <> " at " <> show position)
|
||||
-- AE.cmapM_ @World @(AE.Entity, PositionComponent, CollisionComponent) \(entity, position, collision) ->
|
||||
-- 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'}
|
||||
score' <- gets @GameState (\s -> s.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
|
||||
beginFrame camera RL.white
|
||||
AE.cmapM_ @World @(PositionComponent, BoxComponent) drawSprite
|
||||
dims <- gets @GameState (\s -> (s.dimX, s.dimY))
|
||||
camera <- getCamera @World (gets @GameState (\s -> s.camera)) dims
|
||||
-- getFPS >>= unsafeEff_ . print
|
||||
beginFrame renderer camera RL.white
|
||||
AE.cmapM_ @World @(PositionComponent, BoxComponent) (drawSprite renderer)
|
||||
|
||||
-- (gets @GameState (\s -> s.score)) >>= liftIO . print
|
||||
-- (gets @GameState (\s -> s.score)) >>= liftIO . print
|
||||
|
||||
-- render @World
|
||||
-- renderOrigins @World
|
||||
-- renderBoundingBoxes @World
|
||||
not <$> windowShouldClose
|
||||
-- render @World
|
||||
-- renderOrigins @World
|
||||
-- renderBoundingBoxes @World
|
||||
not <$> windowShouldClose renderer
|
||||
|
|
|
|||
|
|
@ -152,14 +152,15 @@ initialise = do
|
|||
pure ()
|
||||
|
||||
runGame
|
||||
:: forall es
|
||||
:: forall es r
|
||||
. ( AE.ECS LocalWorld :> es
|
||||
, Renderer :> es
|
||||
, State GameState :> es
|
||||
, Renderer (Eff es) r
|
||||
)
|
||||
=> Eff (Game : es) ()
|
||||
=> r
|
||||
-> Eff (Game : es) ()
|
||||
-> Eff es ()
|
||||
runGame = interpret \_ eff ->
|
||||
runGame renderer = interpret \_ eff ->
|
||||
case eff of
|
||||
GameInput -> do
|
||||
playerEntity <- gets @GameState (\s -> s.playerEntity)
|
||||
|
|
@ -168,6 +169,7 @@ runGame = interpret \_ eff ->
|
|||
-- Nothing -> Tag 0
|
||||
-- AE.get @LocalWorld @(TagComponent Int) playerEntity >>= unsafeEff_ . print
|
||||
playerMovement @LocalWorld
|
||||
renderer
|
||||
playerEntity
|
||||
( RL.KeyA
|
||||
, RL.KeyD
|
||||
|
|
@ -178,8 +180,8 @@ runGame = interpret \_ eff ->
|
|||
|
||||
cameraEntity <- gets @GameState (\s -> s.cameraEntity)
|
||||
|
||||
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}))
|
||||
isKeyDown renderer 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}))
|
||||
pure ()
|
||||
GamePhysics -> pure ()
|
||||
GameRendering _ -> do
|
||||
|
|
@ -207,18 +209,18 @@ main' = do
|
|||
print $ perlin 0 0
|
||||
|
||||
-- RL.setTraceLogLevel RL.LogWarning
|
||||
runEff
|
||||
. AE.runECS initWorld
|
||||
. evalState gameState
|
||||
. runReader gameConfig
|
||||
. 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)
|
||||
. runGame
|
||||
$ initialise >> whileM do
|
||||
startEngine @"config.camera" @"config.backgroundColor" @LocalWorld
|
||||
not <$> windowShouldClose
|
||||
withRaylibRenderer gameState.dimX gameState.dimY "App" \renderer ->
|
||||
runEff
|
||||
. AE.runECS initWorld
|
||||
. evalState gameState
|
||||
. runReader gameConfig
|
||||
. 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)
|
||||
. runGame renderer
|
||||
$ initialise >> whileM do
|
||||
startEngine @"config.camera" @"config.backgroundColor" @LocalWorld renderer
|
||||
not <$> windowShouldClose renderer
|
||||
|
||||
pure ()
|
||||
|
|
|
|||
|
|
@ -7,14 +7,15 @@
|
|||
{-# OPTIONS_GHC -fplugin-opt=Foreign.Storable.Generic.Plugin:-v1 #-}
|
||||
{-# OPTIONS_GHC -fplugin=Foreign.Storable.Generic.Plugin #-}
|
||||
|
||||
module System.Renderer (Renderer (..), runRaylibRenderer, beginFrame, drawSprite, drawLine, isKeyDown, windowShouldClose, endFrame) where
|
||||
module System.Renderer (Renderer (..), withRaylibRenderer, 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 Control.Monad.Primitive
|
||||
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
|
||||
|
|
@ -33,77 +34,59 @@ import Raylib.Types qualified as RL
|
|||
import Raylib.Util.Colors qualified as RL
|
||||
import World
|
||||
|
||||
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
|
||||
|
||||
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
|
||||
class Renderer m a where
|
||||
beginFrame :: a -> RL.Camera2D -> RL.Color -> m ()
|
||||
drawSprite :: a -> (PositionComponent, BoxComponent) -> m ()
|
||||
drawLine :: a -> V2 Float -> V2 Float -> RL.Color -> m ()
|
||||
windowShouldClose :: a -> m Bool
|
||||
isKeyDown :: a -> RL.KeyboardKey -> m Bool
|
||||
endFrame :: a -> m ()
|
||||
|
||||
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
|
||||
data RaylibRenderer = RaylibRenderer {indexRef :: IORef Int, vectorRef :: IORef (VS.MVector (PrimState IO) RectangleInfo)}
|
||||
|
||||
withRaylibRenderer :: forall m a. (MonadIO m) => Int -> Int -> Text -> (RaylibRenderer -> m a) -> m a
|
||||
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)
|
||||
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
|
||||
go (RaylibRenderer indexRef vectorRef)
|
||||
|
||||
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
|
||||
)
|
||||
go
|
||||
instance (MonadIO m) => Renderer m RaylibRenderer where
|
||||
beginFrame (RaylibRenderer{indexRef}) camera color = do
|
||||
liftIO $ RL.getFPS >>= liftIO . print
|
||||
liftIO $ writeIORef indexRef 0
|
||||
liftIO $ RL.beginDrawing
|
||||
liftIO $ RL.clearBackground color
|
||||
liftIO $ RL.beginMode2D camera
|
||||
drawSprite (RaylibRenderer{indexRef, vectorRef}) (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 (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
|
||||
|
|
|
|||
Loading…
Reference in a new issue