Compare commits

..

No commits in common. "61451a4a10a8f7d7f29adb952e7a1a6b5debbbc3" and "927d7af132487ac28fee548df13140d935bd38e7" have entirely different histories.

15 changed files with 66 additions and 313 deletions

View file

@ -24,7 +24,6 @@ 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
@ -32,12 +31,10 @@ 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

View file

@ -7,4 +7,3 @@ 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

View file

@ -1,27 +0,0 @@
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

View file

@ -139,17 +139,13 @@ 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
res A.log A.Debug
(fromString $
show (tx < dt, ty < dt, tx < ty, coll True, coll False))
res
else else
NoCollision NoCollision

View file

@ -4,7 +4,7 @@ module Classes.Prop where
import Classes.Graphics.Drawable import Classes.Graphics.Drawable
class (Show a, Drawable a) => Prop a where class (Drawable a) => Prop a where
residentLayer :: a -> Word residentLayer :: a -> Word

View file

@ -10,8 +10,6 @@ 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
@ -37,7 +35,6 @@ 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 []
@ -56,11 +53,8 @@ instance Scene Test where
stageSet <- readTVarIO (testStageSet level) stageSet <- readTVarIO (testStageSet level)
nonPlayerCast <- readTVarIO (testCast level) nonPlayerCast <- readTVarIO (testCast level)
powerups <- (V.map Cast) <$> (readTVarIO (testPowerups level)) pituicat <- atomically $ readTVar (testPlayer level)
A.logIO A.Debug (fromString $ V.foldl (\acc (Cast p) -> acc ++ show p ++ " ") "" powerups) let cast = Cast (fromJust pituicat) `V.cons` nonPlayerCast
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 ->
@ -71,18 +65,14 @@ 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 let (indices, vertices) = populate layers stageSet cast
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)

View file

@ -3,7 +3,6 @@ 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
@ -43,17 +42,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
@ -81,15 +80,6 @@ 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)
@ -113,9 +103,6 @@ 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)

View file

@ -19,7 +19,6 @@ 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]
} }

View file

@ -72,69 +72,31 @@ 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
castCat = -- collidedCat =
let allPartners = V.zip (V.fromList [0..V.length updatedCast]) -- let partner =
(V.map -- V.foldl
(\(Cast c) -> collisionCheck dt playedCat c) -- (\acc@(_, ires) (Cast c) ->
updatedCast -- let res = collisionCheck dt playedCat c
) -- in
filtered = (V.filter ((/= NoCollision) . snd) allPartners) -- if res /= NoCollision &&
partner = V.minimumBy -- collisionTime res < collisionTime ires
(\(_, e) (_, f) -> collisionTime e `compare` collisionTime f) -- then (Cast c, res)
filtered -- else acc
in -- )
if V.null filtered -- (V.head updatedCast, NoCollision)
then -- updatedCast
playedCat -- in
else -- if (collisionTime $ snd partner) == dt
uncurry -- then playedCat
(\(Cast c) cr -> collide playedCat c cr) -- else uncurry
(updatedCast V.! fst partner, snd partner) -- (\(Cast cx) res -> collide playedCat cx res)
walledCat = performWorldCollision castCat layer dt -- partner
affectedCat = walledCat walledCat =
{ pcEffects = pcEffects walledCat ++ performWorldCollision playedCat layer dt
map puEffect (V.toList releasedEffects) in Just $ move dt (A.log A.Debug (fromString $ show $ velocity walledCat) walledCat)
}
in Just $ move dt affectedCat
performWorldCollision performWorldCollision
:: (Collidible c) :: (Collidible c)

View file

@ -1,8 +1,5 @@
{-#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
@ -63,11 +60,7 @@ 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.++ ( ais V.++ nis
(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)
@ -76,11 +69,7 @@ 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.++ ( ais V.++ nis
(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)

View file

@ -11,4 +11,3 @@ 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

View file

@ -41,7 +41,7 @@ data Vertex = Vertex
, vertTexCoord :: V2 GL.GLfloat , vertTexCoord :: V2 GL.GLfloat
, vertTexID :: GL.GLfloat , vertTexID :: GL.GLfloat
} }
deriving (Generic, Show) deriving (Generic)
-- | 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

View file

@ -18,7 +18,6 @@ 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
@ -36,14 +35,13 @@ 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
@ -79,18 +77,13 @@ 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 = V2 0 0 { pcAcc = 0
, pcTMoveVel = , pcTMoveVel =
case pcMoveState p of case pcMoveState p of
Just MoveRight -> V2 (catMoveVelocity * moveFact) 0 Just MoveRight -> V2 catMoveVelocity 0
Just MoveLeft -> V2 ((-catMoveVelocity) * moveFact) 0 Just MoveLeft -> V2 (-catMoveVelocity) 0
_ -> V2 0 0 _ -> V2 0 0
} }
) )
@ -100,22 +93,9 @@ 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
A.log A.Debug ("*meow* am at: " <> (fromString $ show $ pcPos finalCat)) finalCat finalCat
instance Mass Pituicat where instance Mass Pituicat where
@ -177,18 +157,26 @@ 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 >= 0 && (vy * ddt) >= 0 &&
vy < 200 && (vy * ddt) < 5 && diry == -1
diry == -1
in in
ncat A.log
{ pcGrounded = grounded Debug
, pcMoveVel = pcMoveVel ncat * ("*boing* meow! collision result: " <>
if dirx /= 0 fromString (show collr) <>
then V2 0 1 "\nother: " <>
else V2 1 1 fromString (show other)
, pcVel = nvel * )
if dirx /= 0 (
then V2 0 1 ncat
else V2 1 1 { pcGrounded = grounded
} , 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
}
)

View file

@ -1,120 +0,0 @@
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

View file

@ -1,6 +0,0 @@
{-# LANGUAGE ExistentialQuantification #-}
module Types.Tangible where
import Classes.Collectable (Collectable)
data Tangible = forall a . Collectable a => Tangible a