{-# 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, 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
vy :: X
vx :: X
vy :: Vector -> X
vx :: Vector -> 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 -> X -> Vector
Vector{X
vy :: X
vx :: X
vy :: X
vx :: 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 :: RadianAngle -> Vector -> Vector
rotate RadianAngle
angle (Vector X
x' 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 RadianAngle
dx RadianAngle
dy =
  Bool -> Vector -> Vector
forall a. HasCallStack => Bool -> a -> a
assert (RadianAngle
dx RadianAngle -> RadianAngle -> Bool
forall a. Eq a => a -> a -> Bool
/= RadianAngle
0 Bool -> Bool -> Bool
|| RadianAngle
dy RadianAngle -> RadianAngle -> Bool
forall a. Eq a => a -> a -> Bool
/= RadianAngle
0 Bool -> (String, (RadianAngle, RadianAngle)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` String
"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
/ RadianAngle
2)
      dxy :: (X, X)
dxy | RadianAngle
angle RadianAngle -> RadianAngle -> Bool
forall a. Ord a => a -> a -> Bool
<= -RadianAngle
0.75 Bool -> Bool -> Bool
&& RadianAngle
angle RadianAngle -> RadianAngle -> Bool
forall a. Ord a => a -> a -> Bool
>= -RadianAngle
1.25 = (X
0, -X
1)
          | RadianAngle
angle RadianAngle -> RadianAngle -> Bool
forall a. Ord a => a -> a -> Bool
<= -RadianAngle
0.25 = (X
1, -X
1)
          | RadianAngle
angle RadianAngle -> RadianAngle -> Bool
forall a. Ord a => a -> a -> Bool
<= RadianAngle
0.25  = (X
1, X
0)
          | RadianAngle
angle RadianAngle -> RadianAngle -> Bool
forall a. Ord a => a -> a -> Bool
<= RadianAngle
0.75  = (X
1, X
1)
          | RadianAngle
angle RadianAngle -> RadianAngle -> Bool
forall a. Ord a => a -> a -> Bool
<= RadianAngle
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 -> (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
>= RadianAngle
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 = 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` 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 a. Show a => Bool -> a -> 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