loop/src/Dodge/Base/Collide.hs

{-# LANGUAGE TupleSections #-}
{- | Basic collision detection for a moving point -}
module Dodge.Base.Collide
    ( hasLOS
    , collidePointWallsWall
    , hasButtonLOS
    , reflectPointWalls
    , reflectPointWallsDamp
    , ssfold
    , collidePointUpToIndirectMinDist
    , canSeeIndirect
    , isWalkable
    , canSee
    , hasLOSIndirect
    , wlIsOpaque
    , wlIsSeeThrough
    , wallsOnCirc
    , wallsOnLineHit
    , collideCircWalls
    , collideCircWalls'
    , circOnSomeWall
    , collidePointWalls
    , collidePointWallsNorm
    , collidePointWalls'
    , overlapCircWallsReturnWall
    , collideCircCrsPoint
    , collideCircCreatures
    , collidePointCreatures
    , collidePointAnyWallsReflect
    , crsNearPoint
    , crsOnLine
    , crsOnThickLine
    , nearestCrInRad
    , nearestCrInTri
    , nearestCrInFront
    ) where
import Dodge.Data
import Dodge.Zone
import Dodge.Wall.Reflect
import Geometry
import FoldableHelp

--import Data.List
import Data.Maybe
import qualified Data.IntMap.Strict as IM
import Control.Lens
import qualified FoldlHelp as L
import Data.Monoid

hasLOS :: Point2 -> Point2 -> World -> Bool
{-# INLINE hasLOS #-}
hasLOS p1 p2 = not . pointHitsWalls p1 p2 . wallsAlongLine p1 p2

hasButtonLOS :: Point2 -> Point2 -> World -> Bool
{-# INLINE hasButtonLOS #-}
hasButtonLOS p1 p2 = not . pointHitsWalls p1 p2
    . IM.filter (not . _wlTouchThrough) 
    . wallsAlongLine p1 p2

--hitPointLines
--    :: Point2
--    -> Point2
--    -> [(Point2,Point2)]
--    -> Maybe (Point2,(Point2,Point2))
--hitPointLines p1 p2
--    = safeMinimumOn (dist p1 . fst)
--    . mapMaybe
--    (\(x,y) -> (, (x,y)) <$> intersectSegSeg p1 p2 x y)

reflectPointWallsDamp :: Float -> Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
reflectPointWallsDamp x p1 p2 = fmap (f p1 p2) . collidePointWallsWall p1 p2 
  where
    f a b (p,wl) = ( p +.+ errorNormalizeV 139 (vNormal (uncurry (-.-) $ _wlLine wl))
        , reflVelWallDamp x wl (b-.-a)
        )

-- | Looks for first collision of a point with walls.
-- If found, gives point and wall.
-- (This can probably be improved, eg by folding over the walls and on finding a
-- wall moving the end point to the collision point, but the returns in speed
-- are probably minimal)
collidePointWallsWall :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Wall)
collidePointWallsWall p1 p2 
    = safeMinimumOn (dist p1 . fst)
    . IM.mapMaybe ( \wl -> uncurry (intersectSegSeg p1 p2) (_wlLine wl) <&> ( , wl ) ) 

-- | looks for first collision of a point with walls
-- if found, gives point and reflection velocity
reflectPointWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
reflectPointWalls p1 p2
    = safeMinimumOn (dist p1 . fst)
    . IM.mapMaybe
        (( \(x,y) -> 
            fmap ( (, reflectIn (x -.- y) (p2 -.- p1)) 
                 . (+.+ errorNormalizeV 39 (vNormal (x -.- y)))
                 ) 
                 (intersectSegSeg p1 p2 x y)
         ) 
        . _wlLine)
---- | Looks for first collision of a point with walls.
---- If found, gives point and reflection velocity, reflection damped in normal.
--reflectPointWallsDamped 
--    :: Float    -- ^ Damping factor, probably should be in (0,1)
--    -> Point2 
--    -> Point2 
--    -> IM.IntMap Wall 
--    -> Maybe (Point2,Point2)
--reflectPointWallsDamped dfact p1 p2 ws 
--    = safeMinimumOn (dist p1 . fst)
--    $ IM.mapMaybe 
--        (( \(x,y) -> fmap ((, reflectInParam dfact (x -.- y) (p2 -.- p1)) 
--                            . (+.+ errorNormalizeV 40 (vNormal (x -.- y)))) 
--                                (intersectSegSeg p1 p2 x y)) 
--         . _wlLine
--        ) ws
-- | Test if a point collides with walls
pointHitsWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
pointHitsWalls p1 p2 
    = any $ isJust . uncurry (intersectSegSeg p1 p2) . _wlLine
-- | Test if there something blocking a walk
collidePointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
collidePointWalkable p1 p2 ws 
    = any (isJust . uncurry (intersectSegSeg p1 p2) . _wlLine) 
    $ IM.filter (not . fromMaybe True . (^? wlPathable)) ws

--furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
--furthestPointWalkable p1 p2 ws 
--    = fromMaybe p2
--    . safeMinimumOn (dist p1) 
--    $ IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) ws

--collideDirectionIndirect 
--    :: Float    -- ^max distance to look
--    -> Point2   -- ^start point
--    -> Point2   -- ^point in direction
--    -> IM.IntMap Wall 
--    -> Float
--{-# INLINE collideDirectionIndirect #-}
--collideDirectionIndirect d p1 p2 wls
--    = fromMaybe d
--    $
--    ( L.fold
--    . L.prefilter wlIsOpaque
--    . L.premapMaybe (fmap (dist p1) . uncurry (intersectSegSeg p1 p3) . _wlLine)
--    ) L.minimum 
--    wls
--  where
--    p3 = p1 +.+ d *.* safeNormalizeV (p2 -.- p1)

wlIsOpaque :: Wall -> Bool
wlIsOpaque wl = case _wlOpacity wl of
    Opaque -> True
    _ -> False

wlIsSeeThrough :: Wall -> Bool
wlIsSeeThrough wl = case _wlOpacity wl of
    SeeThrough -> True
    _ -> False

--collidePointUpToIndirect
--    :: Point2   -- ^start point
--    -> Point2   -- ^end point
--    -> IM.IntMap Wall 
--    -> Point2
--{-# INLINE collidePointUpToIndirect #-}
--collidePointUpToIndirect p1 p2 = foldr f p2 . IM.filter wlIsOpaque
--  where
--    f wl x = fromMaybe x . uncurry (intersectSegSeg p1 x) $ _wlLine wl

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

--collidePointIndirect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
--{-# INLINE collidePointIndirect #-}
--collidePointIndirect p1 p2 = test . foldr f p2 . IM.filter wlIsOpaque
--  where
--    f wl p = fromMaybe p $ uncurry (intersectSegSeg p1 p) $ _wlLine wl
--    test p | p == p2 = Nothing
--           | otherwise = Just p

collidePointIndirect' :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
{-# INLINE collidePointIndirect' #-}
collidePointIndirect'  p1 p2
    = L.fold
    . L.prefilter wlIsOpaque
    . L.premapMaybe (uncurry (intersectSegSeg p1 p2) . _wlLine)
    $ L.minimumOn (dist p1)

--{- | Checks to see whether someone can fire bullets effectively between two points. 
-- - Not sure if this needs vision as well, need to make this uniform. -}
--collidePointFire :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
--collidePointFire p1 p2 ws 
--    = safeMinimumOn (dist p1) 
--    . IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine ) 
--    $ IM.filter (\wl -> not (_wlFireThrough wl) || wlIsOpaque wl) ws
--{- | Checks to see whether someone can fire bullets effectively between two points. 
-- - Not sure if this needs vision as well, need to make this uniform. -}
--collidePointFireVision :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
--collidePointFireVision p1 p2 ws 
--    = any ( isJust . uncurry (intersectSegSeg p1 p2) . _wlLine) 
--    $ IM.filter theTest ws
--  where 
--    theTest wl = not (_wlFireThrough wl) || wlIsOpaque wl

-- the reason for using the dashed version is the hope that this will short
-- circuit
hasLOSIndirect :: Point2 -> Point2 -> World -> Bool
hasLOSIndirect p1 p2 w = case collidePointIndirect' p1 p2 $ wallsAlongLine p1 p2 w of 
    Just _ -> False
    Nothing -> True

isWalkable :: Point2 -> Point2 -> World -> Bool
isWalkable p1 p2 w = not 
    $ collidePointWalkable p1 p2 
    $ _walls w
--    $ wallsAlongLine p1 p2 w

canSee :: Int -> Int -> World -> Bool
canSee i j w = hasLOS p1 p2 w
  where 
    p1 = _crPos (_creatures w IM.! i)
    p2 = _crPos (_creatures w IM.! j)

--canSeePoint :: Int -> Point2 -> World -> Bool
--canSeePoint i p w = hasLOS p1 p w
--  where
--    p1 = _crPos (_creatures w IM.! i)

--pathToPointFireable :: Int -> Point2 -> World -> Bool
--pathToPointFireable i p w 
--    = not 
--    . pointHitsWalls (_crPos $ _creatures w IM.! i) p
--    $ IM.filter (not . _wlFireThrough ) $ wallsAlongLine p1 p w
--  where 
--    p1 = _crPos (_creatures w IM.! i)

--canSeePointAll :: Int -> Point2 -> World -> Bool
--canSeePointAll i targPos w 
--    = all (flip (canSeePoint i) w . (\p -> targPos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
--  where 
--    cr = _creatures w IM.! i
--    radius = _crRad cr

--canSeeAny :: Int -> Int -> World -> Bool
--canSeeAny fromID toID w 
--    = any (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
--  where 
--    cr = _creatures w IM.! toID
--    cpos = _crPos cr
--    radius = _crRad cr

--canSeeAll :: Int -> Int -> World -> Bool
--canSeeAll fromID toID w 
--    = all (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
--  where 
--    cr = _creatures w IM.! toID
--    cpos = _crPos cr
--    radius = _crRad cr

--canWalk :: Int -> Int -> World -> Bool
--canWalk i j w = not $ collidePointWalkable ipos jpos $ wallsAlongLine ipos jpos w
--  where 
--    ipos = _crPos (_creatures w IM.! i)
--    jpos = _crPos (_creatures w IM.! j)

canSeeIndirect :: Int -> Int -> World -> Bool
canSeeIndirect i j w = not 
    $ any (isJust . uncurry (intersectSegSeg ipos jpos) . _wlLine) 
    $ IM.filter wlIsOpaque 
    $ wallsAlongLine ipos jpos w
  where 
    ipos = _crPos (_creatures w IM.! i)
    jpos = _crPos (_creatures w IM.! j)
    
--canSeeFire :: Point2 -> Point2 -> World -> Bool
--canSeeFire p p' w = not $ collidePointFireVision p p' $ wallsAlongLine p p' w

--canSeeFireVision :: Int -> Int -> World -> Bool
--canSeeFireVision i j w = canSeeFire ipos jpos w
--  where 
--    ipos = _crPos (_creatures w IM.! i)
--    jpos = _crPos (_creatures w IM.! j)
--{- | Test whether both of the outside lines between two creatures are blocked -}
--canSeeFireVisionAny :: Int -> Int -> World -> Bool
--canSeeFireVisionAny i j w 
--    = not 
--    $ collidePointFireVision (ipos +.+ ni) (jpos +.+ nj) 
--        (wallsAlongLine (ipos +.+ ni) (jpos +.+ nj) w)
--    && collidePointFireVision (ipos -.- ni) (jpos -.- nj) 
--        (wallsAlongLine (ipos -.- ni) (jpos -.- nj) w)
--  where
--    icr = _creatures w IM.! i
--    jcr = _creatures w IM.! j
--    ipos = _crPos icr
--    jpos = _crPos jcr
--    n = normalizeV $ vNormal $ ipos -.- jpos
--    ni = _crRad icr *.* n
--    nj = _crRad jcr *.* n
--{- | Test whether either of the outside lines between two creatures are blocked -}
--canSeeFireVisionAll :: Int -> Int -> World -> Bool
--canSeeFireVisionAll i j w 
--    = not 
--    $ collidePointFireVision (ipos +.+ ni) (jpos +.+ nj) 
--        (wallsAlongLine (ipos +.+ ni) (jpos +.+ nj) w)
--    || collidePointFireVision (ipos -.- ni) (jpos -.- nj) 
--        (wallsAlongLine (ipos -.- ni) (jpos -.- nj) w)
--  where
--    icr = _creatures w IM.! i
--    jcr = _creatures w IM.! j
--    ipos = _crPos icr
--    jpos = _crPos jcr
--    n = normalizeV $ vNormal $ ipos -.- jpos
--    ni = _crRad icr *.* n
--    nj = _crRad jcr *.* n

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 f
  where 
    f wl = uncurry circOnSeg (_wlLine wl) p r

--wallNormal :: Wall -> Point2
--wallNormal = normalizeV . vNormal . uncurry (-.-) . _wlLine
-- | Looks for overlap of a circle with walls.
-- If found, gives wall
overlapCircWallsReturnWall :: Point2 -> Float -> IM.IntMap Wall -> Maybe Wall
overlapCircWallsReturnWall p rad
    = L.fold (safeMinimumOnMaybeL (fmap (dist p) . f . _wlLine))
  where 
    f (a,b) = intersectSegSeg p (p -.- rad *.* vNormal (normalizeV (a -.- b))) a b

-- | 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
collidePointAnyWallsReflect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
collidePointAnyWallsReflect p1 p2 
    = getFirst
    . foldMap (First . findPoint . _wlLine)
  where 
    findPoint (x,y) = case intersectSegSeg p1 p2 x y of
        Just ip -> Just (ip +.+ normalizeV (vNormal (x -.- y)), reflectInParam 0.5 (x -.- y) (p2 -.- p1))
        Nothing -> Nothing

-- | Looks for collision of a point with walls.
-- If found, gives collision point
-- If not found, returns point
collidePointWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
collidePointWalls p1 p2 = foldr findPoint p2 . fmap _wlLine
  where
    findPoint (x,y) p = fromMaybe p $ intersectSegSeg p1 p x y
collidePointWalls' :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
collidePointWalls' p1 p2 = foldl' findPoint p2 . fmap _wlLine
  where
    findPoint p = fromMaybe p . uncurry (intersectSegSeg p1 p)

-- | Looks for first collision of a circle with walls.
-- If found, gives point and reflection velocity, reflection damped in normal.
-- note that the "intersection" point is the center of the circle flush against the wall
collideCircWalls' :: Point2 -> Point2 -> Float -> IM.IntMap Wall -> Maybe (Point2,Point2)
collideCircWalls' p1 p2 rad = either (const Nothing) Just . foldr findPoint (Left p2)
  where 
    findPoint wl eip = maybe eip Right $ doReflection (getp eip) $ shiftByRad $ _wlLine wl
    getp (Left p) = p
    getp (Right (p,_)) = p
    doReflection p (x,y) = case intersectSegSeg p1 p x y of
        Nothing -> Nothing
        Just ip -> Just (ip +.+ normalizeV (vNormal (x -.- y)), reflectInParam 0.5 (x -.- y) (p2 -.- p1))
    shiftByRad (a,b) =
        (g $ a +.+ rad *.* normalizeV (a -.-b)
        ,g $ b +.+ rad *.* normalizeV (b -.-a)
        )
      where
        g = ((rad *.* normalizeV (vNormal $ a -.- b)) +.+)

-- | Looks for first collision of a circle with walls.
-- 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
    = safeMinimumOn (dist p1 . fst) 
    . IM.mapMaybe 
        (( \(x:y:_) -> fmap 
            ((, reflectInParam 0.5 (x -.- y) (p2 -.- p1)) 
            . (+.+ normalizeV (vNormal (x -.- y)))
            ) 
            (intersectSegSeg p1 p2 x y)
         ) 
         . shiftByRad . _wlLine
        )
  where 
    shiftByRad (a,b) = map ((rad *.* normalizeV (vNormal $ a -.- b)) +.+)
        [a +.+ rad *.* normalizeV (a -.-b)
        ,b +.+ rad *.* normalizeV (b -.-a)
        ]
-- this shifts the wall out, and for outer corners extends the wall
-- not sure what this does for inner corners, hopefully won't cause a problem
-- the alternative would be to separately bounce off corner points...
-- unfortunately, doesn't allow for collisions when the circle spawns on the
-- wall

-- | Looks for first collision of a point with a list of lines.
-- If found, gives point and normal of wall.
--collidePointLines :: Point2 -> Point2 -> [Wall'] -> Maybe (Point2,Point2)
--collidePointLines p1 p2 ws 
--    = safeMinimumOn f
--    $ mapMaybe (( \(x,y) -> intersectSegSeg p1 p2 x y <&> ( , vNormal $ x -.- y ) ) 
--        . _wlLine') ws
--  where 
--    f (a,_) = magV (p1 -.- a)
--

-- | Looks for first collision of a point with walls.
-- If found, gives point and normal of wall.
collidePointWallsNorm :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
collidePointWallsNorm p1 p2 ws 
    = safeMinimumOn (dist p1 . fst)
    $ IM.mapMaybe (( \(x,y) -> intersectSegSeg p1 p2 x y <&> ( , vNormal $ x -.- y ) ) 
        . _wlLine) ws
-- | Returns the first creature, if any, that a point intersects with.
collidePointCreatures :: Point2 -> Point2 -> IM.IntMap Creature -> Maybe Int
collidePointCreatures p1 p2 = fmap fst 
    . safeMinimumOn snd
    . IM.toList 
    . IM.mapMaybe (\x -> dist p1 <$> intersectCircSegFirst (_crPos x) (_crRad x) p1 p2) 
-- | As for 'collidePointCreatures', only increases the radius of creatures by a
--fixed amount, thus collides a moving circle with creaures.
collideCircCreatures :: Point2 -> Point2 -> Float -> IM.IntMap Creature -> Maybe Int
collideCircCreatures p1 p2 rad = collidePointCreatures p1 p2 . fmap (crRad +~ rad)

-- | Returns the first creature id, if any, that a point intersects with, gives point
--in creature on line.
collidePointCrsPoint :: Point2 -> Point2 -> IM.IntMap Creature -> Maybe (Point2,Int)
collidePointCrsPoint p1 p2 = fmap f 
    . safeMinimumOn (dist p1 . snd)
    . IM.toList 
    . IM.mapMaybe (\x -> intersectCircSegFirst (_crPos x) (_crRad x) p1 p2) 
  where 
    f (cID,p) = (p,cID)
{- | Finds the first creature hit on a line.
Maybe evaluates the creature id and hit point. -}
collideCircCrsPoint :: Point2 -> Point2 -> Float -> IM.IntMap Creature -> Maybe (Point2,Int)
collideCircCrsPoint p1 p2 rad = collidePointCrsPoint p1 p2 . fmap (crRad +~ rad)

---- | Makes a creature not hittable.
--collidePointCrsWithoutPoint :: Int -> Point2 -> Point2 -> World -> Maybe (Point2,Int)
--collidePointCrsWithoutPoint cid p1 p2 w 
--    = fmap f 
--    . safeMinimumOn (snd . snd)
--    . IM.toList 
--    . IM.mapMaybe (\x -> collidePointCirc'' p1 p2 (_crRad x) (_crPos x)) 
--    . IM.delete cid 
--    $ _creatures w
--  where 
--    f (cID,(p,_)) = (p,cID)
{- | Test if a circle collides with any wall. 
 - Note no check on whether the wall is walkable. -}
circOnSomeWall :: Point2 -> Float -> World -> Bool
circOnSomeWall p rad
    = any (\(x,y) -> circOnSeg x y p rad) 
    . fmap _wlLine 
    . IM.elems 
    . wallsNearPoint p
{- | Adds the distance to the creature radius, tests whether the center is in
the circle of this size centered at the point -}
crsNearPoint :: Float -> Point2 -> World -> Bool
crsNearPoint d p = any (\c -> dist (_crPos c) p < (d + _crRad c)) . _creatures
{- | Produce an unordered list of creatures on a line. -}
crsOnLine :: Point2 -> Point2 -> World -> IM.IntMap Creature
crsOnLine p1 p2
    = IM.filter (\cr -> circOnSeg p1 p2 (_crPos cr) (_crRad cr))
    . _creatures
{- | Produce an unordered list of creatures on a wide line. -}
crsOnThickLine :: Float -> Point2 -> Point2 -> World -> IM.IntMap Creature
crsOnThickLine thickness p1 p2
    = IM.filter (\cr -> circOnSeg p1 p2 (_crPos cr) (_crRad cr + thickness))
    . _creatures
{- | Find 'Maybe' the closest creature to a point, within a circle.
 -}
nearestCrInRad :: Point2 -> Float -> World -> Maybe Creature
nearestCrInRad p r
    = safeMinimumOn (dist p . _crPos)
    . IM.filter (\cr -> dist p (_crPos cr) < r) 
    . _creatures
{- | 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
    = safeMinimumOn (dist p . _crPos)
    . IM.filter (\cr -> pointInPolygon (_crPos cr) tri) 
    . _creatures
 where 
    tri = 
        [p 
        ,p +.+ rotateV (dir-pi/4) (V2 x 0)
        ,p +.+ rotateV (dir+pi/4) (V2 x 0)
        ]
{- | Find 'Maybe' the closes creature in front of a point in a given direction for
a given distance.
The shapes within which creatures are searched are a triangle then rectangle.  -}
nearestCrInFront 
    :: Point2
    -> Float    -- ^ Direction (radians +ve anticlockwise from x-axis).
    -> Float    -- ^ Distance.
    -> World -> Maybe Creature
nearestCrInFront p dir x
    = safeMinimumOn (dist p . _crPos)
    . IM.filter (\cr -> pointInPolygon (_crPos cr) rec)
    . _creatures
  where 
    rec = [p, pR, pR1, pL1, pL ]
    pR  = p +.+ rotateV (dir - pi*(3/8)) (V2 (x/2) 0)
    pL  = p +.+ rotateV (dir + pi*(3/8)) (V2 (x/2) 0)
    pR1 = pR +.+ rotateV dir (V2 (x/2) 0)
    pL1 = pL +.+ rotateV dir (V2 (x/2) 0)