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

Reorganise block module

Browse Source
This commit is contained in:
jgk
2021-03-05 20:24:12 +01:00
parent fdca8a8760
commit bd16ad2a2a
5 changed files with 23 additions and 149 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/LevelGen.hs
+16 -31
View File
@@ -13,7 +13,7 @@ import Dodge.Data
import Dodge.Base
import Dodge.SoundLogic
import Dodge.Prototypes
import Dodge.Block
import Dodge.LevelGen.Block
import Dodge.LevelGen.StaticWalls
@@ -303,6 +303,11 @@ removePathsCrossing a b w = set pathGraph newGraph $ set pathGraph' pg'
insertPoint pp@(_,(x,y)) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
newGraph = pairsToGraph dist pg'
putBlockWallPart :: [Point2] -> Int -> Color -> Bool -> [Int] -> World -> World
putBlockWallPart (p:ps) i c b is w = foldr (uncurry removePathsCrossing) wWithBlock pairs
where pairs = zip (p:ps) (ps ++ [p])
wWithBlock = addBlock (p:ps) i c b is w
putBlock :: [Point2] -> Int -> Color -> Bool -> [Int] -> World -> World
putBlock (p:ps) i c b is w = foldr (uncurry removePathsCrossing) wWithBlock pairs
where pairs = zip (p:ps) (ps ++ [p])
@@ -338,50 +343,29 @@ putWindowBlock a b w = removePathsCrossing a b $ foldr makeBlockAt w $ zip ps ns
| otherwise = False
isRightmost | i == numPoints = True
| otherwise = False
l = Block
l = baseBlock
{ _wlLine = [bl,tl]
, _wlID = k0
, _wlColor = winCol
, _wlDraw = Nothing
, _wlSeen = False
, _blIDs = ksAtN i
, _blHP = hp
, _wlIsSeeThrough = True
--, _blVisible = False
, _blVisible = isLeftmost
, _blShadows = shadows
, _blDegrades = degradeHP
}
t = Block
t = baseBlock
{ _wlLine = [tl,tr]
, _wlID = k1
, _wlColor = winCol
, _wlDraw = Nothing
, _wlSeen = False
, _blIDs = ksAtN i
, _blHP = hp
, _wlIsSeeThrough = True
, _blVisible = seen
, _blShadows = shadows
, _blDegrades = degradeHP
}
r = Block
r = baseBlock
{ _wlLine = [tr,br]
, _wlID = k2
, _wlColor = winCol
, _wlDraw = Nothing
, _wlSeen = False
, _blIDs = ksAtN i
, _blHP = hp
, _wlIsSeeThrough = True
--, _blVisible = False
, _blVisible = isRightmost
, _blShadows = shadows
, _blDegrades = degradeHP
}
b = Block
b = baseBlock
{ _wlLine = [br,bl]
, _wlID = k3
, _blVisible = seen
}
baseBlock = Block
{ _wlLine = []
, _wlID = 0
, _wlColor = winCol
, _wlDraw = Nothing
, _wlSeen = False
@@ -391,6 +375,7 @@ putWindowBlock a b w = removePathsCrossing a b $ foldr makeBlockAt w $ zip ps ns
, _blVisible = seen
, _blShadows = shadows
, _blDegrades = degradeHP
, _wlCastShadow = False
}
f = IM.insert k0 l . IM.insert k1 t . IM.insert k2 r . IM.insert k3 b
in over walls f w