pituicat/src/Types/PowerUp.hs

121 lines
2.1 KiB
Haskell

module Types.PowerUp where
import qualified Data.Vector as V
import Linear
-- internal imports
import Classes.Graphics.Drawable
import Classes.Graphics.Bindable
import Classes.Collectable
import Classes.Prop
import Classes.Actor
import Classes.Physics
import Types.Graphics.VertexBuffer
import Types.Texture
import Util
data PowerUp = PowerUp
{ puPos :: V2 Double
, puVel :: V2 Double
, puAcc :: V2 Double
, puTTL :: Double
, puTexture :: Texture
, puEffect :: EffectHolder
}
deriving (Show)
instance Drawable PowerUp where
toVertices (PowerUp (V2 x y) _ _ _ _ _) =
( V.fromList [0, 1, 2, 2, 3, 0]
, V.fromList
[ newVertex
(V3 (realToFrac x - 20) (realToFrac y - 20) 0)
(V4 1 1 1 1)
(V2 0 (1 - 50 / 1024))
1
, newVertex
(V3 (realToFrac x + 20) (realToFrac y - 20) 0)
(V4 1 1 1 1)
(V2 (50 / 1024) (1 - 50 / 1024))
1
, newVertex
(V3 (realToFrac x + 20) (realToFrac y + 20) 0)
(V4 1 1 1 1)
(V2 (50 / 1024) 1)
1
, newVertex
(V3 (realToFrac x - 20) (realToFrac y + 20) 0)
(V4 1 1 1 1)
(V2 0 1)
1
]
)
instance Prop PowerUp where
residentLayer _ = 0
bindPropTexture = bind . puTexture
instance Actor PowerUp where
perform dt o =
let phys = (accelerate dt . gravitate constG)
o
{ puAcc = V2 0 0
, puTTL = puTTL o - dt
}
in
phys
instance Mass PowerUp where
mass _ = 1
acceleration = puAcc
accelerationUpdater o =
(\acc -> o
{ puAcc = acc
}
)
velocity = puVel
velocityUpdater o =
(\vel -> o
{ puVel = vel
}
)
position = puPos
positionUpdater o =
(\pos -> o
{ puPos = pos
}
)
instance Collidible PowerUp where
boundary _ =
( V2 (-20) (-20)
, V2 20 20
)
collide o _ NoCollision = o
collide o other collr@(Collision ddr (V2 dirx diry)) =
let no = elasticCollision 0.5 o other collr
in
no
instance Collectable PowerUp where
effect = puEffect