nek0/pituicat
2
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

starting work on powerups. Drawable for now

Browse source
This commit is contained in:
nek0 2021-04-22 05:37:57 +02:00
parent 370d6def45
commit 21df43b773
9 changed files with 54 additions and 57 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
pituicat.cabal
View file

@ -32,6 +32,7 @@ executable pituicat
, Types.Graphics.Shader
, Types.Util
, Types.Player
, Types.PowerUp
, Classes
, Classes.Scene
, Classes.Actor

2
src/Classes/Prop.hs
View file

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

8
src/Scenes/Test.hs
View file

@ -10,6 +10,8 @@ import Linear
import qualified Data.Vector.Storable as VS
import qualified Data.Vector as V
import Data.String (fromString)
import Data.Maybe (fromJust)
import Control.Concurrent.STM
@ -54,7 +56,8 @@ instance Scene Test where
stageSet <- readTVarIO (testStageSet level)
nonPlayerCast <- readTVarIO (testCast level)
powerups <- fmap (V.map Cast) (readTVarIO (testPowerups level))
powerups <- (V.map Cast) <$> (readTVarIO (testPowerups level))
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
-- nonPlayerCast V.++
@ -69,7 +72,6 @@ instance Scene Test where
}
(PVM p v m) <- atomically $ readTVar (testMatrices level)
setUniform sh "u_mvp" (p !*! v !*! m)
let (indices, vertices) = populate
layers
@ -79,7 +81,9 @@ instance Scene Test where
bind va
bind vb
bind ib
bind sh
setUniform sh "u_mvp" (p !*! v !*! m)
write vb 0 vertices
write ib 0 (VS.map fromIntegral indices)

12
src/Scenes/Test/Load.hs
View file

@ -43,17 +43,17 @@ load level progress = do
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
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
@ -82,10 +82,10 @@ load level progress = do
False
Nothing
oil = PowerUp
(realToFrac <$> (startpos) + V2 100 0)
(realToFrac <$> (startpos + V2 200 (0)))
(V2 0 0)
(V2 0 0)
5
5000
tex
(EffectHolder 5 SpeedUp)

21
src/Scenes/Test/Update.hs
View file

@ -36,7 +36,7 @@ update level dt = liftIO $ do
let played = V.map (perform dt) pus
collided = V.map (\pu -> performWorldCollision pu layer dt) played
in
collided
V.map (move dt) collided
modifyTVar
(testCast level) $ \cast ->
let playedCast =
@ -80,25 +80,6 @@ update level dt = liftIO $ do
modifyTVar
(testPlayer level) $ \(Just pituicat) ->
let playedCat = perform dt pituicat
-- collidedCat =
-- let partner =
-- V.foldl
-- (\acc@(_, ires) (Cast c) ->
-- let res = collisionCheck dt playedCat c
-- in
-- if res /= NoCollision &&
-- collisionTime res < collisionTime ires
-- then (Cast c, res)
-- else acc
-- )
-- (V.head updatedCast, NoCollision)
-- updatedCast
-- in
-- if (collisionTime $ snd partner) == dt
-- then playedCat
-- else uncurry
-- (\(Cast cx) res -> collide playedCat cx res)
-- partner
walledCat =
performWorldCollision playedCat layer dt
in Just $ move dt (A.log A.Debug (fromString $ show $ velocity walledCat) walledCat)

24
src/Scenes/Test/Util.hs
View file

@ -1,5 +1,8 @@
{-#LANGUAGE OverloadedStrings #-}
module Scenes.Test.Util where
import Affection as A
import qualified Graphics.Rendering.OpenGL as GL
import Linear
@ -7,6 +10,8 @@ import Linear
import qualified Data.Vector as V
import qualified Data.Vector.Storable as VS
import Data.String (fromString)
import Control.Arrow ((***))
-- internal imports
@ -60,7 +65,11 @@ populate layers props actors =
(\(ais, avs) (StageSet s) ->
let (nis, nvs) = toVertices s
in
( ais V.++ nis
( ais V.++
(V.map
(+ (if null ais then 0 else V.maximum ais + 1))
nis
)
, avs V.++ nvs)
)
(V.empty, V.empty)
@ -69,7 +78,11 @@ populate layers props actors =
(\(ais, avs) (Cast c) ->
let (nis, nvs) = toVertices c
in
( ais V.++ nis
( ais V.++
(V.map
(+ (if null ais then 0 else V.maximum ais + 1))
nis
)
, avs V.++ nvs)
)
(V.empty, V.empty)
@ -91,9 +104,16 @@ populate layers props actors =
else V.maximum (is V.++ lis V.++ pis) + 1)
cisRaw
in
A.log A.Debug
("layer: " <> (fromString $ show num) <>
", actors: " <> (fromString $ V.foldl (\acc (Cast c) -> acc ++ show c ++ " ") "" actorsHere) <>
", props: " <> (fromString $ V.foldl (\acc (StageSet s) -> acc ++ show s ++ " ") "" propsHere)
)
(
( is V.++ lis V.++ pis V.++ cis
, vs V.++ lvs V.++ pvs V.++ cvs
)
)
)
(V.empty, V.empty)
(V.zip (V.fromList [0 ..]) layers)

2
src/Types/Graphics/VertexBuffer.hs
View file

@ -41,7 +41,7 @@ data Vertex = Vertex
, vertTexCoord :: V2 GL.GLfloat
, vertTexID :: GL.GLfloat
}
deriving (Generic)
deriving (Generic, Show)
-- | make vertices instances of 'Storable'. it's a kind of magic ^.^
instance GStorable Vertex

11
src/Types/Player.hs
View file

@ -95,7 +95,7 @@ instance Actor Pituicat where
else False
}
in
finalCat
A.log A.Debug ("*meow* am at: " <> (fromString $ show $ pcPos finalCat)) finalCat
instance Mass Pituicat where
@ -160,14 +160,6 @@ instance Collidible Pituicat where
(vy * ddt) >= 0 &&
(vy * 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 *
@ -179,4 +171,3 @@ instance Collidible Pituicat where
then V2 0 1
else V2 1 1
}
)

2
src/Types/PowerUp.hs
View file

@ -111,7 +111,7 @@ instance Collidible PowerUp where
collide o _ NoCollision = o
collide o other collr@(Collision ddr (V2 dirx diry)) =
let no = elasticCollision 0.3 o other collr
let no = elasticCollision 0.5 o other collr
in
no