Implement wall penetrating bullets

This commit is contained in:
jgk
2021-03-23 12:06:46 +01:00
parent 63a50f0e05
commit 941fef134d
7 changed files with 67 additions and 90 deletions
+2 -2
View File
@@ -35,7 +35,6 @@ updateBlocks w = (\w' -> seq (_wallsZone w') w') $ flip (foldr removeFromZone) d
killBlock :: Wall -> World -> World
killBlock bl w = f bl .
flip (foldr unshadow)
-- flip (foldr (\i -> set (walls . ix i . blVisible) (True)))
(_blShadows bl)
$ w
where
@@ -50,7 +49,8 @@ killBlock bl w = f bl .
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)
in w & wallsZone . ix x . ix y . ix bid . blVisible %~ \_ -> True
in w & wallsZone . ix x . ix y . ix bid . blVisible %~ (\_ -> True)
& walls . ix bid . blVisible %~ \_ -> True
Nothing -> w
degradeBlock :: Wall -> World -> World
+3 -56
View File
@@ -33,59 +33,6 @@ basePane = Block
evenOddSplit = foldr f ([],[])
where f a (ls,rs) = (rs, a : ls)
putWindowBlock :: Point2 -> Point2 -> World -> World
putWindowBlock a b w = removePathsCrossing a b $ foldr (makeBlockAt bSide) w $ zip ps ns
where d = dist a b
rot = argV (b -.- a)
numPoints = 2 * floor (d / 20)
ns = take (numPoints+1) [0..]
ps = map (\i -> a +.+ i/ (fromIntegral numPoints) *.* (b -.- a))
$ map fromIntegral ns
bSide = d / (fromIntegral numPoints)
makeBlockAt :: Float -> (Point2,Int) -> World -> World
makeBlockAt bSide (p,i) w =
let k = newKey $ _walls w
ds = [(-bSide,-9),(-bSide,9),(bSide,9),(bSide,-9)]
polyAtP p = map ((+.+) p . rotateV rot) ds
ksAtN i = [k+i*4,k+i*4 + 1 ,k+i*4 +2, k+i*4+3]
(k0:k1:k2:k3:_) = ksAtN i
(bl:tl:tr:br:_) = polyAtP p
shadows | i == 0 = ksAtN 1
| i == numPoints - 1 = ksAtN $ numPoints - 2
| otherwise = ksAtN (i-1) ++ ksAtN (i+1)
seen | even i = True
| otherwise = False
isLeftmost | i == 0 = True
| otherwise = False
isRightmost | i == numPoints = True
| otherwise = False
l = baseBlock
{ _wlLine = [bl,tl]
, _wlID = k0
, _blVisible = isLeftmost
}
t = baseBlock
{ _wlLine = [tl,tr]
, _wlID = k1
, _blVisible = seen
}
r = baseBlock
{ _wlLine = [tr,br]
, _wlID = k2
, _blVisible = isRightmost
}
b = baseBlock
{ _wlLine = [br,bl]
, _wlID = k3
, _blVisible = seen
}
baseBlock = basePane
{ _blIDs = ksAtN i
, _blShadows = shadows
}
f = IM.insert k0 l . IM.insert k1 t . IM.insert k2 r . IM.insert k3 b
in over walls f w
putWindowBlock' :: Point2 -> Point2 -> World -> World
putWindowBlock' a b w = removePathsCrossing a b $ foldr insertBlock w listBlocks
where d = dist a b
@@ -108,11 +55,11 @@ putWindowBlock' a b w = removePathsCrossing a b $ foldr insertBlock w listBlocks
| i == numBlocks - 1 = [False,True, True,True]
| otherwise = [False,True,False,True]
shadowsAt i | i == 0 = ksAtI 1
| i == numBlocks - 1 = ksAtI $ numBlocks - 1
| i == numBlocks - 1 = ksAtI $ numBlocks - 2
| otherwise = ksAtI (i-1) ++ ksAtI (i+1)
makeBlockAt :: Point2 -> Int -> [Wall]
makeBlockAt p i = zipWith3 (makePane i) (ksAtI i) (visibilityAt i) (linesAt p)
makePane i k' visStatus ps
makeBlockAt p i = zipWith3 (makePane i) (visibilityAt i) (ksAtI i) (linesAt p)
makePane i visStatus k' ps
= basePane {_wlID = k'
,_wlLine = ps
,_blIDs = ksAtI i