diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index 119f095d3..11855dfe5 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -20,7 +20,7 @@ import qualified IntMapHelp as IM import Control.Lens --import Control.Monad.State -import Data.List +--import Data.List --import Data.Function import Data.Maybe --import Data.Bifunctor @@ -82,14 +82,6 @@ wallsOnLine p1 p2 ws = hitWalls hitPoint w = uncurry (intersectSegSeg' p1 p2) (_wlLine w) hitWalls = filter (isJust . hitPoint) (IM.elems ws) -wallOnLine :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Wall -wallOnLine p1 p2 ws - = listToMaybe $ sortBy f hitWalls - where - hitPoint w = uncurry (intersectSegSeg' p1 p2) (_wlLine w) - hitWalls = filter (isJust . hitPoint) (IM.elems ws) - f w1 w2 = compare (magV (p1 -.- fromJust (hitPoint w1))) (magV (p1 -.- fromJust (hitPoint w2))) - wallsOnCirc :: Point2 -> Float -> IM.IntMap Wall -> IM.IntMap Wall wallsOnCirc p r = IM.filter f where @@ -206,7 +198,6 @@ reflectPointCreature p1 p2 cr = case collidePointCirc p1 p2 (_crRad cr) (_crPos reflectPointCreatures :: Point2 -> Point2 -> IM.IntMap Creature -> Maybe (Point2,Point2,Int) reflectPointCreatures p1 p2 cs = safeMinimumOn f - . IM.elems $ IM.mapMaybe (reflectPointCreature p1 p2) cs where f (a,_,_) = magV (a -.- p1) @@ -233,9 +224,7 @@ reflectCircCreatures -> IM.IntMap Creature -> Maybe (Point2,Point2,Int) reflectCircCreatures rad p1 p2 cs - = listToMaybe - . sortOn f - . IM.elems + = safeMinimumOn f $ IM.mapMaybe (reflectCircCreature rad p1 p2) cs where f (a,_,_) = magV (a -.- p1) @@ -265,9 +254,7 @@ collidePointFF = undefined -- If found, gives point and reflection velocity, reflection damped in normal. collideCircWalls' :: Point2 -> Point2 -> Float -> IM.IntMap Wall -> Maybe (Point2,Point2) collideCircWalls' p1 p2 rad ws - = listToMaybe - . sortOn f - . IM.elems + = safeMinimumOn f $ IM.mapMaybe (( \(x:y:_) -> fmap ((, reflectInParam 0.5 (x -.- y) (p2 -.- p1)) @@ -293,8 +280,7 @@ collideCircWalls' p1 p2 rad ws -- If found, gives point and normal of wall. collidePointLines :: Point2 -> Point2 -> [Wall'] -> Maybe (Point2,Point2) collidePointLines p1 p2 ws - = listToMaybe - . sortOn f + = safeMinimumOn f $ mapMaybe (( \(x,y) -> intersectSegSeg' p1 p2 x y <&> ( , vNormal $ x -.- y ) ) . _wlLine') ws where @@ -304,9 +290,7 @@ collidePointLines p1 p2 ws -- If found, gives point and normal of wall. collidePointWallsNorm :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2) collidePointWallsNorm p1 p2 ws - = listToMaybe - . sortOn f - . IM.elems + = safeMinimumOn f $ IM.mapMaybe (( \(x,y) -> intersectSegSeg' p1 p2 x y <&> ( , vNormal $ x -.- y ) ) . _wlLine) ws where @@ -315,8 +299,7 @@ collidePointWallsNorm p1 p2 ws collidePointCreatures :: Point2 -> Point2 -> World -> Maybe Int collidePointCreatures p1 p2 w = fmap fst - . listToMaybe - . sortOn snd + . safeMinimumOn snd . IM.toList . IM.mapMaybe (\x -> collidePointCirc' p1 p2 (_crRad x) (_crPos x)) $_creatures w @@ -325,8 +308,7 @@ collidePointCreatures p1 p2 w collideCircCreatures :: Point2 -> Point2 -> Float -> World -> Maybe Int collideCircCreatures p1 p2 rad w = fmap fst - . listToMaybe - . sortOn snd + . safeMinimumOn snd . IM.toList . IM.mapMaybe (\x -> collidePointCirc' p1 p2 (rad + _crRad x) (_crPos x)) $ _creatures w @@ -335,8 +317,7 @@ collideCircCreatures p1 p2 rad w collidePointCrsPoint :: Point2 -> Point2 -> World -> Maybe (Point2,Int) collidePointCrsPoint p1 p2 w = fmap f - . listToMaybe - . sortOn (snd . snd) + . safeMinimumOn (snd . snd) . IM.toList . IM.mapMaybe (\x -> collidePointCirc'' p1 p2 (_crRad x) (_crPos x)) $ _creatures w @@ -347,8 +328,7 @@ Maybe evaluates the creature id and hit point. -} collideCircCrsPoint :: Point2 -> Point2 -> Float -> World -> Maybe (Point2,Int) collideCircCrsPoint p1 p2 rad w = fmap f - . listToMaybe - . sortOn (snd . snd) + . safeMinimumOn (snd . snd) . IM.toList . IM.mapMaybe (\x -> collidePointCirc'' p1 p2 (rad + _crRad x) (_crPos x)) $ _creatures w @@ -358,8 +338,7 @@ collideCircCrsPoint p1 p2 rad w collidePointCrsWithoutPoint :: Int -> Point2 -> Point2 -> World -> Maybe (Point2,Int) collidePointCrsWithoutPoint cid p1 p2 w = fmap f - . listToMaybe - . sortOn (snd . snd) + . safeMinimumOn (snd . snd) . IM.toList . IM.mapMaybe (\x -> collidePointCirc'' p1 p2 (_crRad x) (_crPos x)) . IM.delete cid @@ -403,21 +382,18 @@ crsOnThickLine thickness p1 p2 w {- | Find 'Maybe' the closest creature to a point, within a circle. -} nearestCrInRad :: Point2 -> Float -> World -> Maybe Creature -nearestCrInRad p r w = - let crs = IM.filter (\cr -> dist p (_crPos cr) < r) $ _creatures w - sortedCrs = sortOn (dist p . _crPos) $ IM.elems crs - in listToMaybe sortedCrs -{- | Find 'Maybe' the closest creature in front of a point in a right-angle-triangle shape. - -} +nearestCrInRad p r w + = safeMinimumOn (dist p . _crPos) + $ IM.filter (\cr -> dist p (_crPos cr) < r) $ _creatures w +{- | Find 'Maybe' the closest creature in front of a point in a right-angle-triangle shape. -} nearestCrInTri :: Point2 -> Float -- ^ Direction (radians +ve anticlockwise from x-axis). -> Float -- ^ Distance. -> World -> Maybe Creature -nearestCrInTri p dir x w = - let crs = IM.filter (\cr -> errorPointInPolygon 1 (_crPos cr) tri) $ _creatures w - sortedCrs = sortOn (dist p . _crPos) $ IM.elems crs - in listToMaybe sortedCrs +nearestCrInTri p dir x w + = safeMinimumOn (dist p . _crPos) + $ IM.filter (\cr -> errorPointInPolygon 1 (_crPos cr) tri) $ _creatures w where tri = [p @@ -432,10 +408,9 @@ nearestCrInFront -> Float -- ^ Direction (radians +ve anticlockwise from x-axis). -> Float -- ^ Distance. -> World -> Maybe Creature -nearestCrInFront p dir x w = - let crs = IM.filter (\cr -> errorPointInPolygon 2 (_crPos cr) rec) $ _creatures w - sortedCrs = sortOn (dist p . _crPos) $ IM.elems crs - in listToMaybe sortedCrs +nearestCrInFront p dir x w + = safeMinimumOn (dist p . _crPos) + $ IM.filter (\cr -> errorPointInPolygon 2 (_crPos cr) rec) $ _creatures w where rec = [p, pR, pR1, pL1, pL ] pR = p +.+ rotateV (dir - pi*(3/8)) (x/2,0) diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index 699610ce2..c6eed148e 100644 --- a/src/Dodge/Base/Collide.hs +++ b/src/Dodge/Base/Collide.hs @@ -8,6 +8,7 @@ import Geometry --import Data.List import Data.Maybe +import Data.Foldable import qualified Data.IntMap.Strict as IM import Control.Lens @@ -16,15 +17,23 @@ import Control.Lens -- -- > safeMinimumOn id [] == Nothing -- > safeMinimumOn length ["test","extra","a"] == Just "a" -safeMinimumOn :: (Ord b) => (a -> b) -> [a] -> Maybe a -safeMinimumOn _ [] = Nothing -safeMinimumOn f (x:xs) = g x (f x) xs +safeMinimumOn' :: (Ord b) => (a -> b) -> [a] -> Maybe a +safeMinimumOn' _ [] = Nothing +safeMinimumOn' f (x:xs) = g x (f x) xs where g v _ [] = Just v g v mv (y:ys) | my < mv = g y my ys | otherwise = g v mv ys where my = f y +safeMinimumOn :: (Foldable t,Ord b) => (a -> b) -> t a -> Maybe a +safeMinimumOn f = foldl' g Nothing + where + g (Just x) y + | f x < f y = Just x + | otherwise = Just y + g Nothing y = Just y + hasLOS :: Point2 -> Point2 -> World -> Bool {-# INLINE hasLOS #-} hasLOS p1 p2 w = not $ pointHitsWalls p1 p2 $ wallsAlongLine p1 p2 w @@ -44,7 +53,6 @@ hitPointLines p1 p2 reflectPointWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2) reflectPointWalls p1 p2 ws = safeMinimumOn (dist p1 . fst) - . IM.elems $ IM.mapMaybe (( \(x,y) -> fmap ( (, reflectIn (x -.- y) (p2 -.- p1)) @@ -63,7 +71,6 @@ reflectPointWallsDamped -> Maybe (Point2,Point2) reflectPointWallsDamped dfact p1 p2 ws = safeMinimumOn (dist p1 . fst) - . IM.elems $ IM.mapMaybe (( \(x,y) -> fmap ((, reflectInParam dfact (x -.- y) (p2 -.- p1)) . (+.+ errorNormalizeV 40 (vNormal (x -.- y)))) @@ -84,14 +91,12 @@ furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2 furthestPointWalkable p1 p2 ws = fromMaybe p2 . safeMinimumOn (dist p1) - . IM.elems $ IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine) ws collidePointIndirect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2 {-# INLINE collidePointIndirect #-} collidePointIndirect p1 p2 ws = safeMinimumOn (dist p1) - . IM.elems . IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine) $ IM.filter (not . _wlIsSeeThrough) ws {- | Checks to see whether someone can fire bullets effectively between two points. @@ -99,7 +104,6 @@ collidePointIndirect p1 p2 ws collidePointFire :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2 collidePointFire p1 p2 ws = safeMinimumOn (dist p1) - . IM.elems . IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine ) $ IM.filter (\wl -> not (_wlIsSeeThrough wl && isJust (wl ^? blHP))) ws {- | Checks to see whether someone can fire bullets effectively between two points.