justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Steps towards making clouds list based

Browse Source
This commit is contained in:
jgk
2021-07-21 00:05:13 +02:00
parent af44a380fc
commit 7b45a4a295
7 changed files with 65 additions and 67 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base.hs
+4 -5
View File
@@ -109,14 +109,13 @@ creaturesNearPointI n p w = IM.unions [f b $ f a $ _creaturesZone w | a<-[x-n..
Just val -> val
_ -> IM.empty
cloudsNearPoint :: Point2 -> World -> IM.IntMap Cloud
cloudsNearPoint :: Point2 -> World -> [Cloud]
--cloudsNearPoint p w = IM.unions [f b $ f a $ _cloudsZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
cloudsNearPoint p w = f y $ f x $ _cloudsZone w
cloudsNearPoint p w = f ((IM.lookup x $ _cloudsZone w) >>= IM.lookup y)
where
(x,y) = cloudZoneOfPoint p
f i m = case IM.lookup i m of
Just val -> val
_ -> IM.empty
f Nothing = []
f (Just l) = l
-- possible BUG, occurs when used in thingsHitLongLine
creaturesAlongLine :: Point2 -> Point2 -> World -> IM.IntMap Creature
--creaturesAlongLine a b w = IM.unions [f y $ f x $ _creaturesZone w | (x,y) <- zoneOfLine a b]
src/Dodge/Data.hs
+8 -5
View File
@@ -55,8 +55,8 @@ data World = World
, _creaturesZone :: IM.IntMap (IM.IntMap (IM.IntMap Creature))
, _creatureGroups :: IM.IntMap CrGroupParams
, _itemPositions :: IM.IntMap ItemPos
, _clouds :: IM.IntMap Cloud
, _cloudsZone :: IM.IntMap (IM.IntMap (IM.IntMap Cloud))
, _clouds :: [Cloud]
, _cloudsZone :: IM.IntMap (IM.IntMap [Cloud])
, _projectiles :: IM.IntMap Projectile
, _particles :: ![Particle]
, _staticWalls :: IM.IntMap (IM.IntMap [Wall'])
@@ -123,14 +123,17 @@ data Corpse = Corpse
, _cpRes :: Creature
}
data Cloud = Cloud
{ _clID :: Int
, _clPos :: Point2
{ _clPos :: Point2
, _clVel :: Point2
, _clPict :: Cloud -> Picture
, _clRad :: Float
, _clTimer :: Int
, _clEffect :: Cloud -> World -> World
, _clType :: CloudType
-- , _clEffect :: Cloud -> World -> World
}
data CloudType
= SmokeCloud
| GasCloud
data LightSource = LS
{ _lsID :: !Int
, _lsPos :: !Point3
src/Dodge/Default/World.hs
+1 -1
View File
@@ -27,7 +27,7 @@ defaultWorld = World
, _creatures = IM.empty
, _creaturesZone = IM.empty
, _creatureGroups = IM.empty
, _clouds = IM.empty
, _clouds = []
, _cloudsZone = IM.empty
, _itemPositions = IM.empty
, _projectiles = IM.empty
src/Dodge/Render/Picture.hs
+1 -1
View File
@@ -23,7 +23,7 @@ worldPictures w = pictures $ concat
, map (dbArg _pjDraw) . IM.elems $ _projectiles w
, map drawItem . IM.elems $ _floorItems w
, map (crDraw w) . IM.elems $ _creatures w
, map clDraw . reverse . IM.elems $ _clouds w
, map clDraw . reverse $ _clouds w
, map ppDraw . IM.elems $ _pressPlates w
, map btDraw (IM.elems (_buttons w))
, map (dbArg _ptDraw) $ _particles w
src/Dodge/Update.hs
+36 -39
View File
@@ -80,11 +80,10 @@ update' w = case _menuLayers w of
where
(x,y) = crZoneOfPoint $ _crPos cr
cid = _crID cr
zoneClouds = set cloudsZone (IM.foldr cloudInZone IM.empty (_clouds w))
cloudInZone cr = insertIMInZone x y cid cr
zoneClouds = set cloudsZone (foldr cloudInZone IM.empty (_clouds w))
cloudInZone cl = insertInZoneWith x y (++) [cl]
where
(x,y) = cloudZoneOfPoint $ _clPos cr
cid = _clID cr
(x,y) = cloudZoneOfPoint $ _clPos cl
updateCreatureGroups :: World -> World
updateCreatureGroups w = w & creatureGroups %~
@@ -161,43 +160,41 @@ checkEndGame w
| _crHP (you w) < 1 = haltSound $ w {_menuLayers = [GameOverMenu]}
| otherwise = w
--updateClouds :: World -> World
--updateClouds = (clouds .~ IM.empty) . (cloudsZone .~ IM.empty)
updateClouds :: World -> World
updateClouds w = IM.foldl' updateCloud w $ _clouds w
updateClouds w = w
--updateClouds w = IM.foldl' updateCloud w $ _clouds w
updateCloud :: World -> Cloud -> World
updateCloud w c
| _clTimer c < 1 = w & clouds %~ IM.delete (_clID c)
| otherwise = moveCloud c w
moveCloud :: Cloud -> World -> World
moveCloud c w = _clEffect c c . theUpdate $ w
where
newVel = 0.95 *.* springVels
springVels = IM.foldl' (clClSpringVel c) (_clVel c) (cloudsNearPoint oldPos w)
oldPos = _clPos c
newPos = oldPos +.+ newVel
hitWl = collideCircWalls' oldPos newPos 5 $ wallsNearPoint newPos w
finalPos = maybe newPos fst hitWl
finalVel = maybe newVel snd hitWl
theUpdate w' = w'
& clouds . ix (_clID c) . clTimer %~ (\t -> t - 1)
& clouds . ix (_clID c) . clVel .~ finalVel
& clouds . ix (_clID c) . clPos .~ finalPos
clClSpringVel :: Cloud -> Point2 -> Cloud -> Point2
clClSpringVel a v b
| ida == idb = v
| dist pa pb < radDist = v +.+ 0.1 *.* safeNormalizeV (pa -.- pb)
| otherwise = v
where
ida = _clID a
idb = _clID b
pa = _clPos a
pb = _clPos b
radDist = (_clRad a + _clRad b) / 2
--updateCloud :: World -> Cloud -> World
--updateCloud w c
-- | _clTimer c < 1 = w & clouds %~ IM.delete (_clID c)
-- | otherwise = moveCloud c w
--
--moveCloud :: Cloud -> World -> World
--moveCloud c w = _clEffect c c . theUpdate $ w
-- where
-- newVel = 0.95 *.* springVels
-- springVels = IM.foldl' (clClSpringVel c) (_clVel c) (cloudsNearPoint oldPos w)
-- oldPos = _clPos c
-- newPos = oldPos +.+ newVel
-- hitWl = collideCircWalls' oldPos newPos 5 $ wallsNearPoint newPos w
-- finalPos = maybe newPos fst hitWl
-- finalVel = maybe newVel snd hitWl
-- theUpdate w' = w'
-- & clouds . ix (_clID c) . clTimer %~ (\t -> t - 1)
-- & clouds . ix (_clID c) . clVel .~ finalVel
-- & clouds . ix (_clID c) . clPos .~ finalPos
--
--clClSpringVel :: Cloud -> Point2 -> Cloud -> Point2
--clClSpringVel a v b
-- | ida == idb = v
-- | dist pa pb < radDist = v +.+ 0.1 *.* safeNormalizeV (pa -.- pb)
-- | otherwise = v
-- where
-- ida = _clID a
-- idb = _clID b
-- pa = _clPos a
-- pb = _clPos b
-- radDist = (_clRad a + _clRad b) / 2
simpleCrSprings :: World -> World
simpleCrSprings w = IM.foldr' crSpring w $ _creatures w
src/Dodge/WorldEvent/Cloud.hs
+4 -5
View File
@@ -10,17 +10,16 @@ import qualified IntMapHelp as IM
import Control.Lens
makeCloudAt :: Float -> Int -> (Cloud -> Picture) -> Point2 -> World -> World
makeCloudAt rad t drawFunc p w = w & clouds %~ IM.insert i theCloud
makeCloudAt rad t drawFunc p w = w & clouds %~ (theCloud :)
where
i = IM.newKey $ _clouds w
theCloud = Cloud
{ _clID = i
, _clPos = p
{ _clPos = p
, _clVel = (0,0)
, _clPict = drawFunc
, _clRad = rad
, _clTimer = t
, _clEffect = const id
, _clType = SmokeCloud
--, _clEffect = const id
}
drawCloudWith :: Float -> Float -> Color -> Cloud -> Picture
src/Dodge/WorldEvent/SpawnParticle.hs
+11 -11
View File
@@ -264,19 +264,19 @@ makeGasCloud
-> World
-> World
makeGasCloud pos vel w = w
& clouds %~ IM.insert i theCloud
& clouds %~ (theCloud :)
& randGen .~ g
where
i = IM.newKey $ _clouds w
theCloud = Cloud { _clID = i
, _clPos = pos
, _clVel = vel
, _clPict = \_ -> onLayer CrLayer $ color (withAlpha 0.1 col)
$ circleSolid 20
, _clRad = 10
, _clTimer = 400
, _clEffect = cloudPoisonDamage
}
theCloud = Cloud
{ _clPos = pos
, _clVel = vel
, _clPict = \_ -> onLayer CrLayer $ color (withAlpha 0.1 col)
$ circleSolid 20
, _clRad = 10
, _clTimer = 400
, _clType = GasCloud
-- , _clEffect = cloudPoisonDamage
}
(col, g) = runState (takeOne [green,yellow]) $ _randGen w
{-