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

General improvement to shadows

Browse Source
This commit is contained in:
jgk
2021-03-06 12:23:19 +01:00
parent 079f4deecf
commit d57bfcf354
4 changed files with 79 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/LevelGen/Block.hs
+49 -1
View File
@@ -4,6 +4,8 @@ import Dodge.Data
import Dodge.Base
import Dodge.SoundLogic
import Dodge.LevelGen.Pathing
import Geometry
import Picture.Data
@@ -68,6 +70,42 @@ pushPointTowardsBy x p ps = do
shrinkPolygon :: RandomGen g => Float -> [Point2] -> State g [Point2]
shrinkPolygon x ps = sequence $ map (flip (pushPointTowardsBy x) ps) ps
addBlockNoShadow :: [Point2] -> Int -> Color -> Bool -> [Int] -> Bool -> World -> World
addBlockNoShadow (p:ps) hp col isSeeThrough degradability hasAllShadows w
| hp <= 0 && degradability == [] = w
| hp <= 0 = addBlock (p:ps) (head degradability + hp) col isSeeThrough (tail degradability) w
| otherwise = over wallsZone (flip (IM.foldr wallInZone) blocks)
$ over walls (IM.union blocks) w
--addBlock (p:p':ps) w = over walls (IM.insert i b) w
where
shadowList | hasAllShadows = repeat True
| otherwise = concat $ repeat [False,True]
lines = zip (p:ps) (ps ++ [p])
i = newKey $ _walls w
is = [i.. i + length lines-1]
blocks = IM.fromList $ zip is
$ zipWith3 (\j (a,b) bool
-> Block { _wlLine = [a,b]
, _wlID = j
-- , _wlColor = greyN 0.5
, _wlColor = col
, _wlDraw = Nothing
, _wlSeen = False
, _blIDs = is
, _blHP = hp
, _wlIsSeeThrough = isSeeThrough
, _blVisible = True
, _blShadows = []
, _blDegrades = degradability
, _wlCastShadow = bool
}
) is lines shadowList
wallInZone wl | dist (_wlLine wl !! 0) (_wlLine wl !! 1) <= 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))
wlid = _wlID wl
ips = map zoneOfPoint $ divideLine (2*zoneSize) (_wlLine wl !! 0) (_wlLine wl !! 1)
addBlock :: [Point2] -> Int -> Color -> Bool -> [Int] -> World -> World
addBlock (p:ps) hp col isSeeThrough degradability w
@@ -93,7 +131,7 @@ addBlock (p:ps) hp col isSeeThrough degradability w
, _blVisible = True
, _blShadows = []
, _blDegrades = degradability
, _wlCastShadow = False
, _wlCastShadow = True
}
) is lines
wallInZone wl | dist (_wlLine wl !! 0) (_wlLine wl !! 1) <= 2*zoneSize
@@ -103,3 +141,13 @@ addBlock (p:ps) hp col isSeeThrough degradability w
wlid = _wlID wl
ips = map zoneOfPoint $ divideLine (2*zoneSize) (_wlLine wl !! 0) (_wlLine wl !! 1)
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 = addBlockNoShadow (p:ps) i c b is False 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])
wWithBlock = addBlock (p:ps) i c b is w