pituicat/src/Scenes/Test/Update.hs

84 lines
2.1 KiB
Haskell
Raw Normal View History

{-# LANGUAGE OverloadedStrings #-}
module Scenes.Test.Update where
import Affection
import Control.Concurrent.STM
import qualified Data.Vector as V
import Data.String (fromString)
-- internal imports
import Scenes.Test.Types
import Classes
import Types
update
:: Test
-> Double
-> Affection ()
update level dt = liftIO $ do
logIO Debug ("FPS: " <> fromString (show $ 1 / dt))
-- Let all Actors update themselves and check for collisions
-- (Typeclasses rock!)
atomically $ do
lmap <- readTMVar (testMap level)
let layer = mapLayers lmap V.! fromIntegral (mapWalkLayer lmap)
modifyTVar
(testCast level) $ \cast ->
let playedCast =
V.map
(\(Cast c) -> Cast (perform dt c))
cast
collidedCast =
(\(Cast c1) (Cast c2) ->
Cast $
if collisionCheck dt c1 c2
then collide c1 c2
else c1
)
<$> playedCast <*> playedCast
wallCast (Cast c) = Cast $
V.foldl
(\member tile ->
if collisionCheck dt member tile
then collide member tile
else member
)
c
layer
walledCast =
V.map wallCast collidedCast
in
V.map
(\(Cast c) -> Cast $
move dt c
)
walledCast
2021-01-11 23:51:58 +00:00
updatedCast <- readTVar (testCast level)
modifyTVar
(testPlayer level) $ \(Just pituicat) ->
let playedCat = perform dt pituicat
collidedCat =
V.foldl
(\cat (Cast c) ->
if collisionCheck dt cat c
then collide cat c
else cat
)
playedCat
updatedCast
walledCat =
V.foldl
(\cat tile ->
if collisionCheck dt cat tile
then collide cat tile
else cat
)
collidedCat
layer
in Just $ move dt walledCat