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:
justin
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 Just val -> val
_ -> IM.empty _ -> 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 = 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 where
(x,y) = cloudZoneOfPoint p (x,y) = cloudZoneOfPoint p
f i m = case IM.lookup i m of f Nothing = []
Just val -> val f (Just l) = l
_ -> IM.empty
-- possible BUG, occurs when used in thingsHitLongLine -- possible BUG, occurs when used in thingsHitLongLine
creaturesAlongLine :: Point2 -> Point2 -> World -> IM.IntMap Creature creaturesAlongLine :: Point2 -> Point2 -> World -> IM.IntMap Creature
--creaturesAlongLine a b w = IM.unions [f y $ f x $ _creaturesZone w | (x,y) <- zoneOfLine a b] --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)) , _creaturesZone :: IM.IntMap (IM.IntMap (IM.IntMap Creature))
, _creatureGroups :: IM.IntMap CrGroupParams , _creatureGroups :: IM.IntMap CrGroupParams
, _itemPositions :: IM.IntMap ItemPos , _itemPositions :: IM.IntMap ItemPos
, _clouds :: IM.IntMap Cloud , _clouds :: [Cloud]
, _cloudsZone :: IM.IntMap (IM.IntMap (IM.IntMap Cloud)) , _cloudsZone :: IM.IntMap (IM.IntMap [Cloud])
, _projectiles :: IM.IntMap Projectile , _projectiles :: IM.IntMap Projectile
, _particles :: ![Particle] , _particles :: ![Particle]
, _staticWalls :: IM.IntMap (IM.IntMap [Wall']) , _staticWalls :: IM.IntMap (IM.IntMap [Wall'])
@@ -123,14 +123,17 @@ data Corpse = Corpse
, _cpRes :: Creature , _cpRes :: Creature
} }
data Cloud = Cloud data Cloud = Cloud
{ _clID :: Int { _clPos :: Point2
, _clPos :: Point2
, _clVel :: Point2 , _clVel :: Point2
, _clPict :: Cloud -> Picture , _clPict :: Cloud -> Picture
, _clRad :: Float , _clRad :: Float
, _clTimer :: Int , _clTimer :: Int
, _clEffect :: Cloud -> World -> World , _clType :: CloudType
-- , _clEffect :: Cloud -> World -> World
} }
data CloudType
= SmokeCloud
| GasCloud
data LightSource = LS data LightSource = LS
{ _lsID :: !Int { _lsID :: !Int
, _lsPos :: !Point3 , _lsPos :: !Point3
src/Dodge/Default/World.hs
+1 -1
View File
@@ -27,7 +27,7 @@ defaultWorld = World
, _creatures = IM.empty , _creatures = IM.empty
, _creaturesZone = IM.empty , _creaturesZone = IM.empty
, _creatureGroups = IM.empty , _creatureGroups = IM.empty
, _clouds = IM.empty , _clouds = []
, _cloudsZone = IM.empty , _cloudsZone = IM.empty
, _itemPositions = IM.empty , _itemPositions = IM.empty
, _projectiles = 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 (dbArg _pjDraw) . IM.elems $ _projectiles w
, map drawItem . IM.elems $ _floorItems w , map drawItem . IM.elems $ _floorItems w
, map (crDraw w) . IM.elems $ _creatures 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 ppDraw . IM.elems $ _pressPlates w
, map btDraw (IM.elems (_buttons w)) , map btDraw (IM.elems (_buttons w))
, map (dbArg _ptDraw) $ _particles 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 where
(x,y) = crZoneOfPoint $ _crPos cr (x,y) = crZoneOfPoint $ _crPos cr
cid = _crID cr cid = _crID cr
zoneClouds = set cloudsZone (IM.foldr cloudInZone IM.empty (_clouds w)) zoneClouds = set cloudsZone (foldr cloudInZone IM.empty (_clouds w))
cloudInZone cr = insertIMInZone x y cid cr cloudInZone cl = insertInZoneWith x y (++) [cl]
where where
(x,y) = cloudZoneOfPoint $ _clPos cr (x,y) = cloudZoneOfPoint $ _clPos cl
cid = _clID cr
updateCreatureGroups :: World -> World updateCreatureGroups :: World -> World
updateCreatureGroups w = w & creatureGroups %~ updateCreatureGroups w = w & creatureGroups %~
@@ -161,43 +160,41 @@ checkEndGame w
| _crHP (you w) < 1 = haltSound $ w {_menuLayers = [GameOverMenu]} | _crHP (you w) < 1 = haltSound $ w {_menuLayers = [GameOverMenu]}
| otherwise = w | otherwise = w
--updateClouds :: World -> World
--updateClouds = (clouds .~ IM.empty) . (cloudsZone .~ IM.empty)
updateClouds :: World -> World 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 :: World -> Cloud -> World
updateCloud w c --updateCloud w c
| _clTimer c < 1 = w & clouds %~ IM.delete (_clID c) -- | _clTimer c < 1 = w & clouds %~ IM.delete (_clID c)
| otherwise = moveCloud c w -- | otherwise = moveCloud c w
--
moveCloud :: Cloud -> World -> World --moveCloud :: Cloud -> World -> World
moveCloud c w = _clEffect c c . theUpdate $ w --moveCloud c w = _clEffect c c . theUpdate $ w
where -- where
newVel = 0.95 *.* springVels -- newVel = 0.95 *.* springVels
springVels = IM.foldl' (clClSpringVel c) (_clVel c) (cloudsNearPoint oldPos w) -- springVels = IM.foldl' (clClSpringVel c) (_clVel c) (cloudsNearPoint oldPos w)
oldPos = _clPos c -- oldPos = _clPos c
newPos = oldPos +.+ newVel -- newPos = oldPos +.+ newVel
hitWl = collideCircWalls' oldPos newPos 5 $ wallsNearPoint newPos w -- hitWl = collideCircWalls' oldPos newPos 5 $ wallsNearPoint newPos w
finalPos = maybe newPos fst hitWl -- finalPos = maybe newPos fst hitWl
finalVel = maybe newVel snd hitWl -- finalVel = maybe newVel snd hitWl
theUpdate w' = w' -- theUpdate w' = w'
& clouds . ix (_clID c) . clTimer %~ (\t -> t - 1) -- & clouds . ix (_clID c) . clTimer %~ (\t -> t - 1)
& clouds . ix (_clID c) . clVel .~ finalVel -- & clouds . ix (_clID c) . clVel .~ finalVel
& clouds . ix (_clID c) . clPos .~ finalPos -- & clouds . ix (_clID c) . clPos .~ finalPos
--
clClSpringVel :: Cloud -> Point2 -> Cloud -> Point2 --clClSpringVel :: Cloud -> Point2 -> Cloud -> Point2
clClSpringVel a v b --clClSpringVel a v b
| ida == idb = v -- | ida == idb = v
| dist pa pb < radDist = v +.+ 0.1 *.* safeNormalizeV (pa -.- pb) -- | dist pa pb < radDist = v +.+ 0.1 *.* safeNormalizeV (pa -.- pb)
| otherwise = v -- | otherwise = v
where -- where
ida = _clID a -- ida = _clID a
idb = _clID b -- idb = _clID b
pa = _clPos a -- pa = _clPos a
pb = _clPos b -- pb = _clPos b
radDist = (_clRad a + _clRad b) / 2 -- radDist = (_clRad a + _clRad b) / 2
simpleCrSprings :: World -> World simpleCrSprings :: World -> World
simpleCrSprings w = IM.foldr' crSpring w $ _creatures w 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 import Control.Lens
makeCloudAt :: Float -> Int -> (Cloud -> Picture) -> Point2 -> World -> World 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 where
i = IM.newKey $ _clouds w
theCloud = Cloud theCloud = Cloud
{ _clID = i { _clPos = p
, _clPos = p
, _clVel = (0,0) , _clVel = (0,0)
, _clPict = drawFunc , _clPict = drawFunc
, _clRad = rad , _clRad = rad
, _clTimer = t , _clTimer = t
, _clEffect = const id , _clType = SmokeCloud
--, _clEffect = const id
} }
drawCloudWith :: Float -> Float -> Color -> Cloud -> Picture drawCloudWith :: Float -> Float -> Color -> Cloud -> Picture
src/Dodge/WorldEvent/SpawnParticle.hs
+11 -11
View File
@@ -264,19 +264,19 @@ makeGasCloud
-> World -> World
-> World -> World
makeGasCloud pos vel w = w makeGasCloud pos vel w = w
& clouds %~ IM.insert i theCloud & clouds %~ (theCloud :)
& randGen .~ g & randGen .~ g
where where
i = IM.newKey $ _clouds w theCloud = Cloud
theCloud = Cloud { _clID = i { _clPos = pos
, _clPos = pos , _clVel = vel
, _clVel = vel , _clPict = \_ -> onLayer CrLayer $ color (withAlpha 0.1 col)
, _clPict = \_ -> onLayer CrLayer $ color (withAlpha 0.1 col) $ circleSolid 20
$ circleSolid 20 , _clRad = 10
, _clRad = 10 , _clTimer = 400
, _clTimer = 400 , _clType = GasCloud
, _clEffect = cloudPoisonDamage -- , _clEffect = cloudPoisonDamage
} }
(col, g) = runState (takeOne [green,yellow]) $ _randGen w (col, g) = runState (takeOne [green,yellow]) $ _randGen w
{- {-