Refactor more instances to use streaming

This commit is contained in:
2022-06-24 14:30:16 +01:00
parent b467a7dd91
commit 0270d423fd
2 changed files with 17 additions and 17 deletions
+10 -11
View File
@@ -53,13 +53,15 @@ import qualified Streaming.Prelude as S
hasLOS :: Point2 -> Point2 -> World -> Bool hasLOS :: Point2 -> Point2 -> World -> Bool
{-# INLINE hasLOS #-} {-# INLINE hasLOS #-}
hasLOS p1 p2 = not . pointHitsWalls p1 p2 . wallsAlongLine p1 p2 hasLOS p1 p2 = not
. collidePointTestFilter (const True) p1 p2
. wallsAlongLineStream p1 p2
hasButtonLOS :: Point2 -> Point2 -> World -> Bool hasButtonLOS :: Point2 -> Point2 -> World -> Bool
{-# INLINE hasButtonLOS #-} {-# INLINE hasButtonLOS #-}
hasButtonLOS p1 p2 = not . pointHitsWalls p1 p2 hasButtonLOS p1 p2 = not
. IM.filter (not . _wlTouchThrough) . collidePointTestFilter (not . _wlTouchThrough) p1 p2
. wallsAlongLine p1 p2 . wallsAlongLineStream p1 p2
--hitPointLines --hitPointLines
-- :: Point2 -- :: Point2
@@ -225,9 +227,9 @@ collidePointIndirect' p1 p2
-- the reason for using the dashed version is the hope that this will short -- the reason for using the dashed version is the hope that this will short
-- circuit -- circuit
hasLOSIndirect :: Point2 -> Point2 -> World -> Bool hasLOSIndirect :: Point2 -> Point2 -> World -> Bool
hasLOSIndirect p1 p2 w = case collidePointIndirect' p1 p2 $ wallsAlongLine p1 p2 w of hasLOSIndirect p1 p2 = not
Just _ -> False . collidePointTestFilter wlIsOpaque p1 p2
Nothing -> True . wallsAlongLineStream p1 p2
isWalkable :: Point2 -> Point2 -> World -> Bool isWalkable :: Point2 -> Point2 -> World -> Bool
isWalkable p1 p2 = not isWalkable p1 p2 = not
@@ -283,10 +285,7 @@ canSee i j w = hasLOS p1 p2 w
-- jpos = _crPos (_creatures w IM.! j) -- jpos = _crPos (_creatures w IM.! j)
canSeeIndirect :: Int -> Int -> World -> Bool canSeeIndirect :: Int -> Int -> World -> Bool
canSeeIndirect i j w = not canSeeIndirect i j w = hasLOSIndirect ipos jpos w
$ any (isJust . uncurry (intersectSegSeg ipos jpos) . _wlLine)
$ IM.filter wlIsOpaque
$ wallsAlongLine ipos jpos w
where where
ipos = _crPos (_creatures w IM.! i) ipos = _crPos (_creatures w IM.! i)
jpos = _crPos (_creatures w IM.! j) jpos = _crPos (_creatures w IM.! j)
+7 -6
View File
@@ -44,12 +44,13 @@ initialAnoTree = OnwardList
, AnRoom slowDoorRoom , AnRoom slowDoorRoom
, AnTree firstBreather , AnTree firstBreather
, AnTree $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward , AnTree $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward
] -- ]
--
extraAnoList :: [Annotation] --extraAnoList :: [Annotation]
extraAnoList = --extraAnoList =
-- , (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor]) ---- , (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor])
[ AnRoom $ roomCCrits 10 -- [ AnRoom $ roomCCrits 10
, AnRoom $ roomCCrits 10
, AnTree $ tToBTree "spawners" <$> spawnerRoom , AnTree $ tToBTree "spawners" <$> spawnerRoom
, AnRoom pistolerRoom , AnRoom pistolerRoom
, AnRoom doubleCorridorBarrels , AnRoom doubleCorridorBarrels