pituicat/src/Types/Player.hs

114 lines
2.1 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module Types.Player where
import Affection as A
import qualified Graphics.Rendering.OpenGL as GL
import Linear
import qualified Data.Vector as V
import Data.String (fromString)
-- internal imports
import Classes.Graphics.Drawable
import Classes.Graphics.Bindable
import Classes.Prop
import Classes.Actor
import Classes.Physics
import Types.Graphics.VertexBuffer
import Types.Texture
data Pituicat = Pituicat
{ pcPos :: V2 Double
, pcVel :: V2 Double
, pcAcc :: V2 Double
, pcHealth :: Int
, pcTexture :: Texture
}
deriving (Eq, Show)
instance Drawable Pituicat where
toVertices (Pituicat pos@(V2 x y) _ _ _ tex) =
( 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 = (A.log Debug ("moving from " <> fromString (show $ pcPos p)))
(move dt . accelerate dt . gravitate (V2 0 (-250))) (p {pcAcc = 0})
instance Mass Pituicat where
mass _ = 1
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 _ =
( V2 (-25) (-25)
, V2 25 25
)
collide cat other =
A.log
Debug
("*boing* meow! other: " <>
fromString (show other))
(elasticCollision 0.1 cat other)