This commit is contained in:
nek0 2021-07-14 02:42:24 +02:00
parent 3f45ae580c
commit 95f5b2c3a8
2 changed files with 11 additions and 14 deletions

View file

@ -51,18 +51,18 @@ instance Scene Test where
onEvents = singleHandler onEvents = singleHandler
render level = liftIO $ do render level = liftIO $ do
(GLAssets va vb ib sh tx) <- atomically (readTMVar $ testGraphics level) (GLAssets va vb ib sh _) <- atomically (readTMVar $ testGraphics level)
(LevelMap layers _ _ tileMap _) <- (LevelMap layers _ _ tileMap _) <-
atomically (readTMVar $ testMap level) atomically (readTMVar $ testMap level)
stageSet <- readTVarIO (testStageSet level) stageSet <- readTVarIO (testStageSet level)
nonPlayerCast <- readTVarIO (testCast level) nonPlayerCast <- readTVarIO (testCast level)
powerups <- (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) -- 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 V.++ let cast = Cast (fromJust pituicat) `V.cons` powerups V.++
nonPlayerCast nonPlayerCast
playerPos@(V2 px py) = realToFrac <$> (pcPos $ fromJust pituicat) (V2 px py) = realToFrac <$> pcPos (fromJust pituicat)
atomically $ modifyTVar (testMatrices level) $ \pvm -> atomically $ modifyTVar (testMatrices level) $ \pvm ->
pvm pvm
@ -71,7 +71,7 @@ instance Scene Test where
(V3 (400 - px) (300 - py) 0) (V3 (400 - px) (300 - py) 0)
} }
(PVM p v m) <- atomically $ readTVar (testMatrices level) (PVM p v m) <- readTVarIO (testMatrices level)
let (indices, vertices) = populate let (indices, vertices) = populate
layers layers
@ -89,6 +89,6 @@ instance Scene Test where
write ib 0 (VS.map fromIntegral indices) write ib 0 (VS.map fromIntegral indices)
bind (tileMapTexture tileMap) bind (tileMapTexture tileMap)
V.mapM_ (\(StageSet p) -> bindPropTexture p) stageSet V.mapM_(\(StageSet prop) -> bindPropTexture prop) stageSet
V.mapM_ (\(Cast c) -> bindPropTexture c) cast V.mapM_(\(Cast c) -> bindPropTexture c) cast
R.draw va ib sh R.draw va ib sh

View file

@ -81,26 +81,23 @@ instance Mass PowerUp where
acceleration = puAcc acceleration = puAcc
accelerationUpdater o = accelerationUpdater o =
(\acc -> o \acc -> o
{ puAcc = acc { puAcc = acc
} }
)
velocity = puVel velocity = puVel
velocityUpdater o = velocityUpdater o =
(\vel -> o \vel -> o
{ puVel = vel { puVel = vel
} }
)
position = puPos position = puPos
positionUpdater o = positionUpdater o =
(\pos -> o \pos -> o
{ puPos = pos { puPos = pos
} }
)
instance Collidible PowerUp where instance Collidible PowerUp where