{-# 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, Num b) => a -> b
fromIntegralWrap :: Int32 -> Int)) Get Int32
forall t. Binary t => Get t
get
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
type VectorI = Int
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
neg :: Vector -> Vector
{-# INLINE neg #-}
neg :: Vector -> Vector
neg (Vector X
vx 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 -> 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 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)
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)]
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
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
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
vicinityBounded :: X -> Y
-> Point
-> [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 ]
vicinityCardinal :: X -> Y
-> Point
-> [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 ]
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
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)
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
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
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
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)
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 :: 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'
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 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
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