61 lines
1.4 KiB
Haskell
61 lines
1.4 KiB
Haskell
|
{-# 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
|