    {-# LANGUAGE DeriveGeneric #-}
    -- | Basic operations on bounded 2D vectors, with an efficient, but not 1-1
    -- and not monotonic @Enum@ instance.
    module Game.LambdaHack.Common.Vector
      ( Vector(..), VectorI
      , isUnit, neg, chessDistVector, euclidDistSqVector
      , moves, movesCardinal, movesCardinalI, movesDiagonal, movesDiagonalI
      , compassText, vicinityBounded, vicinityUnsafe
      , vicinityCardinal, vicinityCardinalUnsafe, squareUnsafeSet
      , shift, shiftBounded, trajectoryToPath, trajectoryToPathBounded
      , vectorToFrom, computeTrajectory
      , RadianAngle, rotate, towards
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , longMoveTexts, movesSquare, pathToTrajectory
      , normalize, normalizeVector
    #endif
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import           Control.DeepSeq
    import           Data.Binary
    import qualified Data.EnumMap.Strict as EM
    import qualified Data.EnumSet as ES
    import           Data.Int (Int32)
    import qualified Data.IntSet as IS
    import qualified Data.Primitive.PrimArray as PA
    import           GHC.Generics (Generic)

    import Game.LambdaHack.Common.Point
    import Game.LambdaHack.Common.Time
    import Game.LambdaHack.Definition.Defs

    -- | 2D vectors in cartesian representation. Coordinates grow to the right
    -- and down, so that the (1, 1) vector points to the bottom-right corner
    -- of the screen.
    data Vector = Vector
      { Vector -> X
    vx :: X
      , Vector -> X
    vy :: Y
      }
      deriving (X -> Vector -> ShowS
    [Vector] -> ShowS
    Vector -> String
    (X -> Vector -> ShowS)
    -> (Vector -> String) -> ([Vector] -> ShowS) -> Show Vector
    forall a.
    (X -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: X -> Vector -> ShowS
    showsPrec :: X -> Vector -> ShowS
    $cshow :: Vector -> String
    show :: Vector -> String
    $cshowList :: [Vector] -> ShowS
    showList :: [Vector] -> ShowS
    Show, ReadPrec [Vector]
    ReadPrec Vector
    X -> ReadS Vector
    ReadS [Vector]
    (X -> ReadS Vector)
    -> ReadS [Vector]
    -> ReadPrec Vector
    -> ReadPrec [Vector]
    -> Read Vector
    forall a.
    (X -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: X -> ReadS Vector
    readsPrec :: X -> ReadS Vector
    $creadList :: ReadS [Vector]
    readList :: ReadS [Vector]
    $creadPrec :: ReadPrec Vector
    readPrec :: ReadPrec Vector
    $creadListPrec :: ReadPrec [Vector]
    readListPrec :: ReadPrec [Vector]
    Read, Vector -> Vector -> Bool
    (Vector -> Vector -> Bool)
    -> (Vector -> Vector -> Bool) -> Eq Vector
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Vector -> Vector -> Bool
    == :: Vector -> Vector -> Bool
    $c/= :: Vector -> Vector -> Bool
    /= :: Vector -> Vector -> Bool
    Eq, Eq Vector
    Eq Vector =>
    (Vector -> Vector -> Ordering)
    -> (Vector -> Vector -> Bool)
    -> (Vector -> Vector -> Bool)
    -> (Vector -> Vector -> Bool)
    -> (Vector -> Vector -> Bool)
    -> (Vector -> Vector -> Vector)
    -> (Vector -> Vector -> Vector)
    -> Ord Vector
    Vector -> Vector -> Bool
    Vector -> Vector -> Ordering
    Vector -> Vector -> Vector
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Vector -> Vector -> Ordering
    compare :: Vector -> Vector -> Ordering
    $c< :: Vector -> Vector -> Bool
    < :: Vector -> Vector -> Bool
    $c<= :: Vector -> Vector -> Bool
    <= :: Vector -> Vector -> Bool
    $c> :: Vector -> Vector -> Bool
    > :: Vector -> Vector -> Bool
    $c>= :: Vector -> Vector -> Bool
    >= :: Vector -> Vector -> Bool
    $cmax :: Vector -> Vector -> Vector
    max :: Vector -> Vector -> Vector
    $cmin :: Vector -> Vector -> Vector
    min :: Vector -> Vector -> Vector
    Ord, (forall x. Vector -> Rep Vector x)
    -> (forall x. Rep Vector x -> Vector) -> Generic Vector
    forall x. Rep Vector x -> Vector
    forall x. Vector -> Rep Vector x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. Vector -> Rep Vector x
    from :: forall x. Vector -> Rep Vector x
    $cto :: forall x. Rep Vector x -> Vector
    to :: forall x. Rep Vector x -> Vector
    Generic)

    instance Binary Vector where
      put :: Vector -> Put
    put = Int32 -> Put
    forall t. Binary t => t -> Put
    put (Int32 -> Put) -> (Vector -> Int32) -> Vector -> Put
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (X -> Int32
    forall a b. (Integral a, Integral b, Bits a, Bits b) => a -> b
    toIntegralCrash :: Int -> Int32) (X -> Int32) -> (Vector -> X) -> Vector -> Int32
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vector -> X
    forall a. Enum a => a -> X
    fromEnum
      get :: Get Vector
    get = (Int32 -> Vector) -> Get Int32 -> Get Vector
    forall a b. (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (X -> Vector
    forall a. Enum a => X -> a
    toEnum (X -> Vector) -> (Int32 -> X) -> Int32 -> Vector
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int32 -> X
    forall a b. (Integral a, Num b) => a -> b
    fromIntegralWrap :: Int32 -> Int)) Get Int32
    forall t. Binary t => Get t
    get
        -- `fromIntegralWrap` is fine here, because we converted the integer
        -- in the opposite direction first, so it fits even in 31 bit `Int`

    -- Note that the conversion is not monotonic wrt the natural @Ord@ instance,
    -- to keep it in sync with Point.
    instance Enum Vector where
      fromEnum :: Vector -> X
    fromEnum Vector{X
    vx :: Vector -> X
    vy :: Vector -> X
    vx :: X
    vy :: X
    ..} =
        let !xsize :: X
    xsize = PrimArray X -> X -> X
    forall a. Prim a => PrimArray a -> X -> a
    PA.indexPrimArray PrimArray X
    speedupHackXSize X
    0
        in X
    vx X -> X -> X
    forall a. Num a => a -> a -> a
    + X
    vy X -> X -> X
    forall a. Num a => a -> a -> a
    * X
    xsize
      toEnum :: X -> Vector
    toEnum X
    n =
        let !xsize :: X
    xsize = PrimArray X -> X -> X
    forall a. Prim a => PrimArray a -> X -> a
    PA.indexPrimArray PrimArray X
    speedupHackXSize X
    0
            !xsizeHalf :: X
    xsizeHalf = X
    xsize X -> X -> X
    forall a. Integral a => a -> a -> a
    `div` X
    2
            (!X
    y, !X
    x) = X
    n X -> X -> (X, X)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` X
    xsize
            (!X
    vx, !X
    vy) | X
    x X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    >= X
    xsizeHalf = (X
    x X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    xsize, X
    y X -> X -> X
    forall a. Num a => a -> a -> a
    + X
    1)
                       | X
    x X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    <= - X
    xsizeHalf = (X
    x X -> X -> X
    forall a. Num a => a -> a -> a
    + X
    xsize, X
    y X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    1)
                       | Bool
    otherwise = (X
    x, X
    y)
        in Vector{X
    vx :: X
    vy :: X
    vx :: X
    vy :: X
    ..}

    instance NFData Vector

    -- | Enumeration representation of @Vector@.
    type VectorI = Int

    -- | Tells if a vector has length 1 in the chessboard metric.
    isUnit :: Vector -> Bool
    {-# INLINE isUnit #-}
    isUnit :: Vector -> Bool
    isUnit Vector
    v = Vector -> X
    chessDistVector Vector
    v X -> X -> Bool
    forall a. Eq a => a -> a -> Bool
    == X
    1

    -- | Reverse an arbirary vector.
    neg :: Vector -> Vector
    {-# INLINE neg #-}
    neg :: Vector -> Vector
    neg (Vector X
    vx X
    vy) = X -> X -> Vector
    Vector (-X
    vx) (-X
    vy)

    -- | The lenght of a vector in the chessboard metric,
    -- where diagonal moves cost 1.
    chessDistVector :: Vector -> Int
    {-# INLINE chessDistVector #-}
    chessDistVector :: Vector -> X
    chessDistVector (Vector X
    x X
    y) = X -> X -> X
    forall a. Ord a => a -> a -> a
    max (X -> X
    forall a. Num a => a -> a
    abs X
    x) (X -> X
    forall a. Num a => a -> a
    abs X
    y)

    -- | Squared euclidean distance between two vectors.
    euclidDistSqVector :: Vector -> Vector -> Int
    euclidDistSqVector :: Vector -> Vector -> X
    euclidDistSqVector (Vector X
    x0 X
    y0) (Vector X
    x1 X
    y1) =
      (X
    x1 X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    x0) X -> X -> X
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ (X
    2 :: Int) X -> X -> X
    forall a. Num a => a -> a -> a
    + (X
    y1 X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    y0) X -> X -> X
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ (X
    2 :: Int)

    -- | Vectors of all unit moves in the chessboard metric,
    -- clockwise, starting north-west.
    moves :: [Vector]
    moves :: [Vector]
    moves =
      ((X, X) -> Vector) -> [(X, X)] -> [Vector]
    forall a b. (a -> b) -> [a] -> [b]
    map ((X -> X -> Vector) -> (X, X) -> Vector
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry X -> X -> Vector
    Vector)
        [(-X
    1, -X
    1), (X
    0, -X
    1), (X
    1, -X
    1), (X
    1, X
    0), (X
    1, X
    1), (X
    0, X
    1), (-X
    1, X
    1), (-X
    1, X
    0)]

    -- | Vectors of all cardinal direction unit moves, clockwise, starting north.
    movesCardinal :: [Vector]
    movesCardinal :: [Vector]
    movesCardinal = ((X, X) -> Vector) -> [(X, X)] -> [Vector]
    forall a b. (a -> b) -> [a] -> [b]
    map ((X -> X -> Vector) -> (X, X) -> Vector
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry X -> X -> Vector
    Vector) [(X
    0, -X
    1), (X
    1, X
    0), (X
    0, X
    1), (-X
    1, X
    0)]

    movesCardinalI :: [VectorI]
    movesCardinalI :: [X]
    movesCardinalI = (Vector -> X) -> [Vector] -> [X]
    forall a b. (a -> b) -> [a] -> [b]
    map Vector -> X
    forall a. Enum a => a -> X
    fromEnum [Vector]
    movesCardinal

    -- | Vectors of all diagonal direction unit moves, clockwise, starting north.
    movesDiagonal :: [Vector]
    movesDiagonal :: [Vector]
    movesDiagonal = ((X, X) -> Vector) -> [(X, X)] -> [Vector]
    forall a b. (a -> b) -> [a] -> [b]
    map ((X -> X -> Vector) -> (X, X) -> Vector
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry X -> X -> Vector
    Vector) [(-X
    1, -X
    1), (X
    1, -X
    1), (X
    1, X
    1), (-X
    1, X
    1)]

    movesDiagonalI :: [VectorI]
    movesDiagonalI :: [X]
    movesDiagonalI = (Vector -> X) -> [Vector] -> [X]
    forall a b. (a -> b) -> [a] -> [b]
    map Vector -> X
    forall a. Enum a => a -> X
    fromEnum [Vector]
    movesDiagonal

    -- moveTexts :: [Text]
    -- moveTexts = ["NW", "N", "NE", "E", "SE", "S", "SW", "W"]

    longMoveTexts :: [Text]
    longMoveTexts :: [Text]
    longMoveTexts = [ Text
    "northwest", Text
    "north", Text
    "northeast", Text
    "east"
                    , Text
    "southeast", Text
    "south", Text
    "southwest", Text
    "west" ]

    compassText :: Vector -> Text
    compassText :: Vector -> Text
    compassText Vector
    v = let m :: EnumMap Vector Text
    m = [(Vector, Text)] -> EnumMap Vector Text
    forall k a. Enum k => [(k, a)] -> EnumMap k a
    EM.fromList ([(Vector, Text)] -> EnumMap Vector Text)
    -> [(Vector, Text)] -> EnumMap Vector Text
    forall a b. (a -> b) -> a -> b
    $ [Vector] -> [Text] -> [(Vector, Text)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Vector]
    moves [Text]
    longMoveTexts
                        assFail :: Text
    assFail = String -> Text
    forall a. HasCallStack => String -> a
    error (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ String
    "not a unit vector" String -> Vector -> String
    forall v. Show v => String -> v -> String
    `showFailure` Vector
    v
                    in Text -> Vector -> EnumMap Vector Text -> Text
    forall k a. Enum k => a -> k -> EnumMap k a -> a
    EM.findWithDefault Text
    assFail Vector
    v EnumMap Vector Text
    m

    -- | All (8 at most) closest neighbours of a point within an area.
    vicinityBounded :: X -> Y   -- ^ limit the search to this area
                    -> Point    -- ^ position to find neighbours of
                    -> [Point]
    vicinityBounded :: X -> X -> Point -> [Point]
    vicinityBounded X
    rWidthMax X
    rHeightMax Point
    p =
      if (X, X, X, X) -> Point -> Bool
    insideP (X
    1, X
    1, X
    rWidthMax X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    2, X
    rHeightMax X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    2) Point
    p
      then Point -> [Point]
    vicinityUnsafe Point
    p
      else [ Point
    res | Vector
    dxy <- [Vector]
    moves
                 , let res :: Point
    res = Point -> Vector -> Point
    shift Point
    p Vector
    dxy
                 , (X, X, X, X) -> Point -> Bool
    insideP (X
    0, X
    0, X
    rWidthMax X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    1, X
    rHeightMax X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    1) Point
    res ]

    vicinityUnsafe :: Point -> [Point]
    {-# INLINE vicinityUnsafe #-}
    vicinityUnsafe :: Point -> [Point]
    vicinityUnsafe Point
    p = [ Point -> Vector -> Point
    shift Point
    p Vector
    dxy | Vector
    dxy <- [Vector]
    moves ]

    -- | All (4 at most) cardinal direction neighbours of a point within an area.
    vicinityCardinal :: X -> Y   -- ^ limit the search to this area
                     -> Point    -- ^ position to find neighbours of
                     -> [Point]
    vicinityCardinal :: X -> X -> Point -> [Point]
    vicinityCardinal X
    rWidthMax X
    rHeightMax Point
    p =
      [ Point
    res | Vector
    dxy <- [Vector]
    movesCardinal
            , let res :: Point
    res = Point -> Vector -> Point
    shift Point
    p Vector
    dxy
            , (X, X, X, X) -> Point -> Bool
    insideP (X
    0, X
    0, X
    rWidthMax X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    1, X
    rHeightMax X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    1) Point
    res ]

    vicinityCardinalUnsafe :: Point -> [Point]
    vicinityCardinalUnsafe :: Point -> [Point]
    vicinityCardinalUnsafe Point
    p = [ Point -> Vector -> Point
    shift Point
    p Vector
    dxy | Vector
    dxy <- [Vector]
    movesCardinal ]

    -- Ascending list; includes the origin.
    movesSquare :: [VectorI]
    movesSquare :: [X]
    movesSquare = ((X, X) -> X) -> [(X, X)] -> [X]
    forall a b. (a -> b) -> [a] -> [b]
    map (Vector -> X
    forall a. Enum a => a -> X
    fromEnum (Vector -> X) -> ((X, X) -> Vector) -> (X, X) -> X
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (X -> X -> Vector) -> (X, X) -> Vector
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry X -> X -> Vector
    Vector)
                      [ (-X
    1, -X
    1), (X
    0, -X
    1), (X
    1, -X
    1)
                      , (-X
    1, X
    0), (X
    0, X
    0), (X
    1, X
    0)
                      , (-X
    1, X
    1), (X
    0, X
    1), (X
    1, X
    1) ]

    squareUnsafeSet :: Point -> ES.EnumSet Point
    {-# INLINE squareUnsafeSet #-}
    squareUnsafeSet :: Point -> EnumSet Point
    squareUnsafeSet Point
    p =
      IntSet -> EnumSet Point
    forall k. IntSet -> EnumSet k
    ES.intSetToEnumSet (IntSet -> EnumSet Point) -> IntSet -> EnumSet Point
    forall a b. (a -> b) -> a -> b
    $ [X] -> IntSet
    IS.fromDistinctAscList ([X] -> IntSet) -> [X] -> IntSet
    forall a b. (a -> b) -> a -> b
    $ (X -> X) -> [X] -> [X]
    forall a b. (a -> b) -> [a] -> [b]
    map (Point -> X
    forall a. Enum a => a -> X
    fromEnum Point
    p X -> X -> X
    forall a. Num a => a -> a -> a
    +) [X]
    movesSquare

    -- | Translate a point by a vector.
    shift :: Point -> Vector -> Point
    {-# INLINE shift #-}
    shift :: Point -> Vector -> Point
    shift (Point X
    x0 X
    y0) (Vector X
    x1 X
    y1) = X -> X -> Point
    Point (X
    x0 X -> X -> X
    forall a. Num a => a -> a -> a
    + X
    x1) (X
    y0 X -> X -> X
    forall a. Num a => a -> a -> a
    + X
    y1)

    -- | Translate a point by a vector, but only if the result fits in an area.
    shiftBounded :: X -> Y -> Point -> Vector -> Point
    shiftBounded :: X -> X -> Point -> Vector -> Point
    shiftBounded X
    rWidthMax X
    rHeightMax Point
    pos v :: Vector
    v@(Vector X
    xv X
    yv) =
      if (X, X, X, X) -> Point -> Bool
    insideP (-X
    xv, -X
    yv, X
    rWidthMax X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    xv X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    1, X
    rHeightMax X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    yv X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    1) Point
    pos
      then Point -> Vector -> Point
    shift Point
    pos Vector
    v
      else Point
    pos

    -- | A list of points that a list of vectors leads to.
    trajectoryToPath :: Point -> [Vector] -> [Point]
    trajectoryToPath :: Point -> [Vector] -> [Point]
    trajectoryToPath Point
    _ [] = []
    trajectoryToPath Point
    start (Vector
    v : [Vector]
    vs) = let next :: Point
    next = Point -> Vector -> Point
    shift Point
    start Vector
    v
                                      in Point
    next Point -> [Point] -> [Point]
    forall a. a -> [a] -> [a]
    : Point -> [Vector] -> [Point]
    trajectoryToPath Point
    next [Vector]
    vs

    -- | A list of points that a list of vectors leads to, bounded by level size.
    trajectoryToPathBounded :: X -> Y -> Point -> [Vector] -> [Point]
    trajectoryToPathBounded :: X -> X -> Point -> [Vector] -> [Point]
    trajectoryToPathBounded X
    _ X
    _ Point
    _ [] = []
    trajectoryToPathBounded X
    rWidthMax X
    rHeightMax Point
    start (Vector
    v : [Vector]
    vs) =
      let next :: Point
    next = X -> X -> Point -> Vector -> Point
    shiftBounded X
    rWidthMax X
    rHeightMax Point
    start Vector
    v
      in Point
    next Point -> [Point] -> [Point]
    forall a. a -> [a] -> [a]
    : X -> X -> Point -> [Vector] -> [Point]
    trajectoryToPathBounded X
    rWidthMax X
    rHeightMax Point
    next [Vector]
    vs

    -- | The vector between the second point and the first. We have
    --
    -- > shift pos1 (pos2 `vectorToFrom` pos1) == pos2
    --
    -- The arguments are in the same order as in the underlying scalar subtraction.
    vectorToFrom :: Point -> Point -> Vector
    {-# INLINE vectorToFrom #-}
    vectorToFrom :: Point -> Point -> Vector
    vectorToFrom (Point X
    x0 X
    y0) (Point X
    x1 X
    y1) = X -> X -> Vector
    Vector (X
    x0 X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    x1) (X
    y0 X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    y1)

    -- | A list of vectors between a list of points.
    pathToTrajectory :: [Point] -> [Vector]
    pathToTrajectory :: [Point] -> [Vector]
    pathToTrajectory [] = []
    pathToTrajectory lp1 :: [Point]
    lp1@(Point
    _ : [Point]
    lp2) = (Point -> Point -> Vector) -> [Point] -> [Point] -> [Vector]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Point -> Point -> Vector
    vectorToFrom [Point]
    lp2 [Point]
    lp1

    computeTrajectory :: Int -> Int -> Int -> [Point] -> ([Vector], (Speed, Int))
    computeTrajectory :: X -> X -> X -> [Point] -> ([Vector], (Speed, X))
    computeTrajectory X
    weight X
    throwVelocity X
    throwLinger [Point]
    path =
      let speed :: Speed
    speed = X -> X -> Speed
    speedFromWeight X
    weight X
    throwVelocity
          trange :: X
    trange = Speed -> X -> X
    rangeFromSpeedAndLinger Speed
    speed X
    throwLinger
          btrajectory :: [Vector]
    btrajectory = [Point] -> [Vector]
    pathToTrajectory ([Point] -> [Vector]) -> [Point] -> [Vector]
    forall a b. (a -> b) -> a -> b
    $ X -> [Point] -> [Point]
    forall a. X -> [a] -> [a]
    take (X
    trange X -> X -> X
    forall a. Num a => a -> a -> a
    + X
    1) [Point]
    path
      in ([Vector]
    btrajectory, (Speed
    speed, X
    trange))

    type RadianAngle = Double

    -- | Rotate a vector by the given angle (expressed in radians)
    -- counterclockwise and return a unit vector approximately in the resulting
    -- direction.
    rotate :: RadianAngle -> Vector -> Vector
    rotate :: Double -> Vector -> Vector
    rotate Double
    angle (Vector X
    x' X
    y') =
      let x :: Double
    x = X -> Double
    intToDouble X
    x'
          y :: Double
    y = X -> Double
    intToDouble X
    y'
          -- Minus before the angle comes from our coordinates being
          -- mirrored along the X axis (Y coordinates grow going downwards).
          dx :: Double
    dx = Double
    x Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double -> Double
    forall a. Floating a => a -> a
    cos (-Double
    angle) Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - Double
    y Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double -> Double
    forall a. Floating a => a -> a
    sin (-Double
    angle)
          dy :: Double
    dy = Double
    x Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double -> Double
    forall a. Floating a => a -> a
    sin (-Double
    angle) Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + Double
    y Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double -> Double
    forall a. Floating a => a -> a
    cos (-Double
    angle)
      in Double -> Double -> Vector
    normalize Double
    dx Double
    dy

    -- | Given a vector of arbitrary non-zero length, produce a unit vector
    -- that points in the same direction (in the chessboard metric).
    -- Of several equally good directions it picks one of those that visually
    -- (in the euclidean metric) maximally align with the original vector.
    normalize :: Double -> Double -> Vector
    normalize :: Double -> Double -> Vector
    normalize Double
    dx Double
    dy =
      Bool -> Vector -> Vector
    forall a. HasCallStack => Bool -> a -> a
    assert (Double
    dx Double -> Double -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Double
    0 Bool -> Bool -> Bool
    || Double
    dy Double -> Double -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Double
    0 Bool -> (String, (Double, Double)) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` String
    "can't normalize zero" String -> (Double, Double) -> (String, (Double, Double))
    forall v. String -> v -> (String, v)
    `swith` (Double
    dx, Double
    dy)) (Vector -> Vector) -> Vector -> Vector
    forall a b. (a -> b) -> a -> b
    $
      let angle :: Double
          angle :: Double
    angle = Double -> Double
    forall a. Floating a => a -> a
    atan (Double
    dy Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    dx) Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / (Double
    forall a. Floating a => a
    pi Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    2)
          dxy :: (X, X)
    dxy | Double
    angle Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    <= -Double
    0.75 Bool -> Bool -> Bool
    && Double
    angle Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    >= -Double
    1.25 = (X
    0, -X
    1)
              | Double
    angle Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    <= -Double
    0.25 = (X
    1, -X
    1)
              | Double
    angle Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Double
    0.25  = (X
    1, X
    0)
              | Double
    angle Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Double
    0.75  = (X
    1, X
    1)
              | Double
    angle Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Double
    1.25  = (X
    0, X
    1)
              | Bool
    otherwise = String -> (X, X)
    forall a. HasCallStack => String -> a
    error (String -> (X, X)) -> String -> (X, X)
    forall a b. (a -> b) -> a -> b
    $ String
    "impossible angle" String -> (Double, Double, Double) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (Double
    dx, Double
    dy, Double
    angle)
      in if Double
    dx Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Double
    0
         then (X -> X -> Vector) -> (X, X) -> Vector
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry X -> X -> Vector
    Vector (X, X)
    dxy
         else Vector -> Vector
    neg (Vector -> Vector) -> Vector -> Vector
    forall a b. (a -> b) -> a -> b
    $ (X -> X -> Vector) -> (X, X) -> Vector
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry X -> X -> Vector
    Vector (X, X)
    dxy

    normalizeVector :: Vector -> Vector
    normalizeVector :: Vector -> Vector
    normalizeVector v :: Vector
    v@(Vector X
    vx X
    vy) =
      let res :: Vector
    res = Double -> Double -> Vector
    normalize (X -> Double
    intToDouble X
    vx) (X -> Double
    intToDouble X
    vy)
      in Bool -> Vector -> Vector
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not (Vector -> Bool
    isUnit Vector
    v) Bool -> Bool -> Bool
    || Vector
    v Vector -> Vector -> Bool
    forall a. Eq a => a -> a -> Bool
    == Vector
    res
                 Bool -> (String, (Vector, Vector)) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` String
    "unit vector gets untrivially normalized"
                 String -> (Vector, Vector) -> (String, (Vector, Vector))
    forall v. String -> v -> (String, v)
    `swith` (Vector
    v, Vector
    res))
         Vector
    res

    -- | Given two distinct positions, determine the direction (a unit vector)
    -- in which one should move from the first in order to get closer
    -- to the second. Ignores obstacles. Of several equally good directions
    -- (in the chessboard metric) it picks one of those that visually
    -- (in the euclidean metric) maximally align with the vector between
    -- the two points.
    towards :: Point -> Point -> Vector
    towards :: Point -> Point -> Vector
    towards Point
    pos0 Point
    pos1 =
      Bool -> Vector -> Vector
    forall a. HasCallStack => Bool -> a -> a
    assert (Point
    pos0 Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Point
    pos1 Bool -> (String, (Point, Point)) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` String
    "towards self" String -> (Point, Point) -> (String, (Point, Point))
    forall v. String -> v -> (String, v)
    `swith` (Point
    pos0, Point
    pos1))
      (Vector -> Vector) -> Vector -> Vector
    forall a b. (a -> b) -> a -> b
    $ Vector -> Vector
    normalizeVector (Vector -> Vector) -> Vector -> Vector
    forall a b. (a -> b) -> a -> b
    $ Point
    pos1 Point -> Point -> Vector
    `vectorToFrom` Point
    pos0