pituicat/src/Scenes/Test/Update.hs

170 lines
5.1 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Scenes.Test.Update where
import Affection as A
import Control.Concurrent.STM
import qualified Data.Vector as V
import Data.Maybe
import Data.String (fromString)
import Linear
-- 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 =
V.map
(\(Cast c1) ->
let partners = V.foldl
(\acc@(Cast _, ires) (Cast c2) ->
let res = collisionCheck dt c1 c2
in
if res /= NoCollision &&
collisionTime res < collisionTime ires
then (Cast c2, res)
else acc
)
(Cast c1, NoCollision)
playedCast
in
if null partners
then Cast c1
else
uncurry
(\(Cast c2) result -> Cast $ collide c1 c2 result)
partners
)
playedCast
wallCast (Cast c) =
Cast $ performWorldCollision c layer dt
walledCast =
V.map wallCast collidedCast
in
V.map
(\(Cast c) -> Cast $
move dt c
)
walledCast
updatedCast <- readTVar (testCast level)
oldCat <- fromJust <$> readTVar (testPlayer level)
releasedEffects <- stateTVar (testPowerups level) $ \pus ->
let living = V.foldl
(\acc pu ->
let npu = perform dt pu
in
if puTTL npu > 0
then npu `V.cons` acc
else acc
)
V.empty
pus
indexCollected = V.filter ((/= NoCollision) . snd) $
V.zip (V.fromList [0..length living])
(V.map
(collisionCheck dt oldCat)
living
)
collected = V.foldl
(\acc (ind, _) ->
(living V.! ind) `V.cons` acc
)
V.empty
indexCollected
differ = V.foldl
(\acc life -> if life `V.elem` collected
then acc
else life `V.cons` acc
)
V.empty
living
fin = V.map
(\pu -> move dt $ performWorldCollision pu layer dt)
differ
in
(collected, fin)
modifyTVar
(testPlayer level) $ \(Just pituicat) ->
let playedCat = perform dt pituicat
castCat =
let allPartners = V.zip (V.fromList [0..V.length updatedCast])
(V.map
(\(Cast c) -> collisionCheck dt playedCat c)
updatedCast
)
filtered = (V.filter ((/= NoCollision) . snd) allPartners)
partner = V.minimumBy
(\(_, e) (_, f) -> collisionTime e `compare` collisionTime f)
filtered
in
if V.null filtered
then
playedCat
else
uncurry
(\(Cast c) cr -> collide playedCat c cr)
(updatedCast V.! fst partner, snd partner)
walledCat = performWorldCollision castCat layer dt
affectedCat = walledCat
{ pcEffects = pcEffects walledCat ++
map puEffect (V.toList releasedEffects)
}
in Just $ move dt affectedCat
performWorldCollision
:: (Collidible c)
=> c -- ^ Cast member to check
-> Layer -- ^ The walk layer of the level
-> Double -- ^ Tick length
-> c -- ^ Updated cast member
performWorldCollision c layer dt =
let partner = V.foldl
(\acc@(part, cr) tile ->
let res = collisionCheck dt c tile
ret = if cr == NoCollision && res == NoCollision
then
acc
else
if cr == NoCollision && res /= NoCollision
then (tile, res)
else
if cr /= NoCollision && res == NoCollision
then
acc
else
if collisionTime cr < collisionTime res
then acc
else (tile, res)
in
ret
)
(V.head layer, collisionCheck dt c $ V.head layer)
layer
in
uncurry (collide c) partner