pituicat/src/Scenes/Test/EventHandler.hs

53 lines
1.4 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module Scenes.Test.EventHandler where
import Affection as A
import qualified SDL
import Linear
import Control.Concurrent.STM
import Data.String (fromString)
-- internal imports
import Types
import Scenes.Test.Types
singleHandler
:: Test
-> TranslatorMessage
-> Affection ()
singleHandler level event = do
let multiplier = if tmKeyMotion event == SDL.Pressed then 1 else 0
changeDirection cat state dirVel =
Just cat
{ pcMoveState = if multiplier > 0 then Just state else Nothing
, pcVel = if multiplier > 0
then pcVel cat + V2 dirVel 0
else
let (V2 vx vy) = pcVel cat
in
if abs vx - dirVel < 0
then V2 0 vy
else V2 (vx - dirVel) vy
}
liftIO $ atomically $ modifyTVar (testPlayer level) (\(Just pituicat) ->
A.log Debug ("Grounded: " <> fromString (show $ pcGrounded pituicat)) $
case tmAction event of
Jump -> if multiplier > 0 && pcGrounded pituicat
then A.log Debug "jumping"
(Just pituicat
{ pcVel = pcVel pituicat + V2 0 300
, pcGrounded = False
}
)
else
Just pituicat
MoveRight -> changeDirection pituicat MoveRight catMoveVelocity
MoveLeft -> changeDirection pituicat MoveLeft (-catMoveVelocity)
_ -> Just pituicat
)