starting work on powerups. Drawable for now
This commit is contained in:
parent
370d6def45
commit
21df43b773
9 changed files with 54 additions and 57 deletions
|
|
@ -32,6 +32,7 @@ executable pituicat
|
|||
, Types.Graphics.Shader
|
||||
, Types.Util
|
||||
, Types.Player
|
||||
, Types.PowerUp
|
||||
, Classes
|
||||
, Classes.Scene
|
||||
, Classes.Actor
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue