182 lines
4 KiB
Haskell
182 lines
4 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
module Types.Player where
|
|
|
|
import Affection as A
|
|
|
|
import Linear
|
|
|
|
import qualified Data.Vector as V
|
|
|
|
import Data.String (fromString)
|
|
|
|
-- internal imports
|
|
|
|
import Util
|
|
|
|
import Classes.Graphics.Drawable
|
|
import Classes.Graphics.Bindable
|
|
import Classes.Prop
|
|
import Classes.Actor
|
|
import Classes.Physics
|
|
|
|
import Types.Graphics.VertexBuffer
|
|
import Types.Texture
|
|
import Types.Subsystems
|
|
|
|
catMoveVelocity :: Double
|
|
catMoveVelocity = 100
|
|
|
|
data Pituicat = Pituicat
|
|
{ pcPos :: V2 Double
|
|
, pcVel :: V2 Double
|
|
, pcMoveVel :: V2 Double
|
|
, pcTMoveVel :: V2 Double
|
|
, pcAcc :: V2 Double
|
|
, pcHealth :: Int
|
|
, pcTexture :: Texture
|
|
, pcGrounded :: Bool
|
|
, pcMoveState :: Maybe Action
|
|
}
|
|
deriving (Eq, Show)
|
|
|
|
instance Drawable Pituicat where
|
|
|
|
toVertices (Pituicat (V2 x y) _ _ _ _ _ _ _ _) =
|
|
( V.fromList [0, 1, 2, 2, 3, 0]
|
|
, V.fromList
|
|
[ newVertex
|
|
(V3 (realToFrac x - 25) (realToFrac y - 25) 0)
|
|
(V4 1 1 1 1)
|
|
(V2 0 (1 - 50 / 1024))
|
|
1
|
|
, newVertex
|
|
(V3 (realToFrac x + 25) (realToFrac y - 25) 0)
|
|
(V4 1 1 1 1)
|
|
(V2 (50 / 1024) (1 - 50 / 1024))
|
|
1
|
|
, newVertex
|
|
(V3 (realToFrac x + 25) (realToFrac y + 25) 0)
|
|
(V4 1 1 1 1)
|
|
(V2 (50 / 1024) 1)
|
|
1
|
|
, newVertex
|
|
(V3 (realToFrac x - 25) (realToFrac y + 25) 0)
|
|
(V4 1 1 1 1)
|
|
(V2 0 1)
|
|
1
|
|
]
|
|
)
|
|
|
|
instance Prop Pituicat where
|
|
|
|
residentLayer _ = 0
|
|
|
|
bindPropTexture = bind . pcTexture
|
|
|
|
instance Actor Pituicat where
|
|
|
|
perform dt p =
|
|
let (V2 _ dy) = velocity physCat
|
|
physCat = (accelerate dt . gravitate constG)
|
|
(p
|
|
{ pcAcc = 0
|
|
, pcTMoveVel =
|
|
case pcMoveState p of
|
|
Just MoveRight -> V2 catMoveVelocity 0
|
|
Just MoveLeft -> V2 (-catMoveVelocity) 0
|
|
_ -> V2 0 0
|
|
}
|
|
)
|
|
finalCat = physCat
|
|
{ pcMoveVel =
|
|
lerp (min 0.95 (60 * dt)) (pcMoveVel physCat) (pcTMoveVel physCat)
|
|
, pcGrounded = if pcGrounded physCat
|
|
then not (abs dy * dt > 2)
|
|
else False
|
|
}
|
|
in
|
|
finalCat
|
|
|
|
instance Mass Pituicat where
|
|
|
|
mass _ = 1
|
|
|
|
acceleration = pcAcc
|
|
|
|
accelerationUpdater cat =
|
|
(\accel -> cat
|
|
{ pcAcc = accel
|
|
}
|
|
)
|
|
|
|
velocity cat = pcVel cat + pcMoveVel cat
|
|
|
|
velocityUpdater cat =
|
|
(\vel@(V2 vx vy) ->
|
|
let
|
|
(V2 mx my) = pcMoveVel cat
|
|
nvel = V2
|
|
(if abs mx > abs vx
|
|
then 0
|
|
else (signum vx) * (abs vx - abs mx)
|
|
)
|
|
(if abs my > abs vy
|
|
then 0
|
|
else (signum vy) * (abs vy - abs my)
|
|
)
|
|
in
|
|
cat
|
|
{ pcVel = nvel
|
|
}
|
|
)
|
|
|
|
position = pcPos
|
|
|
|
positionUpdater cat =
|
|
(\pos -> cat
|
|
{ pcPos = pos
|
|
}
|
|
)
|
|
|
|
instance Collidible Pituicat where
|
|
|
|
boundary _ =
|
|
( V2 (-25) (-25)
|
|
, V2 25 25
|
|
)
|
|
|
|
collide cat _ NoCollision = cat
|
|
collide cat other collr@(Collision ddt (V2 dirx diry)) =
|
|
let ncat = (elasticCollision 0.3 cat other collr)
|
|
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))
|
|
grounded =
|
|
(vy * ddt) >= 0 &&
|
|
(vy * ddt) < 5 && diry == -1
|
|
in
|
|
A.log
|
|
Debug
|
|
("*boing* meow! collision result: " <>
|
|
fromString (show collr) <>
|
|
"\nother: " <>
|
|
fromString (show other)
|
|
)
|
|
(
|
|
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
|
|
}
|
|
)
|