start collectables

movable_objects2
nek0 1 year ago
parent 039d567be8
commit 2ec22ea6b0
  1. 2
      pituicat.cabal
  2. 1
      src/Classes.hs
  3. 4
      src/Classes/Collectable.hs
  4. 13
      src/Scenes/Test.hs
  5. 12
      src/Scenes/Test/Load.hs
  6. 1
      src/Scenes/Test/Types.hs
  7. 5
      src/Scenes/Test/Update.hs
  8. 1
      src/Types.hs
  9. 4
      src/Types/Player.hs
  10. 120
      src/Types/PowerUp.hs
  11. 2
      src/Types/Tangible.hs

@ -36,6 +36,7 @@ executable pituicat
, Classes.Scene
, Classes.Actor
, Classes.Prop
, Classes.Collectable
, Classes.Graphics
, Classes.Graphics.Bindable
, Classes.Graphics.Buffer
@ -44,7 +45,6 @@ executable pituicat
, Classes.Physics
, Classes.Physics.Mass
, Classes.Physics.Collidible
, Classes.Physics.Collectable
, Scenes.Test
, Scenes.Test.Types
, Scenes.Test.Util

@ -7,3 +7,4 @@ import Classes.Scene as C
import Classes.Prop as C
import Classes.Actor as C
import Classes.Physics as C
import Classes.Collectable as C

@ -1,4 +1,4 @@
module Classes.Physics.Collectable where
module Classes.Collectable where
import Classes.Physics.Collidible (Collidible)
@ -11,12 +11,14 @@ data Effect
| Antidote
| StopTime
| Invisibility
deriving (Show)
-- | The Effect holder type definition
data EffectHolder = EffectHolder
{ effectDuration :: Double -- ^ Duration of stored effect
, effectReleased :: Effect -- ^ The actual effect released
}
deriving (Show)
class Collidible c => Collectable c where

@ -35,6 +35,7 @@ instance Scene Test where
<*> newTVarIO Nothing
<*> newTVarIO V.empty
<*> newTVarIO V.empty
<*> newTVarIO V.empty
<*> newTVarIO (PVM identity identity identity)
<*> newTVarIO []
@ -53,8 +54,11 @@ instance Scene Test where
stageSet <- readTVarIO (testStageSet level)
nonPlayerCast <- readTVarIO (testCast level)
pituicat <- atomically $ readTVar (testPlayer level)
let cast = Cast (fromJust pituicat) `V.cons` nonPlayerCast
powerups <- fmap (V.map Cast) (readTVarIO (testPowerups level))
pituicat <- readTVarIO (testPlayer level)
let cast = Cast (fromJust pituicat) `V.cons` powerups
-- nonPlayerCast V.++
-- powerups
playerPos@(V2 px py) = realToFrac <$> (pcPos $ fromJust pituicat)
atomically $ modifyTVar (testMatrices level) $ \pvm ->
@ -67,7 +71,10 @@ instance Scene Test where
(PVM p v m) <- atomically $ readTVar (testMatrices level)
setUniform sh "u_mvp" (p !*! v !*! m)
let (indices, vertices) = populate layers stageSet cast
let (indices, vertices) = populate
layers
stageSet
cast
bind va
bind vb

@ -3,6 +3,7 @@ module Scenes.Test.Load where
import qualified Graphics.Rendering.OpenGL as GL
import qualified Data.Vector as V
import qualified Data.Vector.Storable as VS
import Control.Concurrent.STM
@ -38,7 +39,7 @@ load level progress = do
bind vertexArray
vertexBuffer <- newVertexBuffer 1024
vertexBuffer <- newVertexBuffer 4096
bind vertexBuffer
@ -80,6 +81,14 @@ load level progress = do
tex
False
Nothing
oil = PowerUp
(realToFrac <$> (startpos) + V2 100 0)
(V2 0 0)
(V2 0 0)
5
tex
(EffectHolder 5 SpeedUp)
bind shader
setUniform shader "u_mvp" (projection !*! view !*! model)
@ -103,6 +112,7 @@ load level progress = do
putTMVar (testGraphics level)
(GLAssets vertexArray vertexBuffer indexBuffer shader [tex])
writeTVar (testPlayer level) (Just pituicat)
writeTVar (testPowerups level) (V.fromList [oil])
writeTVar (testLoaded level) True
writeTVar (testMatrices level) (PVM projection view model)

@ -19,6 +19,7 @@ data Test = Test
, testPlayer :: TVar (Maybe Pituicat)
, testStageSet :: TVar (V.Vector StageSet)
, testCast :: TVar (V.Vector Cast)
, testPowerups :: TVar (V.Vector PowerUp)
, testMatrices :: TVar PVM
, testClean :: TVar [UUID]
}

@ -32,6 +32,11 @@ update level dt = liftIO $ do
atomically $ do
lmap <- readTMVar (testMap level)
let layer = mapLayers lmap V.! fromIntegral (mapWalkLayer lmap)
modifyTVar (testPowerups level) $ \pus ->
let played = V.map (perform dt) pus
collided = V.map (\pu -> performWorldCollision pu layer dt) played
in
collided
modifyTVar
(testCast level) $ \cast ->
let playedCast =

@ -11,3 +11,4 @@ import Types.StageSet as T
import Types.Graphics as T
import Types.Player as T
import Types.Util as T
import Types.PowerUp as T

@ -35,7 +35,7 @@ data Pituicat = Pituicat
, pcHealth :: Int
, pcTexture :: Texture
, pcGrounded :: Bool
, pcMoveState :: Maybe Action
, pcMoveState :: Maybe Action
}
deriving (Eq, Show)
@ -79,7 +79,7 @@ instance Actor Pituicat where
let (V2 _ dy) = velocity physCat
physCat = (accelerate dt . gravitate constG)
(p
{ pcAcc = 0
{ pcAcc = V2 0 0
, pcTMoveVel =
case pcMoveState physCat of
Just MoveRight -> V2 catMoveVelocity 0

@ -0,0 +1,120 @@
module Types.PowerUp where
import qualified Data.Vector as V
import Linear
-- internal imports
import Classes.Graphics.Drawable
import Classes.Graphics.Bindable
import Classes.Collectable
import Classes.Prop
import Classes.Actor
import Classes.Physics
import Types.Graphics.VertexBuffer
import Types.Texture
import Util
data PowerUp = PowerUp
{ puPos :: V2 Double
, puVel :: V2 Double
, puAcc :: V2 Double
, puTTL :: Double
, puTexture :: Texture
, puEffect :: EffectHolder
}
deriving (Show)
instance Drawable PowerUp where
toVertices (PowerUp (V2 x y) _ _ _ _ _) =
( V.fromList [0, 1, 2, 2, 3, 0]
, V.fromList
[ newVertex
(V3 (realToFrac x - 20) (realToFrac y - 20) 0)
(V4 1 1 1 1)
(V2 0 (1 - 50 / 1024))
1
, newVertex
(V3 (realToFrac x + 20) (realToFrac y - 20) 0)
(V4 1 1 1 1)
(V2 (50 / 1024) (1 - 50 / 1024))
1
, newVertex
(V3 (realToFrac x + 20) (realToFrac y + 20) 0)
(V4 1 1 1 1)
(V2 (50 / 1024) 1)
1
, newVertex
(V3 (realToFrac x - 20) (realToFrac y + 20) 0)
(V4 1 1 1 1)
(V2 0 1)
1
]
)
instance Prop PowerUp where
residentLayer _ = 0
bindPropTexture = bind . puTexture
instance Actor PowerUp where
perform dt o =
let phys = (accelerate dt . gravitate constG)
o
{ puAcc = V2 0 0
, puTTL = puTTL o - dt
}
in
phys
instance Mass PowerUp where
mass _ = 1
acceleration = puAcc
accelerationUpdater o =
(\acc -> o
{ puAcc = acc
}
)
velocity = puVel
velocityUpdater o =
(\vel -> o
{ puVel = vel
}
)
position = puPos
positionUpdater o =
(\pos -> o
{ puPos = pos
}
)
instance Collidible PowerUp where
boundary _ =
( V2 (-20) (-20)
, V2 20 20
)
collide o _ NoCollision = o
collide o other collr@(Collision ddr (V2 dirx diry)) =
let no = elasticCollision 0.3 o other collr
in
no
instance Collectable PowerUp where
effect = puEffect

@ -1,6 +1,6 @@
{-# LANGUAGE ExistentialQuantification #-}
module Types.Tangible where
import Classes.Physics.Collectable (Collectable)
import Classes.Collectable (Collectable)
data Tangible = forall a . Collectable a => Tangible a

Loading…
Cancel
Save