pituicat/src/Types/Player.hs

230 lines
5.6 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.Prop
import Classes.Actor
2021-04-29 04:09:32 +00:00
import Classes.Collectable
2020-12-23 06:47:20 +00:00
import Graphics.Classes.Drawable
import Graphics.Classes.Bindable
import Graphics.Types.VertexBuffer
import Graphics.Types.Texture
import Physics.Classes
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-05-01 20:16:06 +00:00
{ pcPos :: V2 Double
, pcVel :: V2 Double
, pcMoveVel :: V2 Double
, pcTMoveVel :: V2 Double
, pcAcc :: V2 Double
, pcHealth :: Int
, pcTexture :: Texture
, pcGrounded :: Bool
, pcMoveState :: Maybe Action
, pcViewDirection :: ViewDirection
, pcEffects :: [EffectHolder]
2021-07-24 07:35:41 +00:00
, pcXColl :: Bool
2020-12-23 06:47:20 +00:00
}
deriving (Eq, Show)
2020-12-23 06:47:20 +00:00
2021-05-01 20:16:06 +00:00
data ViewDirection = ViewLeft | ViewRight
deriving (Eq, Show)
2020-12-23 06:47:20 +00:00
instance Drawable Pituicat where
2021-07-24 07:35:41 +00:00
toVertices (Pituicat (V2 x y) _ _ _ _ _ _ _ _ vd _ _) =
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)
2021-05-01 20:16:06 +00:00
(if vd == ViewRight
2021-04-29 19:02:41 +00:00
then V2 0 (1 - 50 / 1024)
else V2 (50 / 1024) (1 - 50 / 1024)
)
2020-12-23 06:47:20 +00:00
1
, newVertex
(V3 (realToFrac x + 25) (realToFrac y - 25) 0)
2020-12-23 16:16:30 +00:00
(V4 1 1 1 1)
2021-05-01 20:16:06 +00:00
(if vd == ViewRight
2021-04-29 19:02:41 +00:00
then V2 (50 / 1024) (1 - 50 / 1024)
else V2 0 (1 - 50 / 1024)
)
2020-12-23 06:47:20 +00:00
1
, newVertex
(V3 (realToFrac x + 25) (realToFrac y + 25) 0)
2020-12-23 16:16:30 +00:00
(V4 1 1 1 1)
2021-05-01 20:16:06 +00:00
(if vd == ViewRight
2021-04-29 19:02:41 +00:00
then V2 (50 / 1024) 1
else V2 0 1
)
2020-12-23 06:47:20 +00:00
1
, newVertex
(V3 (realToFrac x - 25) (realToFrac y + 25) 0)
2020-12-23 16:16:30 +00:00
(V4 1 1 1 1)
2021-05-01 20:16:06 +00:00
(if vd == ViewRight
2021-04-29 19:02:41 +00:00
then V2 0 1
else V2 (50 / 1024) 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
2021-04-29 04:09:32 +00:00
moveFact =
if
2021-07-24 01:33:00 +00:00
not (any ((SpeedUp ==) . effectReleased) (pcEffects p))
2021-04-29 04:09:32 +00:00
then 1
else 2
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-04-29 04:09:32 +00:00
Just MoveRight -> V2 (catMoveVelocity * moveFact) 0
Just MoveLeft -> V2 ((-catMoveVelocity) * moveFact) 0
2021-01-17 01:30:45 +00:00
_ -> 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)
2021-07-24 01:33:00 +00:00
, pcGrounded = pcGrounded physCat && abs dy * dt <= 2
2021-07-24 07:35:41 +00:00
, pcPos = pcPos physCat + if not (pcXColl physCat)
then ((dt *) <$> pcMoveVel physCat)
else V2 0 0
2021-04-29 04:09:32 +00:00
, pcEffects =
foldl
(\acc eff ->
let nduration = effectDuration eff - dt
in
if nduration > 0
then
eff { effectDuration = nduration} : acc
else
acc
)
[]
(pcEffects p)
2021-01-11 23:51:58 +00:00
}
in
2021-07-24 01:33:00 +00:00
A.log A.Debug ("*meow* am at: " <> fromString (show $ position finalCat))
2021-05-01 20:27:18 +00:00
(finalCat
{ pcViewDirection = if pcGrounded finalCat
then
case pcMoveState finalCat of
Just MoveRight -> ViewRight
Just MoveLeft -> ViewLeft
_ -> pcViewDirection finalCat
else
pcViewDirection finalCat
}
)
instance Mass Pituicat where
2021-07-08 16:45:02 +00:00
mass _ = 100
acceleration = pcAcc
accelerationUpdater cat =
2021-07-24 01:33:00 +00:00
\accel -> cat
{ pcAcc = accel
}
2021-07-24 07:35:41 +00:00
velocity =
pcVel
velocityUpdater cat =
2021-07-24 07:35:41 +00:00
\vel -> cat
{ pcVel = vel
}
position = pcPos
positionUpdater cat =
2021-07-24 01:33:00 +00:00
\pos -> cat
{ pcPos = pos
}
instance Collidible Pituicat where
2021-05-01 20:16:06 +00:00
boundary cat =
if pcViewDirection cat == ViewRight
then
( V2 (-18) (-25)
, V2 25 15
)
else
( V2 (-25) (-25)
, V2 18 15
)
2021-07-24 07:35:41 +00:00
collide cat [] _ = cat
{ pcXColl = False
}
collide cat collrs@((_, NoCollision):_) _ = cat
{ pcXColl = any
(\(_, Collision _ (V2 cx _)) -> cx /= 0)
(filter ((NoCollision /= ) . snd) collrs)
}
collide cat collrs@(collr@((other, Collision ddt (V2 dirx diry))):_) dt =
-- let ncat = elasticCollision 0.3 cat other collr
-- nvel@(V2 _ vy) = pcVel ncat
-- grounded = diry == -1 && abs (vy * ddt) < 2
-- fact = fromIntegral <$> V2
-- (1 - abs dirx)
-- (if diry /= -1 && quadrance nvel > bounceThreshold then 1 else 0)
2021-07-24 01:33:00 +00:00
-- in
-- ncat
2021-07-24 07:35:41 +00:00
-- { pcVel = nvel * fact
-- , pcMoveVel = pcMoveVel ncat * fact
-- , pcTMoveVel = pcTMoveVel ncat * fact
-- , pcGrounded = grounded
2021-07-24 01:33:00 +00:00
-- }
2021-07-24 07:35:41 +00:00
let ncat = elasticCollision 0.3 cat collr dt
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 =
diry == -1 && abs (vy * ddt) < 2
in
ncat
{ pcGrounded = grounded
, pcXColl = any
(\(_, Collision _ (V2 cx _)) -> cx /= 0)
(filter ((NoCollision /=) . snd) collrs) || dirx /= 0
}