Improve wall squashing further

This commit is contained in:
2026-03-26 20:25:59 +00:00
parent 62a37388e7
commit 0ddedf7fd6
9 changed files with 99 additions and 79 deletions
+5 -5
View File
@@ -154,19 +154,19 @@ thingsHitExceptCr (Just cid) sp ep = filter t . thingsHit sp ep
t = (Just cid /=) . (^? _2 . _Left . crID)
wlsHit :: Point2 -> Point2 -> World -> [(Point2, Wall)]
wlsHit sp ep = sortOn (dist sp . fst) . wlsHitUnsorted sp ep
wlsHit sp ep = sortOn (dist sp . fst) . IM.elems . wlsHitUnsorted sp ep
---- pushes out any hit point by one
wlHitPos :: Point2 -> Point2 -> World -> Point2
wlHitPos sp ep = maybe ep ((+ normalize (ep - sp)) . fst) . safeHead . wlsHit sp ep
wlsHitUnsorted :: Point2 -> Point2 -> World -> [(Point2, Wall)]
wlsHitUnsorted :: Point2 -> Point2 -> World -> IM.IntMap (Point2, Wall)
wlsHitUnsorted sp ep
| sp == ep = const mempty
| otherwise = overlapSegWalls sp ep . IM.elems . wlsNearSeg sp ep
| otherwise = overlapSegWalls sp ep . wlsNearSeg sp ep
wlsHitRadial :: Point2 -> Float -> World -> [(Point2, Wall)]
wlsHitRadial p r = mapMaybe f . IM.elems . wlsNearCirc p r
wlsHitRadial :: Point2 -> Float -> World -> IM.IntMap (Point2, Wall)
wlsHitRadial p r = IM.mapMaybe f . wlsNearCirc p r
where
--f wl = uncurry (intersectSegSeg p (p - r *.* v)) (_wlLine wl) <&> (,wl)
f wl = mhp <&> (,wl)