pituicat/src/Types/Player.hs

174 lines
3.8 KiB
Haskell
Raw Normal View History

{-# LANGUAGE OverloadedStrings #-}
2020-12-23 06:47:20 +00:00
module Types.Player where
import Affection as A
2020-12-23 06:47:20 +00:00
import Linear
import qualified Data.Vector as V
import Data.String (fromString)
2020-12-23 06:47:20 +00:00
-- internal imports
2021-01-11 23:53:00 +00:00
import Util
2020-12-23 06:47:20 +00:00
import Classes.Graphics.Drawable
import Classes.Graphics.Bindable
import Classes.Prop
import Classes.Actor
import Classes.Physics
2020-12-23 06:47:20 +00:00
import Types.Graphics.VertexBuffer
import Types.Texture
2021-01-12 02:12:02 +00:00
import Types.Subsystems
catMoveVelocity :: Double
2021-01-17 01:30:45 +00:00
catMoveVelocity = 100
2020-12-23 06:47:20 +00:00
data Pituicat = Pituicat
2021-01-12 02:12:02 +00:00
{ pcPos :: V2 Double
, pcVel :: V2 Double
2021-01-14 22:08:24 +00:00
, pcMoveVel :: V2 Double
2021-01-17 01:30:45 +00:00
, pcTMoveVel :: V2 Double
2021-01-12 02:12:02 +00:00
, pcAcc :: V2 Double
, pcHealth :: Int
, pcTexture :: Texture
, pcGrounded :: Bool
2021-04-20 02:19:54 +00:00
, pcMoveState :: Maybe Action
2020-12-23 06:47:20 +00:00
}
deriving (Eq, Show)
2020-12-23 06:47:20 +00:00
instance Drawable Pituicat where
2021-01-17 01:30:45 +00:00
toVertices (Pituicat (V2 x y) _ _ _ _ _ _ _ _) =
2020-12-23 06:47:20 +00:00
( V.fromList [0, 1, 2, 2, 3, 0]
, V.fromList
[ newVertex
(V3 (realToFrac x - 25) (realToFrac y - 25) 0)
2020-12-23 16:16:30 +00:00
(V4 1 1 1 1)
2020-12-23 06:47:20 +00:00
(V2 0 (1 - 50 / 1024))
1
, newVertex
(V3 (realToFrac x + 25) (realToFrac y - 25) 0)
2020-12-23 16:16:30 +00:00
(V4 1 1 1 1)
2020-12-23 06:47:20 +00:00
(V2 (50 / 1024) (1 - 50 / 1024))
1
, newVertex
(V3 (realToFrac x + 25) (realToFrac y + 25) 0)
2020-12-23 16:16:30 +00:00
(V4 1 1 1 1)
2020-12-23 06:47:20 +00:00
(V2 (50 / 1024) 1)
1
, newVertex
(V3 (realToFrac x - 25) (realToFrac y + 25) 0)
2020-12-23 16:16:30 +00:00
(V4 1 1 1 1)
2020-12-23 15:39:45 +00:00
(V2 0 1)
2020-12-23 06:47:20 +00:00
1
]
)
instance Prop Pituicat where
residentLayer _ = 0
bindPropTexture = bind . pcTexture
instance Actor Pituicat where
2021-01-11 23:51:58 +00:00
perform dt p =
let (V2 _ dy) = velocity physCat
physCat = (accelerate dt . gravitate constG)
2021-01-17 01:30:45 +00:00
(p
2021-04-20 02:19:54 +00:00
{ pcAcc = V2 0 0
2021-01-17 01:30:45 +00:00
, pcTMoveVel =
2021-04-17 09:33:28 +00:00
case pcMoveState p of
2021-01-17 01:30:45 +00:00
Just MoveRight -> V2 catMoveVelocity 0
Just MoveLeft -> V2 (-catMoveVelocity) 0
_ -> V2 0 0
}
)
2021-01-11 23:51:58 +00:00
finalCat = physCat
2021-01-17 01:30:45 +00:00
{ pcMoveVel =
2021-04-17 09:33:28 +00:00
lerp (min 0.95 (60 * dt)) (pcMoveVel physCat) (pcTMoveVel physCat)
, pcGrounded = if pcGrounded physCat
then not (abs dy * dt > 2)
else False
2021-01-11 23:51:58 +00:00
}
in
A.log A.Debug ("*meow* am at: " <> (fromString $ show $ pcPos finalCat)) finalCat
instance Mass Pituicat where
mass _ = 1
acceleration = pcAcc
accelerationUpdater cat =
(\accel -> cat
{ pcAcc = accel
}
)
2021-01-14 22:08:24 +00:00
velocity cat = pcVel cat + pcMoveVel cat
velocityUpdater cat =
2021-01-17 01:30:45 +00:00
(\vel@(V2 vx vy) ->
2021-04-17 09:33:28 +00:00
let
(V2 mx my) = pcMoveVel cat
nvel = V2
(if abs mx > abs vx
2021-01-17 01:30:45 +00:00
then 0
2021-04-17 09:33:28 +00:00
else (signum vx) * (abs vx - abs mx)
)
(if abs my > abs vy
2021-01-17 01:30:45 +00:00
then 0
2021-04-17 09:33:28 +00:00
else (signum vy) * (abs vy - abs my)
)
2021-01-17 01:30:45 +00:00
in
cat
2021-04-17 09:33:28 +00:00
{ pcVel = nvel
2021-01-17 01:30:45 +00:00
}
)
position = pcPos
positionUpdater cat =
(\pos -> cat
{ pcPos = pos
}
)
instance Collidible Pituicat where
boundary _ =
( V2 (-25) (-25)
, V2 25 25
)
2021-01-17 01:30:45 +00:00
collide cat _ NoCollision = cat
2021-01-17 19:29:27 +00:00
collide cat other collr@(Collision ddt (V2 dirx diry)) =
2021-01-19 20:46:17 +00:00
let ncat = (elasticCollision 0.3 cat other collr)
2021-04-17 09:33:28 +00:00
vel@(V2 vx vy) = velocity ncat
moveVel@(V2 mx my) = pcMoveVel cat
nvel = V2
(if abs mx > abs vx
then 0
else (signum vx) * (abs vx - abs mx)
)
((\(V2 _ y) -> y) (if diry /= 0 then pcVel ncat else pcVel cat))
2021-01-19 20:46:17 +00:00
grounded =
2021-04-17 09:33:28 +00:00
(vy * ddt) >= 0 &&
(vy * ddt) < 5 && diry == -1
2021-01-19 20:46:17 +00:00
in
ncat
{ pcGrounded = grounded
, pcMoveVel = pcMoveVel ncat *
if dirx /= 0
then V2 0 1
else V2 1 1
, pcVel = nvel *
if dirx /= 0
then V2 0 1
else V2 1 1
}