starting work on powerups. Drawable for now

pituicat.cabal

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

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
 

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)

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)
 

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)

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
+        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.zip (V.fromList [0 ..]) layers)

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

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

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