{-# 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
showList :: [Vector] -> ShowS
$cshowList :: [Vector] -> ShowS
show :: Vector -> String
$cshow :: Vector -> String
showsPrec :: X -> Vector -> ShowS
$cshowsPrec :: X -> 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
readListPrec :: ReadPrec [Vector]
$creadListPrec :: ReadPrec [Vector]
readPrec :: ReadPrec Vector
$creadPrec :: ReadPrec Vector
readList :: ReadS [Vector]
$creadList :: ReadS [Vector]
readsPrec :: X -> ReadS Vector
$creadsPrec :: X -> ReadS Vector
Read, Vector -> Vector -> Bool
(Vector -> Vector -> Bool)
-> (Vector -> Vector -> Bool) -> Eq Vector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vector -> Vector -> Bool
$c/= :: Vector -> Vector -> Bool
== :: Vector -> Vector -> Bool
$c== :: 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
min :: Vector -> Vector -> Vector
$cmin :: Vector -> Vector -> Vector
max :: Vector -> Vector -> Vector
$cmax :: Vector -> Vector -> Vector
>= :: Vector -> Vector -> Bool
$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
compare :: Vector -> Vector -> Ordering
$ccompare :: Vector -> Vector -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep Vector x -> Vector
$cfrom :: forall x. Vector -> Rep Vector x
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 (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, Integral b, IsIntSubType a b ~ 'True) =>
a -> b
intCast :: Int32 -> Int)) Get Int32
forall t. Binary t => Get t
get

-- 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{..} =
    let !xsize :: X
xsize = PrimArray X -> X -> X
forall a. Prim a => PrimArray a -> X -> a
PA.indexPrimArray PrimArray X
speedupHackXSize 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 n :: X
n =
    let !xsize :: X
xsize = PrimArray X -> X -> X
forall a. Prim a => PrimArray a -> X -> a
PA.indexPrimArray PrimArray X
speedupHackXSize 0
        !xsizeHalf :: X
xsizeHalf = X
xsize X -> X -> X
forall a. Integral a => a -> a -> a
`div` 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
+ 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
- 1)
                   | Bool
otherwise = (X
x, X
y)
    in $WVector :: X -> X -> Vector
Vector{..}

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 v :: Vector
v = Vector -> X
chessDistVector Vector
v X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== 1

-- | Reverse an arbirary vector.
neg :: Vector -> Vector
{-# INLINE neg #-}
neg :: Vector -> Vector
neg (Vector vx :: X
vx vy :: 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
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 x0 :: X
x0 y0 :: X
y0) (Vector x1 :: X
x1 y1 :: 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
^ (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
^ (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)
    [(-1, -1), (0, -1), (1, -1), (1, 0), (1, 1), (0, 1), (-1, 1), (-1, 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) [(0, -1), (1, 0), (0, 1), (-1, 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) [(-1, -1), (1, -1), (1, 1), (-1, 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 = [ "northwest", "north", "northeast", "east"
                , "southeast", "south", "southwest", "west" ]

compassText :: Vector -> Text
compassText :: Vector -> Text
compassText v :: 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
$ "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

-- | Checks that a point belongs to an area.
insideP :: Point -> (X, Y, X, Y) -> Bool
{-# INLINE insideP #-}
insideP :: Point -> (X, X, X, X) -> Bool
insideP (Point x :: X
x y :: X
y) (x0 :: X
x0, y0 :: X
y0, x1 :: X
x1, y1 :: X
y1) = X
x1 X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= X
x Bool -> Bool -> Bool
&& X
x X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= X
x0 Bool -> Bool -> Bool
&& X
y1 X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= X
y Bool -> Bool -> Bool
&& X
y X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= X
y0

-- | 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 rXmax :: X
rXmax rYmax :: X
rYmax p :: Point
p =
  if Point -> (X, X, X, X) -> Bool
insideP Point
p (1, 1, X
rXmax X -> X -> X
forall a. Num a => a -> a -> a
- 2, X
rYmax X -> X -> X
forall a. Num a => a -> a -> a
- 2)
  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
             , Point -> (X, X, X, X) -> Bool
insideP Point
res (0, 0, X
rXmax X -> X -> X
forall a. Num a => a -> a -> a
- 1, X
rYmax X -> X -> X
forall a. Num a => a -> a -> a
- 1) ]

vicinityUnsafe :: Point -> [Point]
{-# INLINE vicinityUnsafe #-}
vicinityUnsafe :: Point -> [Point]
vicinityUnsafe p :: 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 rXmax :: X
rXmax rYmax :: X
rYmax p :: Point
p =
  [ Point
res | Vector
dxy <- [Vector]
movesCardinal
        , let res :: Point
res = Point -> Vector -> Point
shift Point
p Vector
dxy
        , Point -> (X, X, X, X) -> Bool
insideP Point
res (0, 0, X
rXmax X -> X -> X
forall a. Num a => a -> a -> a
- 1, X
rYmax X -> X -> X
forall a. Num a => a -> a -> a
- 1) ]

vicinityCardinalUnsafe :: Point -> [Point]
vicinityCardinalUnsafe :: Point -> [Point]
vicinityCardinalUnsafe p :: 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)
                  [ (-1, -1), (0, -1), (1, -1)
                  , (-1, 0), (0, 0), (1, 0)
                  , (-1, 1), (0, 1), (1, 1) ]

squareUnsafeSet :: Point -> ES.EnumSet Point
{-# INLINE squareUnsafeSet #-}
squareUnsafeSet :: Point -> EnumSet Point
squareUnsafeSet p :: 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 x0 :: X
x0 y0 :: X
y0) (Vector x1 :: X
x1 y1 :: 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 rXmax :: X
rXmax rYmax :: X
rYmax pos :: Point
pos v :: Vector
v@(Vector xv :: X
xv yv :: X
yv) =
  if Point -> (X, X, X, X) -> Bool
insideP Point
pos (-X
xv, -X
yv, X
rXmax X -> X -> X
forall a. Num a => a -> a -> a
- X
xv X -> X -> X
forall a. Num a => a -> a -> a
- 1, X
rYmax X -> X -> X
forall a. Num a => a -> a -> a
- X
yv X -> X -> X
forall a. Num a => a -> a -> a
- 1)
  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 _ [] = []
trajectoryToPath start :: Point
start (v :: Vector
v : vs :: [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 _ _ _ [] = []
trajectoryToPathBounded rXmax :: X
rXmax rYmax :: X
rYmax start :: Point
start (v :: Vector
v : vs :: [Vector]
vs) =
  let next :: Point
next = X -> X -> Point -> Vector -> Point
shiftBounded X
rXmax X
rYmax Point
start Vector
v
  in Point
next Point -> [Point] -> [Point]
forall a. a -> [a] -> [a]
: X -> X -> Point -> [Vector] -> [Point]
trajectoryToPathBounded X
rXmax X
rYmax 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 x0 :: X
x0 y0 :: X
y0) (Point x1 :: X
x1 y1 :: 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@(_ : lp2 :: [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 weight :: X
weight throwVelocity :: X
throwVelocity throwLinger :: X
throwLinger path :: [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
+ 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 :: RadianAngle -> Vector -> Vector
rotate angle :: RadianAngle
angle (Vector x' :: X
x' y' :: X
y') =
  let x :: RadianAngle
x = X -> RadianAngle
intToDouble X
x'
      y :: RadianAngle
y = X -> RadianAngle
intToDouble X
y'
      -- Minus before the angle comes from our coordinates being
      -- mirrored along the X axis (Y coordinates grow going downwards).
      dx :: RadianAngle
dx = RadianAngle
x RadianAngle -> RadianAngle -> RadianAngle
forall a. Num a => a -> a -> a
* RadianAngle -> RadianAngle
forall a. Floating a => a -> a
cos (-RadianAngle
angle) RadianAngle -> RadianAngle -> RadianAngle
forall a. Num a => a -> a -> a
- RadianAngle
y RadianAngle -> RadianAngle -> RadianAngle
forall a. Num a => a -> a -> a
* RadianAngle -> RadianAngle
forall a. Floating a => a -> a
sin (-RadianAngle
angle)
      dy :: RadianAngle
dy = RadianAngle
x RadianAngle -> RadianAngle -> RadianAngle
forall a. Num a => a -> a -> a
* RadianAngle -> RadianAngle
forall a. Floating a => a -> a
sin (-RadianAngle
angle) RadianAngle -> RadianAngle -> RadianAngle
forall a. Num a => a -> a -> a
+ RadianAngle
y RadianAngle -> RadianAngle -> RadianAngle
forall a. Num a => a -> a -> a
* RadianAngle -> RadianAngle
forall a. Floating a => a -> a
cos (-RadianAngle
angle)
  in RadianAngle -> RadianAngle -> Vector
normalize RadianAngle
dx RadianAngle
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 :: RadianAngle -> RadianAngle -> Vector
normalize dx :: RadianAngle
dx dy :: RadianAngle
dy =
  Bool -> Vector -> Vector
forall a. HasCallStack => Bool -> a -> a
assert (RadianAngle
dx RadianAngle -> RadianAngle -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 Bool -> Bool -> Bool
|| RadianAngle
dy RadianAngle -> RadianAngle -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 Bool -> (String, (RadianAngle, RadianAngle)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "can't normalize zero" String
-> (RadianAngle, RadianAngle)
-> (String, (RadianAngle, RadianAngle))
forall v. String -> v -> (String, v)
`swith` (RadianAngle
dx, RadianAngle
dy)) (Vector -> Vector) -> Vector -> Vector
forall a b. (a -> b) -> a -> b
$
  let angle :: Double
      angle :: RadianAngle
angle = RadianAngle -> RadianAngle
forall a. Floating a => a -> a
atan (RadianAngle
dy RadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/ RadianAngle
dx) RadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/ (RadianAngle
forall a. Floating a => a
pi RadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/ 2)
      dxy :: (X, X)
dxy | RadianAngle
angle RadianAngle -> RadianAngle -> Bool
forall a. Ord a => a -> a -> Bool
<= -0.75 Bool -> Bool -> Bool
&& RadianAngle
angle RadianAngle -> RadianAngle -> Bool
forall a. Ord a => a -> a -> Bool
>= -1.25 = (0, -1)
          | RadianAngle
angle RadianAngle -> RadianAngle -> Bool
forall a. Ord a => a -> a -> Bool
<= -0.25 = (1, -1)
          | RadianAngle
angle RadianAngle -> RadianAngle -> Bool
forall a. Ord a => a -> a -> Bool
<= 0.25  = (1, 0)
          | RadianAngle
angle RadianAngle -> RadianAngle -> Bool
forall a. Ord a => a -> a -> Bool
<= 0.75  = (1, 1)
          | RadianAngle
angle RadianAngle -> RadianAngle -> Bool
forall a. Ord a => a -> a -> Bool
<= 1.25  = (0, 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
$ "impossible angle" String -> (RadianAngle, RadianAngle, RadianAngle) -> String
forall v. Show v => String -> v -> String
`showFailure` (RadianAngle
dx, RadianAngle
dy, RadianAngle
angle)
  in if RadianAngle
dx RadianAngle -> RadianAngle -> Bool
forall a. Ord a => a -> a -> Bool
>= 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 vx :: X
vx vy :: X
vy) =
  let res :: Vector
res = RadianAngle -> RadianAngle -> Vector
normalize (X -> RadianAngle
intToDouble X
vx) (X -> RadianAngle
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 a. Show a => Bool -> a -> Bool
`blame` "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 pos0 :: Point
pos0 pos1 :: 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 a. Show a => Bool -> a -> Bool
`blame` "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