Commit before changing thingsHit to use stream

This commit is contained in:
2022-06-26 11:37:43 +01:00
parent 6c571d1878
commit f47059ae9b
5 changed files with 15 additions and 35 deletions
+2 -31
View File
@@ -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
+1 -1
View File
@@ -1,7 +1,7 @@
module Dodge.Debug.Picture where
import Dodge.Data
import Dodge.Base.Window
import Dodge.Base.Collide
import Dodge.Base.Wall
import Geometry
import Picture
+1 -1
View File
@@ -3,7 +3,7 @@ module Dodge.Render.Walls
) where
import Dodge.Data
import Dodge.Zone
import Dodge.Base.Collide
import Dodge.Base.Wall
import Geometry
import ShapePicture
+2 -2
View File
@@ -110,8 +110,8 @@ moveInverseShockwave w pt
r = _ptRad pt
t = _ptTimer pt
rad = r - 0.1 * r * fromIntegral (10 - t)
dams = over creatures (IM.map damCr) . flip (foldr (damageBlocksBy 1)) hitBlocks
hitBlocks = wallsOnCirc' p rad $ wallsNearPoint' p w
dams = over creatures (IM.map damCr) -- . flip (foldr (damageBlocksBy 1)) hitBlocks
-- hitBlocks = wallsOnCirc' p rad $ wallsNearPoint' p w
damCr cr
| dist (_crPos cr) p >= rad + _crRad cr = cr
| otherwise = cr & crState . csDamage .:~
+9
View File
@@ -7,6 +7,7 @@ module FoldableHelp
, safeMinMaybeL
, filter3
, takeUntil
, ssfold
, module Data.Foldable
)
where
@@ -91,3 +92,11 @@ filter3 t1 t2 t3 = L.fold $ (,,)
-}
takeUntil :: Foldable t => (a -> Bool) -> t a -> [a]
takeUntil p = foldr (\x xs -> x : if p x then [] else xs) []
-- 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