{-# 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 physCat of Just MoveRight -> V2 catMoveVelocity 0 Just MoveLeft -> V2 (-catMoveVelocity) 0 _ -> V2 0 0 } ) finalCat = physCat { pcMoveVel = lerp (min 0.95 (59 * 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 nx = if abs mx > abs vx then 0 else vx - mx ny = if abs my > abs vy then 0 else vy - my in cat { pcVel = (V2 nx ny) } ) 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 cat nvel@(V2 dx dy) = velocity ncat grounded = (dy * ddt) >= 0 && (dy * 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 , pcTMoveVel = pcTMoveVel ncat * if dirx /= 0 then V2 0 1 else V2 1 1 , pcVel = pcVel ncat * if dirx /= 0 then V2 0 1 else V2 1 1 } )