{-# LANGUAGE DeriveGeneric #-}
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
, 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
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
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
type VectorI = Int
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
neg :: Vector -> Vector
{-# INLINE neg #-}
neg :: Vector -> Vector
neg (Vector vx :: X
vx vy :: X
vy) = X -> X -> Vector
Vector (-X
vx) (-X
vy)
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)
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)
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)]
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
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
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
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
vicinityBounded :: X -> Y
-> Point
-> [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 ]
vicinityCardinal :: X -> Y
-> Point
-> [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 ]
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
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)
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
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
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
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)
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 :: 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'
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
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
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