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

Refactor wall points from lists to pairs

Browse Source
This commit is contained in:
jgk
2021-05-04 01:31:55 +02:00
parent e21178b688
commit 6d4c17fc07
23 changed files with 260 additions and 255 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/LevelGen/Block.hs
+8 -8
View File
@@ -26,7 +26,7 @@ updateBlocks w = (\w' -> seq (_wallsZone w') w') $ flip (foldr removeFromZone) d
removeFromZone :: Wall -> World -> World
removeFromZone bl = over (wallsZone . ix x . ix y) (IM.delete (_wlID bl))
where
(x,y) = zoneOfPoint $ pHalf (_wlLine bl !! 0) (_wlLine bl !! 1)
(x,y) = zoneOfPoint $ pHalf (fst $ _wlLine bl) (snd $ _wlLine bl)
deadPanes = filter blockIsDead (IM.elems $ _walls w)
deadBlocks = nubBy ((==) `on` _blIDs) deadPanes
blockIsDead wl = case wl ^? blHP of
@@ -38,7 +38,7 @@ killBlock bl w = f bl . flip (foldr unshadow) (_blShadows bl) $ w
where
f bl@(Block {_blDegrades = (x:xs)}) = degradeBlock bl . hitSound bl
f bl = hitSound' bl
pos = _wlLine bl !! 0
pos = fst $ _wlLine bl
hitSound bl
| _wlIsSeeThrough bl = mkSoundBreakGlass pos
| otherwise = soundMultiFrom sos soundid 25 0
@@ -50,7 +50,7 @@ killBlock bl w = f bl . flip (foldr unshadow) (_blShadows bl) $ w
unshadow :: Int -> World -> World
unshadow bid w = case w ^? walls . ix bid of
Just b ->
let (x,y) = zoneOfPoint $ pHalf (_wlLine b !! 0) (_wlLine b !! 1)
let (x,y) = zoneOfPoint $ pHalf (fst $ _wlLine b) (snd $ _wlLine b)
in w & wallsZone . ix x . ix y . ix bid . blVisible %~ const True
& walls . ix bid . blVisible %~ const True
Nothing -> w
@@ -59,7 +59,7 @@ degradeBlock :: Wall -> World -> World
degradeBlock bl w =
let blid = _wlID bl
bls = map (\i -> _walls w IM.! i) (_blIDs $ _walls w IM.! blid)
ps = reverse $ orderPolygon $ nub $ concatMap _wlLine bls
ps = reverse $ orderPolygon $ nub $ concatMap ((\(a,b) -> [a,b]) . _wlLine) bls
(newPs,g) = runState (shrinkPolygon 0.5 ps) $ _randGen w
(x:xs) = _blDegrades bl
in addBlock newPs (x + _blHP bl) (_wlColor bl) (_wlIsSeeThrough bl) xs $ set randGen g w
@@ -104,7 +104,7 @@ addBlock (p:ps) hp col isSeeThrough degradability w
i = newKey $ _walls w
is = [i.. i + length lines-1]
panes = IM.fromList $ zip is
$ zipWith (\j (a,b) -> Block { _wlLine = [a,b]
$ zipWith (\j (a,b) -> Block { _wlLine = (a,b)
, _wlID = j
, _wlColor = col
, _wlSeen = False
@@ -117,13 +117,13 @@ addBlock (p:ps) hp col isSeeThrough degradability w
}
) is lines
wallInZone wl
| dist (_wlLine wl !! 0) (_wlLine wl !! 1) <= 2*zoneSize
| dist (fst $ _wlLine wl) (snd $ _wlLine wl) <= 2*zoneSize
= insertIMInZone x y wlid wl
| otherwise = flip (foldr (\(a,b) -> insertIMInZone a b wlid wl)) ips
where
(x,y) = zoneOfPoint $ pHalf (_wlLine wl !! 0) (_wlLine wl !! 1)
(x,y) = zoneOfPoint $ pHalf (fst $ _wlLine wl) (snd $ _wlLine wl)
wlid = _wlID wl
ips = map zoneOfPoint $ divideLine (2*zoneSize) (_wlLine wl !! 0) (_wlLine wl !! 1)
ips = map zoneOfPoint $ divideLine (2*zoneSize) (fst $ _wlLine wl) (snd $ _wlLine wl)
putBlock :: [Point2] -> Int -> Color -> Bool -> [Int] -> World -> World
putBlock (p:ps) i c b is w = foldr (uncurry removePathsCrossing) wWithBlock pairs