From 21df43b773ec9e777f25d9a80b992a035cda9d6f Mon Sep 17 00:00:00 2001 From: nek0 Date: Thu, 22 Apr 2021 05:37:57 +0200 Subject: [PATCH] starting work on powerups. Drawable for now --- pituicat.cabal | 1 + src/Classes/Prop.hs | 2 +- src/Scenes/Test.hs | 8 ++++++-- src/Scenes/Test/Load.hs | 12 +++++------ src/Scenes/Test/Update.hs | 21 +------------------ src/Scenes/Test/Util.hs | 30 ++++++++++++++++++++++----- src/Types/Graphics/VertexBuffer.hs | 2 +- src/Types/Player.hs | 33 +++++++++++------------------- src/Types/PowerUp.hs | 2 +- 9 files changed, 54 insertions(+), 57 deletions(-) diff --git a/pituicat.cabal b/pituicat.cabal index a8340ab..6676dce 100644 --- a/pituicat.cabal +++ b/pituicat.cabal @@ -32,6 +32,7 @@ executable pituicat , Types.Graphics.Shader , Types.Util , Types.Player + , Types.PowerUp , Classes , Classes.Scene , Classes.Actor diff --git a/src/Classes/Prop.hs b/src/Classes/Prop.hs index b4bb139..b907c73 100644 --- a/src/Classes/Prop.hs +++ b/src/Classes/Prop.hs @@ -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 diff --git a/src/Scenes/Test.hs b/src/Scenes/Test.hs index 0f2c5a2..c60851f 100644 --- a/src/Scenes/Test.hs +++ b/src/Scenes/Test.hs @@ -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) diff --git a/src/Scenes/Test/Load.hs b/src/Scenes/Test/Load.hs index aff49c9..8575e81 100644 --- a/src/Scenes/Test/Load.hs +++ b/src/Scenes/Test/Load.hs @@ -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) diff --git a/src/Scenes/Test/Update.hs b/src/Scenes/Test/Update.hs index 2964fd3..057477f 100644 --- a/src/Scenes/Test/Update.hs +++ b/src/Scenes/Test/Update.hs @@ -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) diff --git a/src/Scenes/Test/Util.hs b/src/Scenes/Test/Util.hs index f11f070..04efa37 100644 --- a/src/Scenes/Test/Util.hs +++ b/src/Scenes/Test/Util.hs @@ -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 - ( is V.++ lis V.++ pis V.++ cis - , vs V.++ lvs V.++ pvs V.++ cvs - ) + 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) diff --git a/src/Types/Graphics/VertexBuffer.hs b/src/Types/Graphics/VertexBuffer.hs index 848a5a2..7b9796c 100644 --- a/src/Types/Graphics/VertexBuffer.hs +++ b/src/Types/Graphics/VertexBuffer.hs @@ -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 diff --git a/src/Types/Player.hs b/src/Types/Player.hs index 59844a9..53da69b 100644 --- a/src/Types/Player.hs +++ b/src/Types/Player.hs @@ -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,23 +160,14 @@ 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 * - if dirx /= 0 - then V2 0 1 - else V2 1 1 - , pcVel = nvel * - if dirx /= 0 - then V2 0 1 - else V2 1 1 - } - ) + ncat + { 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 + } diff --git a/src/Types/PowerUp.hs b/src/Types/PowerUp.hs index 4b6c7f2..c635988 100644 --- a/src/Types/PowerUp.hs +++ b/src/Types/PowerUp.hs @@ -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