pituicat/src/Scenes/Test/Update.hs

{-# 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
    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