Compare commits
16 Commits
927d7af132
...
61451a4a10
Author | SHA1 | Date |
---|---|---|
nek0 | 61451a4a10 | |
nek0 | 03a577fd18 | |
nek0 | 6f816eedef | |
nek0 | 3079ee74e1 | |
nek0 | 21df43b773 | |
nek0 | 370d6def45 | |
nek0 | 9e04a4fddb | |
nek0 | d095569911 | |
nek0 | 5a15be6eef | |
nek0 | b51248e7e7 | |
nek0 | 310105ed48 | |
nek0 | 2ec22ea6b0 | |
nek0 | 039d567be8 | |
nek0 | 083ef004cd | |
nek0 | f3a70c100f | |
nek0 | 7456840238 |
|
@ -24,6 +24,7 @@ executable pituicat
|
||||||
, Types.Texture
|
, Types.Texture
|
||||||
, Types.Cast
|
, Types.Cast
|
||||||
, Types.StageSet
|
, Types.StageSet
|
||||||
|
, Types.Tangible
|
||||||
, Types.Graphics
|
, Types.Graphics
|
||||||
, Types.Graphics.VertexArray
|
, Types.Graphics.VertexArray
|
||||||
, Types.Graphics.VertexBuffer
|
, Types.Graphics.VertexBuffer
|
||||||
|
@ -31,10 +32,12 @@ executable pituicat
|
||||||
, Types.Graphics.Shader
|
, Types.Graphics.Shader
|
||||||
, Types.Util
|
, Types.Util
|
||||||
, Types.Player
|
, Types.Player
|
||||||
|
, Types.PowerUp
|
||||||
, Classes
|
, Classes
|
||||||
, Classes.Scene
|
, Classes.Scene
|
||||||
, Classes.Actor
|
, Classes.Actor
|
||||||
, Classes.Prop
|
, Classes.Prop
|
||||||
|
, Classes.Collectable
|
||||||
, Classes.Graphics
|
, Classes.Graphics
|
||||||
, Classes.Graphics.Bindable
|
, Classes.Graphics.Bindable
|
||||||
, Classes.Graphics.Buffer
|
, Classes.Graphics.Buffer
|
||||||
|
|
|
@ -7,3 +7,4 @@ import Classes.Scene as C
|
||||||
import Classes.Prop as C
|
import Classes.Prop as C
|
||||||
import Classes.Actor as C
|
import Classes.Actor as C
|
||||||
import Classes.Physics as C
|
import Classes.Physics as C
|
||||||
|
import Classes.Collectable as C
|
||||||
|
|
|
@ -0,0 +1,27 @@
|
||||||
|
module Classes.Collectable where
|
||||||
|
|
||||||
|
import Classes.Physics.Collidible (Collidible)
|
||||||
|
|
||||||
|
-- | All kinds of Effects present in the game
|
||||||
|
data Effect
|
||||||
|
= HealthUp
|
||||||
|
| SpeedUp
|
||||||
|
| JumpUp
|
||||||
|
| ArmorUp
|
||||||
|
| Antidote
|
||||||
|
| StopTime
|
||||||
|
| Invisibility
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
-- | The Effect holder type definition
|
||||||
|
data EffectHolder = EffectHolder
|
||||||
|
{ effectDuration :: Double -- ^ Duration of stored effect
|
||||||
|
, effectReleased :: Effect -- ^ The actual effect released
|
||||||
|
}
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
class Collidible c => Collectable c where
|
||||||
|
|
||||||
|
effect
|
||||||
|
:: c -- ^ Collectable object
|
||||||
|
-> EffectHolder -- ^ The descriptor of the effect contained
|
|
@ -139,13 +139,17 @@ class (Show c, Mass c) => Collidible c where
|
||||||
Collision tx (V2 (floor $ signum d1x) 0)
|
Collision tx (V2 (floor $ signum d1x) 0)
|
||||||
(_, True, True, False, True) ->
|
(_, True, True, False, True) ->
|
||||||
Collision ty (V2 0 (floor $ signum d1y))
|
Collision ty (V2 0 (floor $ signum d1y))
|
||||||
|
(True, _, True, False, _) ->
|
||||||
|
NoCollision
|
||||||
|
(_, True, False, _, False) ->
|
||||||
|
NoCollision
|
||||||
(_, _, _, False, False) ->
|
(_, _, _, False, False) ->
|
||||||
NoCollision
|
NoCollision
|
||||||
|
x -> error $
|
||||||
|
"Unhandled combination of collision check results: "
|
||||||
|
<> (fromString $ show x)
|
||||||
in
|
in
|
||||||
A.log A.Debug
|
res
|
||||||
(fromString $
|
|
||||||
show (tx < dt, ty < dt, tx < ty, coll True, coll False))
|
|
||||||
res
|
|
||||||
else
|
else
|
||||||
NoCollision
|
NoCollision
|
||||||
|
|
||||||
|
|
|
@ -4,7 +4,7 @@ module Classes.Prop where
|
||||||
|
|
||||||
import Classes.Graphics.Drawable
|
import Classes.Graphics.Drawable
|
||||||
|
|
||||||
class (Drawable a) => Prop a where
|
class (Show a, Drawable a) => Prop a where
|
||||||
|
|
||||||
residentLayer :: a -> Word
|
residentLayer :: a -> Word
|
||||||
|
|
||||||
|
|
|
@ -10,6 +10,8 @@ import Linear
|
||||||
import qualified Data.Vector.Storable as VS
|
import qualified Data.Vector.Storable as VS
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
|
|
||||||
|
import Data.String (fromString)
|
||||||
|
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
|
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
|
@ -35,6 +37,7 @@ instance Scene Test where
|
||||||
<*> newTVarIO Nothing
|
<*> newTVarIO Nothing
|
||||||
<*> newTVarIO V.empty
|
<*> newTVarIO V.empty
|
||||||
<*> newTVarIO V.empty
|
<*> newTVarIO V.empty
|
||||||
|
<*> newTVarIO V.empty
|
||||||
<*> newTVarIO (PVM identity identity identity)
|
<*> newTVarIO (PVM identity identity identity)
|
||||||
<*> newTVarIO []
|
<*> newTVarIO []
|
||||||
|
|
||||||
|
@ -53,8 +56,11 @@ instance Scene Test where
|
||||||
|
|
||||||
stageSet <- readTVarIO (testStageSet level)
|
stageSet <- readTVarIO (testStageSet level)
|
||||||
nonPlayerCast <- readTVarIO (testCast level)
|
nonPlayerCast <- readTVarIO (testCast level)
|
||||||
pituicat <- atomically $ readTVar (testPlayer level)
|
powerups <- (V.map Cast) <$> (readTVarIO (testPowerups level))
|
||||||
let cast = Cast (fromJust pituicat) `V.cons` nonPlayerCast
|
A.logIO A.Debug (fromString $ V.foldl (\acc (Cast p) -> acc ++ show p ++ " ") "" powerups)
|
||||||
|
pituicat <- readTVarIO (testPlayer level)
|
||||||
|
let cast = Cast (fromJust pituicat) `V.cons` powerups V.++
|
||||||
|
nonPlayerCast
|
||||||
playerPos@(V2 px py) = realToFrac <$> (pcPos $ fromJust pituicat)
|
playerPos@(V2 px py) = realToFrac <$> (pcPos $ fromJust pituicat)
|
||||||
|
|
||||||
atomically $ modifyTVar (testMatrices level) $ \pvm ->
|
atomically $ modifyTVar (testMatrices level) $ \pvm ->
|
||||||
|
@ -65,14 +71,18 @@ instance Scene Test where
|
||||||
}
|
}
|
||||||
|
|
||||||
(PVM p v m) <- atomically $ readTVar (testMatrices level)
|
(PVM p v m) <- atomically $ readTVar (testMatrices level)
|
||||||
setUniform sh "u_mvp" (p !*! v !*! m)
|
|
||||||
|
|
||||||
let (indices, vertices) = populate layers stageSet cast
|
let (indices, vertices) = populate
|
||||||
|
layers
|
||||||
|
stageSet
|
||||||
|
cast
|
||||||
|
|
||||||
bind va
|
bind va
|
||||||
bind vb
|
bind vb
|
||||||
bind ib
|
bind ib
|
||||||
|
bind sh
|
||||||
|
|
||||||
|
setUniform sh "u_mvp" (p !*! v !*! m)
|
||||||
write vb 0 vertices
|
write vb 0 vertices
|
||||||
|
|
||||||
write ib 0 (VS.map fromIntegral indices)
|
write ib 0 (VS.map fromIntegral indices)
|
||||||
|
|
|
@ -3,6 +3,7 @@ module Scenes.Test.Load where
|
||||||
|
|
||||||
import qualified Graphics.Rendering.OpenGL as GL
|
import qualified Graphics.Rendering.OpenGL as GL
|
||||||
|
|
||||||
|
import qualified Data.Vector as V
|
||||||
import qualified Data.Vector.Storable as VS
|
import qualified Data.Vector.Storable as VS
|
||||||
|
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
|
@ -42,17 +43,17 @@ load level progress = do
|
||||||
|
|
||||||
bind vertexBuffer
|
bind vertexBuffer
|
||||||
|
|
||||||
let vertices = VS.fromList (createQuad (V2 (400 - 16) (300 - 16)) 0)
|
--let vertices = VS.fromList (createQuad (V2 (400 - 16) (300 - 16)) 0)
|
||||||
|
|
||||||
write vertexBuffer 0 vertices
|
--write vertexBuffer 0 vertices
|
||||||
|
|
||||||
indexBuffer <- newIndexBuffer 1024
|
indexBuffer <- newIndexBuffer 1024
|
||||||
|
|
||||||
bind indexBuffer
|
bind indexBuffer
|
||||||
|
|
||||||
let indices = VS.fromList [0, 1, 2, 2, 3, 0]
|
-- let indices = VS.fromList [0, 1, 2, 2, 3, 0]
|
||||||
|
|
||||||
write indexBuffer 0 indices
|
-- write indexBuffer 0 indices
|
||||||
|
|
||||||
addBuffer (undefined :: Vertex) vertexBuffer
|
addBuffer (undefined :: Vertex) vertexBuffer
|
||||||
|
|
||||||
|
@ -80,6 +81,15 @@ load level progress = do
|
||||||
tex
|
tex
|
||||||
False
|
False
|
||||||
Nothing
|
Nothing
|
||||||
|
[]
|
||||||
|
oil = PowerUp
|
||||||
|
(realToFrac <$> (startpos + V2 200 0))
|
||||||
|
(V2 0 0)
|
||||||
|
(V2 0 0)
|
||||||
|
5000
|
||||||
|
tex
|
||||||
|
(EffectHolder 5 SpeedUp)
|
||||||
|
|
||||||
|
|
||||||
bind shader
|
bind shader
|
||||||
setUniform shader "u_mvp" (projection !*! view !*! model)
|
setUniform shader "u_mvp" (projection !*! view !*! model)
|
||||||
|
@ -103,6 +113,9 @@ load level progress = do
|
||||||
putTMVar (testGraphics level)
|
putTMVar (testGraphics level)
|
||||||
(GLAssets vertexArray vertexBuffer indexBuffer shader [tex])
|
(GLAssets vertexArray vertexBuffer indexBuffer shader [tex])
|
||||||
writeTVar (testPlayer level) (Just pituicat)
|
writeTVar (testPlayer level) (Just pituicat)
|
||||||
|
writeTVar (testCast level)
|
||||||
|
(V.fromList [Cast (oil {puPos = puPos oil + V2 200 0})])
|
||||||
|
writeTVar (testPowerups level) (V.fromList [oil])
|
||||||
writeTVar (testLoaded level) True
|
writeTVar (testLoaded level) True
|
||||||
writeTVar (testMatrices level) (PVM projection view model)
|
writeTVar (testMatrices level) (PVM projection view model)
|
||||||
|
|
||||||
|
|
|
@ -19,6 +19,7 @@ data Test = Test
|
||||||
, testPlayer :: TVar (Maybe Pituicat)
|
, testPlayer :: TVar (Maybe Pituicat)
|
||||||
, testStageSet :: TVar (V.Vector StageSet)
|
, testStageSet :: TVar (V.Vector StageSet)
|
||||||
, testCast :: TVar (V.Vector Cast)
|
, testCast :: TVar (V.Vector Cast)
|
||||||
|
, testPowerups :: TVar (V.Vector PowerUp)
|
||||||
, testMatrices :: TVar PVM
|
, testMatrices :: TVar PVM
|
||||||
, testClean :: TVar [UUID]
|
, testClean :: TVar [UUID]
|
||||||
}
|
}
|
||||||
|
|
|
@ -72,31 +72,69 @@ update level dt = liftIO $ do
|
||||||
)
|
)
|
||||||
walledCast
|
walledCast
|
||||||
updatedCast <- readTVar (testCast level)
|
updatedCast <- readTVar (testCast level)
|
||||||
|
oldCat <- fromJust <$> readTVar (testPlayer level)
|
||||||
|
releasedEffects <- stateTVar (testPowerups level) $ \pus ->
|
||||||
|
let living = V.foldl
|
||||||
|
(\acc pu ->
|
||||||
|
let npu = perform dt pu
|
||||||
|
in
|
||||||
|
if puTTL npu > 0
|
||||||
|
then npu `V.cons` acc
|
||||||
|
else acc
|
||||||
|
)
|
||||||
|
V.empty
|
||||||
|
pus
|
||||||
|
indexCollected = V.filter ((/= NoCollision) . snd) $
|
||||||
|
V.zip (V.fromList [0..length living])
|
||||||
|
(V.map
|
||||||
|
(collisionCheck dt oldCat)
|
||||||
|
living
|
||||||
|
)
|
||||||
|
collected = V.foldl
|
||||||
|
(\acc (ind, _) ->
|
||||||
|
(living V.! ind) `V.cons` acc
|
||||||
|
)
|
||||||
|
V.empty
|
||||||
|
indexCollected
|
||||||
|
differ = V.foldl
|
||||||
|
(\acc life -> if life `V.elem` collected
|
||||||
|
then acc
|
||||||
|
else life `V.cons` acc
|
||||||
|
)
|
||||||
|
V.empty
|
||||||
|
living
|
||||||
|
fin = V.map
|
||||||
|
(\pu -> move dt $ performWorldCollision pu layer dt)
|
||||||
|
differ
|
||||||
|
in
|
||||||
|
(collected, fin)
|
||||||
modifyTVar
|
modifyTVar
|
||||||
(testPlayer level) $ \(Just pituicat) ->
|
(testPlayer level) $ \(Just pituicat) ->
|
||||||
let playedCat = perform dt pituicat
|
let playedCat = perform dt pituicat
|
||||||
-- collidedCat =
|
castCat =
|
||||||
-- let partner =
|
let allPartners = V.zip (V.fromList [0..V.length updatedCast])
|
||||||
-- V.foldl
|
(V.map
|
||||||
-- (\acc@(_, ires) (Cast c) ->
|
(\(Cast c) -> collisionCheck dt playedCat c)
|
||||||
-- let res = collisionCheck dt playedCat c
|
updatedCast
|
||||||
-- in
|
)
|
||||||
-- if res /= NoCollision &&
|
filtered = (V.filter ((/= NoCollision) . snd) allPartners)
|
||||||
-- collisionTime res < collisionTime ires
|
partner = V.minimumBy
|
||||||
-- then (Cast c, res)
|
(\(_, e) (_, f) -> collisionTime e `compare` collisionTime f)
|
||||||
-- else acc
|
filtered
|
||||||
-- )
|
in
|
||||||
-- (V.head updatedCast, NoCollision)
|
if V.null filtered
|
||||||
-- updatedCast
|
then
|
||||||
-- in
|
playedCat
|
||||||
-- if (collisionTime $ snd partner) == dt
|
else
|
||||||
-- then playedCat
|
uncurry
|
||||||
-- else uncurry
|
(\(Cast c) cr -> collide playedCat c cr)
|
||||||
-- (\(Cast cx) res -> collide playedCat cx res)
|
(updatedCast V.! fst partner, snd partner)
|
||||||
-- partner
|
walledCat = performWorldCollision castCat layer dt
|
||||||
walledCat =
|
affectedCat = walledCat
|
||||||
performWorldCollision playedCat layer dt
|
{ pcEffects = pcEffects walledCat ++
|
||||||
in Just $ move dt (A.log A.Debug (fromString $ show $ velocity walledCat) walledCat)
|
map puEffect (V.toList releasedEffects)
|
||||||
|
}
|
||||||
|
in Just $ move dt affectedCat
|
||||||
|
|
||||||
performWorldCollision
|
performWorldCollision
|
||||||
:: (Collidible c)
|
:: (Collidible c)
|
||||||
|
|
|
@ -1,5 +1,8 @@
|
||||||
|
{-#LANGUAGE OverloadedStrings #-}
|
||||||
module Scenes.Test.Util where
|
module Scenes.Test.Util where
|
||||||
|
|
||||||
|
import Affection as A
|
||||||
|
|
||||||
import qualified Graphics.Rendering.OpenGL as GL
|
import qualified Graphics.Rendering.OpenGL as GL
|
||||||
|
|
||||||
import Linear
|
import Linear
|
||||||
|
@ -60,7 +63,11 @@ populate layers props actors =
|
||||||
(\(ais, avs) (StageSet s) ->
|
(\(ais, avs) (StageSet s) ->
|
||||||
let (nis, nvs) = toVertices s
|
let (nis, nvs) = toVertices s
|
||||||
in
|
in
|
||||||
( ais V.++ nis
|
( ais V.++
|
||||||
|
(V.map
|
||||||
|
(+ (if null ais then 0 else V.maximum ais + 1))
|
||||||
|
nis
|
||||||
|
)
|
||||||
, avs V.++ nvs)
|
, avs V.++ nvs)
|
||||||
)
|
)
|
||||||
(V.empty, V.empty)
|
(V.empty, V.empty)
|
||||||
|
@ -69,7 +76,11 @@ populate layers props actors =
|
||||||
(\(ais, avs) (Cast c) ->
|
(\(ais, avs) (Cast c) ->
|
||||||
let (nis, nvs) = toVertices c
|
let (nis, nvs) = toVertices c
|
||||||
in
|
in
|
||||||
( ais V.++ nis
|
( ais V.++
|
||||||
|
(V.map
|
||||||
|
(+ (if null ais then 0 else V.maximum ais + 1))
|
||||||
|
nis
|
||||||
|
)
|
||||||
, avs V.++ nvs)
|
, avs V.++ nvs)
|
||||||
)
|
)
|
||||||
(V.empty, V.empty)
|
(V.empty, V.empty)
|
||||||
|
|
|
@ -11,3 +11,4 @@ import Types.StageSet as T
|
||||||
import Types.Graphics as T
|
import Types.Graphics as T
|
||||||
import Types.Player as T
|
import Types.Player as T
|
||||||
import Types.Util as T
|
import Types.Util as T
|
||||||
|
import Types.PowerUp as T
|
||||||
|
|
|
@ -41,7 +41,7 @@ data Vertex = Vertex
|
||||||
, vertTexCoord :: V2 GL.GLfloat
|
, vertTexCoord :: V2 GL.GLfloat
|
||||||
, vertTexID :: GL.GLfloat
|
, vertTexID :: GL.GLfloat
|
||||||
}
|
}
|
||||||
deriving (Generic)
|
deriving (Generic, Show)
|
||||||
|
|
||||||
-- | make vertices instances of 'Storable'. it's a kind of magic ^.^
|
-- | make vertices instances of 'Storable'. it's a kind of magic ^.^
|
||||||
instance GStorable Vertex
|
instance GStorable Vertex
|
||||||
|
|
|
@ -18,6 +18,7 @@ import Classes.Graphics.Bindable
|
||||||
import Classes.Prop
|
import Classes.Prop
|
||||||
import Classes.Actor
|
import Classes.Actor
|
||||||
import Classes.Physics
|
import Classes.Physics
|
||||||
|
import Classes.Collectable
|
||||||
|
|
||||||
import Types.Graphics.VertexBuffer
|
import Types.Graphics.VertexBuffer
|
||||||
import Types.Texture
|
import Types.Texture
|
||||||
|
@ -35,13 +36,14 @@ data Pituicat = Pituicat
|
||||||
, pcHealth :: Int
|
, pcHealth :: Int
|
||||||
, pcTexture :: Texture
|
, pcTexture :: Texture
|
||||||
, pcGrounded :: Bool
|
, pcGrounded :: Bool
|
||||||
, pcMoveState :: Maybe Action
|
, pcMoveState :: Maybe Action
|
||||||
|
, pcEffects :: [EffectHolder]
|
||||||
}
|
}
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
instance Drawable Pituicat where
|
instance Drawable Pituicat where
|
||||||
|
|
||||||
toVertices (Pituicat (V2 x y) _ _ _ _ _ _ _ _) =
|
toVertices (Pituicat (V2 x y) _ _ _ _ _ _ _ _ _) =
|
||||||
( V.fromList [0, 1, 2, 2, 3, 0]
|
( V.fromList [0, 1, 2, 2, 3, 0]
|
||||||
, V.fromList
|
, V.fromList
|
||||||
[ newVertex
|
[ newVertex
|
||||||
|
@ -77,13 +79,18 @@ instance Actor Pituicat where
|
||||||
|
|
||||||
perform dt p =
|
perform dt p =
|
||||||
let (V2 _ dy) = velocity physCat
|
let (V2 _ dy) = velocity physCat
|
||||||
|
moveFact =
|
||||||
|
if
|
||||||
|
null (filter ((SpeedUp ==) . effectReleased) (pcEffects p))
|
||||||
|
then 1
|
||||||
|
else 2
|
||||||
physCat = (accelerate dt . gravitate constG)
|
physCat = (accelerate dt . gravitate constG)
|
||||||
(p
|
(p
|
||||||
{ pcAcc = 0
|
{ pcAcc = V2 0 0
|
||||||
, pcTMoveVel =
|
, pcTMoveVel =
|
||||||
case pcMoveState p of
|
case pcMoveState p of
|
||||||
Just MoveRight -> V2 catMoveVelocity 0
|
Just MoveRight -> V2 (catMoveVelocity * moveFact) 0
|
||||||
Just MoveLeft -> V2 (-catMoveVelocity) 0
|
Just MoveLeft -> V2 ((-catMoveVelocity) * moveFact) 0
|
||||||
_ -> V2 0 0
|
_ -> V2 0 0
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
@ -93,9 +100,22 @@ instance Actor Pituicat where
|
||||||
, pcGrounded = if pcGrounded physCat
|
, pcGrounded = if pcGrounded physCat
|
||||||
then not (abs dy * dt > 2)
|
then not (abs dy * dt > 2)
|
||||||
else False
|
else False
|
||||||
|
, pcEffects =
|
||||||
|
foldl
|
||||||
|
(\acc eff ->
|
||||||
|
let nduration = effectDuration eff - dt
|
||||||
|
in
|
||||||
|
if nduration > 0
|
||||||
|
then
|
||||||
|
eff { effectDuration = nduration} : acc
|
||||||
|
else
|
||||||
|
acc
|
||||||
|
)
|
||||||
|
[]
|
||||||
|
(pcEffects p)
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
finalCat
|
A.log A.Debug ("*meow* am at: " <> (fromString $ show $ pcPos finalCat)) finalCat
|
||||||
|
|
||||||
instance Mass Pituicat where
|
instance Mass Pituicat where
|
||||||
|
|
||||||
|
@ -157,26 +177,18 @@ instance Collidible Pituicat where
|
||||||
)
|
)
|
||||||
((\(V2 _ y) -> y) (if diry /= 0 then pcVel ncat else pcVel cat))
|
((\(V2 _ y) -> y) (if diry /= 0 then pcVel ncat else pcVel cat))
|
||||||
grounded =
|
grounded =
|
||||||
(vy * ddt) >= 0 &&
|
vy >= 0 &&
|
||||||
(vy * ddt) < 5 && diry == -1
|
vy < 200 &&
|
||||||
|
diry == -1
|
||||||
in
|
in
|
||||||
A.log
|
ncat
|
||||||
Debug
|
{ pcGrounded = grounded
|
||||||
("*boing* meow! collision result: " <>
|
, pcMoveVel = pcMoveVel ncat *
|
||||||
fromString (show collr) <>
|
if dirx /= 0
|
||||||
"\nother: " <>
|
then V2 0 1
|
||||||
fromString (show other)
|
else V2 1 1
|
||||||
)
|
, pcVel = nvel *
|
||||||
(
|
if dirx /= 0
|
||||||
ncat
|
then V2 0 1
|
||||||
{ pcGrounded = grounded
|
else V2 1 1
|
||||||
, pcMoveVel = pcMoveVel ncat *
|
}
|
||||||
if dirx /= 0
|
|
||||||
then V2 0 1
|
|
||||||
else V2 1 1
|
|
||||||
, pcVel = nvel *
|
|
||||||
if dirx /= 0
|
|
||||||
then V2 0 1
|
|
||||||
else V2 1 1
|
|
||||||
}
|
|
||||||
)
|
|
||||||
|
|
|
@ -0,0 +1,120 @@
|
||||||
|
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 (Eq, 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
|
|
@ -0,0 +1,6 @@
|
||||||
|
{-# LANGUAGE ExistentialQuantification #-}
|
||||||
|
module Types.Tangible where
|
||||||
|
|
||||||
|
import Classes.Collectable (Collectable)
|
||||||
|
|
||||||
|
data Tangible = forall a . Collectable a => Tangible a
|
Loading…
Reference in New Issue