{-# 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.Prop import Classes.Actor import Classes.Collectable import Graphics.Classes.Drawable import Graphics.Classes.Bindable import Graphics.Types.VertexBuffer import Graphics.Types.Texture import Physics.Classes 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 , pcViewDirection :: ViewDirection , pcEffects :: [EffectHolder] , pcXColl :: Bool } deriving (Eq, Show) data ViewDirection = ViewLeft | ViewRight deriving (Eq, Show) instance Drawable Pituicat where toVertices (Pituicat (V2 x y) _ _ _ _ _ _ _ _ vd _ _) = ( V.fromList [0, 1, 2, 2, 3, 0] , V.fromList [ newVertex (V3 (realToFrac x - 25) (realToFrac y - 25) 0) (V4 1 1 1 1) (if vd == ViewRight then V2 0 (1 - 50 / 1024) else V2 (50 / 1024) (1 - 50 / 1024) ) 1 , newVertex (V3 (realToFrac x + 25) (realToFrac y - 25) 0) (V4 1 1 1 1) (if vd == ViewRight then V2 (50 / 1024) (1 - 50 / 1024) else V2 0 (1 - 50 / 1024) ) 1 , newVertex (V3 (realToFrac x + 25) (realToFrac y + 25) 0) (V4 1 1 1 1) (if vd == ViewRight then V2 (50 / 1024) 1 else V2 0 1 ) 1 , newVertex (V3 (realToFrac x - 25) (realToFrac y + 25) 0) (V4 1 1 1 1) (if vd == ViewRight then V2 0 1 else V2 (50 / 1024) 1 ) 1 ] ) instance Prop Pituicat where residentLayer _ = 0 bindPropTexture = bind . pcTexture instance Actor Pituicat where perform dt p = let (V2 _ dy) = velocity physCat moveFact = if not (any ((SpeedUp ==) . effectReleased) (pcEffects p)) then 1 else 2 physCat = (accelerate dt . gravitate constG) (p { pcAcc = V2 0 0 , pcTMoveVel = case pcMoveState p of Just MoveRight -> V2 (catMoveVelocity * moveFact) 0 Just MoveLeft -> V2 ((-catMoveVelocity) * moveFact) 0 _ -> V2 0 0 } ) finalCat = physCat { pcMoveVel = lerp (min 0.95 (60 * dt)) (pcMoveVel physCat) (pcTMoveVel physCat) , pcGrounded = pcGrounded physCat && abs dy * dt <= 2 , pcPos = pcPos physCat + if not (pcXColl physCat) then ((dt *) <$> pcMoveVel physCat) else V2 0 0 , pcEffects = foldl (\acc eff -> let nduration = effectDuration eff - dt in if nduration > 0 then eff { effectDuration = nduration} : acc else acc ) [] (pcEffects p) } in A.log A.Debug ("*meow* am at: " <> fromString (show $ position finalCat)) (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 mass _ = 100 acceleration = pcAcc accelerationUpdater cat = \accel -> cat { pcAcc = accel } velocity = pcVel velocityUpdater cat = \vel -> cat { pcVel = vel } position = pcPos positionUpdater cat = \pos -> cat { pcPos = pos } instance Collidible Pituicat where boundary cat = if pcViewDirection cat == ViewRight then ( V2 (-18) (-25) , V2 25 15 ) else ( V2 (-25) (-25) , V2 18 15 ) 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) -- in -- ncat -- { pcVel = nvel * fact -- , pcMoveVel = pcMoveVel ncat * fact -- , pcTMoveVel = pcTMoveVel ncat * fact -- , pcGrounded = grounded -- } 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 }