Commit before changing thingsHit to use stream
This commit is contained in:
@@ -15,12 +15,8 @@ module Dodge.Base.Collide
|
||||
, collidePointTestFilter
|
||||
, bounceBall
|
||||
, bouncePoint
|
||||
, ssfold
|
||||
, collidePointUpToIndirectMinDist
|
||||
, wlIsOpaque
|
||||
, wlIsSeeThrough
|
||||
, wallsOnCirc
|
||||
, wallsOnCirc'
|
||||
-- , wallsOnCirc
|
||||
-- , wallsOnCirc'
|
||||
, wallsOnLineHit
|
||||
, collideCircWallsStream
|
||||
, collideCircWalls
|
||||
@@ -120,37 +116,12 @@ allVisibleWalls w = concats $ S.subst (flip (visibleWalls vPos) w . (+.+ vPos))
|
||||
where
|
||||
vPos = _cameraViewFrom w
|
||||
|
||||
collidePointUpToIndirectMinDist
|
||||
:: Point2 -- ^start point
|
||||
-> Point2 -- ^end point
|
||||
-> Float -- ^minimal possible distance
|
||||
-> IM.IntMap Wall
|
||||
-> Point2
|
||||
{-# INLINE collidePointUpToIndirectMinDist #-}
|
||||
collidePointUpToIndirectMinDist p1 p2 md = ssfold prop f p2 . IM.filter wlIsOpaque
|
||||
where
|
||||
f x wl = fromMaybe x . uncurry (intersectSegSeg p1 x) $ _wlLine wl
|
||||
prop p3 = dist p1 p3 < md
|
||||
|
||||
-- from haskell-cafe
|
||||
-- short circuit a fold when a given property is satisfied
|
||||
-- the fold builds a function that is then called on a0
|
||||
ssfold :: Foldable t => (a -> Bool) -> (a -> b -> a) -> a -> t b -> a
|
||||
{-# INLINABLE ssfold #-}
|
||||
ssfold p f a0 xs = foldr (\x g a -> if p a then a else g (f a x)) id xs a0
|
||||
|
||||
|
||||
wallsOnLineHit :: Point2 -> Point2 -> IM.IntMap Wall -> IM.IntMap (Point2, Wall)
|
||||
wallsOnLineHit p1 p2 = IM.mapMaybe f
|
||||
where
|
||||
f wl = uncurry (intersectSegSeg p1 p2) (_wlLine wl) <&> (, wl)
|
||||
|
||||
wallsOnCirc :: Point2 -> Float -> IM.IntMap Wall -> IM.IntMap Wall
|
||||
wallsOnCirc p r = IM.filter (uncurry (circOnSeg p r) . _wlLine)
|
||||
|
||||
wallsOnCirc' :: Point2 -> Float -> [Wall] -> [Wall]
|
||||
wallsOnCirc' p r = filter $ uncurry (circOnSeg p r) . _wlLine
|
||||
|
||||
-- | Looks for any collision of a circle with walls.
|
||||
-- If found, gives point and reflection velocity, reflection damped in normal.
|
||||
-- note that in this version the circle can overlap the wall
|
||||
|
||||
Reference in New Issue
Block a user