starting work on powerups. Drawable for now

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

View File

@ -32,6 +32,7 @@ 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

View File

@ -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

View File

@ -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
@ -54,7 +56,8 @@ instance Scene Test where
stageSet <- readTVarIO (testStageSet level) stageSet <- readTVarIO (testStageSet level)
nonPlayerCast <- readTVarIO (testCast 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) pituicat <- readTVarIO (testPlayer level)
let cast = Cast (fromJust pituicat) `V.cons` powerups let cast = Cast (fromJust pituicat) `V.cons` powerups
-- nonPlayerCast V.++ -- nonPlayerCast V.++
@ -69,7 +72,6 @@ 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 layers
@ -79,7 +81,9 @@ instance Scene Test where
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

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

View File

@ -36,7 +36,7 @@ update level dt = liftIO $ do
let played = V.map (perform dt) pus let played = V.map (perform dt) pus
collided = V.map (\pu -> performWorldCollision pu layer dt) played collided = V.map (\pu -> performWorldCollision pu layer dt) played
in in
collided V.map (move dt) collided
modifyTVar modifyTVar
(testCast level) $ \cast -> (testCast level) $ \cast ->
let playedCast = let playedCast =
@ -80,25 +80,6 @@ update level dt = liftIO $ do
modifyTVar modifyTVar
(testPlayer level) $ \(Just pituicat) -> (testPlayer level) $ \(Just pituicat) ->
let playedCat = perform dt 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 = walledCat =
performWorldCollision playedCat layer dt performWorldCollision playedCat layer dt
in Just $ move dt (A.log A.Debug (fromString $ show $ velocity walledCat) walledCat) in Just $ move dt (A.log A.Debug (fromString $ show $ velocity walledCat) walledCat)

View File

@ -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
@ -7,6 +10,8 @@ import Linear
import qualified Data.Vector as V import qualified Data.Vector as V
import qualified Data.Vector.Storable as VS import qualified Data.Vector.Storable as VS
import Data.String (fromString)
import Control.Arrow ((***)) import Control.Arrow ((***))
-- internal imports -- internal imports
@ -60,7 +65,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 +78,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)
@ -91,9 +104,16 @@ populate layers props actors =
else V.maximum (is V.++ lis V.++ pis) + 1) else V.maximum (is V.++ lis V.++ pis) + 1)
cisRaw cisRaw
in in
( is V.++ lis V.++ pis V.++ cis A.log A.Debug
, vs V.++ lvs V.++ pvs V.++ cvs ("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.empty, V.empty)
(V.zip (V.fromList [0 ..]) layers) (V.zip (V.fromList [0 ..]) layers)

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) 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

View File

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

View File

@ -111,7 +111,7 @@ instance Collidible PowerUp where
collide o _ NoCollision = o collide o _ NoCollision = o
collide o other collr@(Collision ddr (V2 dirx diry)) = 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 in
no no