Cleanup
This commit is contained in:
+94
-62
@@ -1,159 +1,191 @@
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
module Geometry.Vector
|
||||
where
|
||||
|
||||
module Geometry.Vector where
|
||||
|
||||
import Geometry.Data
|
||||
{- | Moves from two to three dimensions, adding zero in z direction. -}
|
||||
|
||||
-- | Moves from two to three dimensions, adding zero in z direction.
|
||||
zeroZ :: Point2 -> Point3
|
||||
{-# INLINE zeroZ #-}
|
||||
zeroZ (V2 x y) = V3 x y 0
|
||||
|
||||
infixl 6 +.+, -.-
|
||||
|
||||
infixl 7 *.*
|
||||
|
||||
{- | 2D coordinate-wise addition. -}
|
||||
-- | 2D coordinate-wise addition.
|
||||
(+.+) :: Point2 -> Point2 -> Point2
|
||||
{-# INLINE (+.+) #-}
|
||||
--(+.+) = -- (+)
|
||||
V2 x1 y1 +.+ V2 x2 y2 =
|
||||
let
|
||||
!x = x1 + x2
|
||||
!y = y1 + y2
|
||||
in V2 x y
|
||||
{- | 2D coordinate-wise subtraction. -}
|
||||
let !x = x1 + x2
|
||||
!y = y1 + y2
|
||||
in V2 x y
|
||||
|
||||
-- | 2D coordinate-wise subtraction.
|
||||
(-.-) :: Point2 -> Point2 -> Point2
|
||||
{-# INLINE (-.-) #-}
|
||||
--(-.-) = (-)
|
||||
V2 x1 y1 -.- V2 x2 y2 =
|
||||
let
|
||||
!x = x1 - x2
|
||||
!y = y1 - y2
|
||||
in V2 x y
|
||||
{- | 2D scalar multiplication. -}
|
||||
let !x = x1 - x2
|
||||
!y = y1 - y2
|
||||
in V2 x y
|
||||
|
||||
-- | 2D scalar multiplication.
|
||||
(*.*) :: Float -> Point2 -> Point2
|
||||
{-# INLINE (*.*) #-}
|
||||
a *.* V2 x2 y2 =
|
||||
let
|
||||
!x = a * x2
|
||||
!y = a * y2
|
||||
in V2 x y
|
||||
let !x = a * x2
|
||||
!y = a * y2
|
||||
in V2 x y
|
||||
|
||||
{- | Normalize a vector to length 1. -}
|
||||
-- | Normalize a vector to length 1.
|
||||
normalizeV :: Point2 -> Point2
|
||||
{-# INLINE normalizeV #-}
|
||||
normalizeV p = (1 / magV p) *.* p
|
||||
|
||||
{- | Angle between two vectors. Always positive. -}
|
||||
clipV :: Float -> Point2 -> Point2
|
||||
{-# INLINE clipV #-}
|
||||
clipV x v
|
||||
| magV v > x = x *.* normalizeV v
|
||||
| otherwise = v
|
||||
|
||||
-- | Angle between two vectors. Always positive.
|
||||
|
||||
-- TODO fix this: it seems to be unstable when the two vectors are very close to
|
||||
-- each other
|
||||
angleVV :: Point2 -> Point2 -> Float
|
||||
{-# INLINE angleVV #-}
|
||||
angleVV a b
|
||||
angleVV a b
|
||||
| a == b = 0
|
||||
| otherwise =
|
||||
let ma = magV a
|
||||
mb = magV b
|
||||
d = a `dotV` b
|
||||
in acos $ d / (ma * mb)
|
||||
{- | Safe version of 'angleVV' that returns 0 if either vector is null. -}
|
||||
d = a `dotV` b
|
||||
in acos $ d / (ma * mb)
|
||||
|
||||
-- | Safe version of 'angleVV' that returns 0 if either vector is null.
|
||||
safeAngleVV :: Point2 -> Point2 -> Float
|
||||
{-# INLINE safeAngleVV #-}
|
||||
safeAngleVV a b
|
||||
| a == V2 0 0 || b == V2 0 0 = 0
|
||||
| otherwise = angleVV a b
|
||||
{- | Dot product. -}
|
||||
| otherwise = angleVV a b
|
||||
|
||||
-- | Dot product.
|
||||
dotV :: Point2 -> Point2 -> Float
|
||||
{-# INLINE dotV #-}
|
||||
dotV (V2 x y) (V2 z w) = x*z + y*w
|
||||
{- | Given vector, returns the angle, anticlockwise from +ve x-axis, in radians. -}
|
||||
dotV (V2 x y) (V2 z w) = x * z + y * w
|
||||
|
||||
-- | Given vector, returns the angle, anticlockwise from +ve x-axis, in radians.
|
||||
argV :: Point2 -> Float
|
||||
{-# INLINE argV #-}
|
||||
argV (V2 x y) = normalizeAngle $ atan2 y x
|
||||
|
||||
{- | Given vector, returns the angle, anticlockwise from +ve x-axis, in radians.
|
||||
Returns Nothing for a 0 0 vector. -}
|
||||
{- | Given vector, returns the angle, anticlockwise from +ve x-axis, in radians.
|
||||
Returns Nothing for a 0 0 vector.
|
||||
-}
|
||||
safeArgV :: Point2 -> Maybe Float
|
||||
{-# INLINE safeArgV #-}
|
||||
safeArgV (V2 0 0) = Nothing
|
||||
safeArgV v = Just $ argV v
|
||||
{- | Determinant of the matrix formed by two vectors. -}
|
||||
|
||||
-- | Determinant of the matrix formed by two vectors.
|
||||
detV :: Point2 -> Point2 -> Float
|
||||
{-# INLINE detV #-}
|
||||
detV (V2 x1 y1) (V2 x2 y2) = x1 * y2 - y1 * x2
|
||||
{- | Given an angle in radians, anticlockwise from +ve x-axis,
|
||||
- returns the corresponding unit vector. -}
|
||||
|
||||
{- | Given an angle in radians, anticlockwise from +ve x-axis,
|
||||
- returns the corresponding unit vector.
|
||||
-}
|
||||
unitVectorAtAngle :: Float -> Point2
|
||||
{-# INLINE unitVectorAtAngle #-}
|
||||
unitVectorAtAngle r = V2 (cos r) (sin r)
|
||||
|
||||
-- | Rotate a vector by an angle (in radians). +ve angle is counter-clockwise.
|
||||
rotateV :: Float -> Point2 -> Point2
|
||||
rotateV r (V2 x y) = V2
|
||||
(x * cos r - y * sin r)
|
||||
(x * sin r + y * cos r)
|
||||
rotateV r (V2 x y) =
|
||||
V2
|
||||
(x * cos r - y * sin r)
|
||||
(x * sin r + y * cos r)
|
||||
{-# INLINE rotateV #-}
|
||||
|
||||
rotateVAround :: Point2 -> Float -> Point2 -> Point2
|
||||
rotateVAround p r q = rotateV r (q -.- p) +.+ p
|
||||
{-# INLINE rotateVAround #-}
|
||||
|
||||
-- | Convert degrees to radians
|
||||
degToRad :: Float -> Float
|
||||
degToRad d = d * pi / 180
|
||||
{-# INLINE degToRad #-}
|
||||
|
||||
-- | Convert radians to degrees
|
||||
radToDeg :: Float -> Float
|
||||
radToDeg r = r * 180 / pi
|
||||
{-# INLINE radToDeg #-}
|
||||
|
||||
-- | Normalize an angle to be between 0 and 2*pi radians
|
||||
normalizeAngle :: Float -> Float
|
||||
{-# INLINE normalizeAngle #-}
|
||||
normalizeAngle f
|
||||
| f >= 0 && f < 2*pi = f
|
||||
normalizeAngle f
|
||||
| f >= 0 && f < 2 * pi = f
|
||||
| otherwise = f - 2 * pi * floor' (f / (2 * pi))
|
||||
where
|
||||
where
|
||||
floor' :: Float -> Float
|
||||
floor' x = fromIntegral (floor x :: Int)
|
||||
{- | Rotate vector by pi/2 clockwise. -}
|
||||
|
||||
-- | Rotate vector by pi/2 clockwise.
|
||||
vNormal :: Point2 -> Point2
|
||||
{-# INLINE vNormal #-}
|
||||
vNormal (V2 x y) = V2 y (negate x)
|
||||
{- | Negate a vector. -}
|
||||
|
||||
-- | Negate a vector.
|
||||
vInverse :: Point2 -> Point2
|
||||
vInverse (V2 x y) = V2 (-x) (-y)
|
||||
{- | Normalize a vector safely: on (0,0) return (0,0). -}
|
||||
vInverse (V2 x y) = V2 (- x) (- y)
|
||||
|
||||
-- | Normalize a vector safely: on (0,0) return (0,0).
|
||||
squashNormalizeV :: Point2 -> Point2
|
||||
{-# INLINE squashNormalizeV #-}
|
||||
squashNormalizeV p
|
||||
squashNormalizeV p
|
||||
| magV p == 0 = V2 0 0
|
||||
| otherwise = (1/magV p ) *.* p
|
||||
{- | Normalize a vector safely: on (0,0) return Nothing. -}
|
||||
| otherwise = (1 / magV p) *.* p
|
||||
|
||||
-- | Normalize a vector safely: on (0,0) return Nothing.
|
||||
safeNormalizeV :: Point2 -> Maybe Point2
|
||||
{-# INLINE safeNormalizeV #-}
|
||||
safeNormalizeV p
|
||||
safeNormalizeV p
|
||||
| magV p == 0 = Nothing
|
||||
| otherwise = Just $ (1/magV p ) *.* p
|
||||
{- | Magnitude of a vector. -}
|
||||
| otherwise = Just $ (1 / magV p) *.* p
|
||||
|
||||
-- | Magnitude of a vector.
|
||||
magV :: Point2 -> Float
|
||||
{-# INLINE magV #-}
|
||||
magV (V2 x y) = sqrt $ x^(2::Int) + y^(2::Int)
|
||||
magV (V2 x y) = sqrt $ x ^ (2 :: Int) + y ^ (2 :: Int)
|
||||
|
||||
{- | Magnitude of the cross product of two vectors.
|
||||
Identical to detV. -}
|
||||
Identical to detV.
|
||||
-}
|
||||
crossV :: Point2 -> Point2 -> Float
|
||||
crossV (V2 ax ay) (V2 bx by) = ax*by - ay*bx
|
||||
{- | TO CHECK Orthographic projection of one vector onto another. -}
|
||||
crossV (V2 ax ay) (V2 bx by) = ax * by - ay * bx
|
||||
|
||||
-- | TO CHECK Orthographic projection of one vector onto another.
|
||||
projV :: Point2 -> Point2 -> Point2
|
||||
projV fromv onv
|
||||
| den == 0 = error "tried projecting onto zero vector"
|
||||
projV fromv onv
|
||||
| den == 0 = error "tried projecting onto zero vector"
|
||||
| otherwise = (fromv `dotV` onv) / den *.* onv
|
||||
where
|
||||
den = onv `dotV` onv
|
||||
|
||||
-- | Return distance between two points.
|
||||
dist :: Point2 -> Point2 -> Float
|
||||
{-# INLINE dist #-}
|
||||
dist !p1 !p2 = magV (p2 -.- p1)
|
||||
|
||||
-- | Finds a new angle a given fraction between two other angles
|
||||
tweenAngles
|
||||
:: Float
|
||||
-> Float
|
||||
-> Float
|
||||
-> Float
|
||||
tweenAngles ::
|
||||
Float ->
|
||||
Float ->
|
||||
Float ->
|
||||
Float
|
||||
{-# INLINE tweenAngles #-}
|
||||
tweenAngles frac a1 a2
|
||||
| abs (a1 - a2) < pi = frac * (a1 - a2) + a2
|
||||
@@ -161,8 +193,8 @@ tweenAngles frac a1 a2
|
||||
where
|
||||
go frac' a1' a2'
|
||||
| abs (a1' - a2') < pi = frac' * (a1' - a2') + a2'
|
||||
| a1' > a2' = go frac' (a1' - 2*pi) a2'
|
||||
| otherwise = go frac' a1' (a2' - 2*pi)
|
||||
| a1' > a2' = go frac' (a1' - 2 * pi) a2'
|
||||
| otherwise = go frac' a1' (a2' - 2 * pi)
|
||||
|
||||
xV2 :: Point2 -> Float
|
||||
{-# INLINE xV2 #-}
|
||||
|
||||
Reference in New Issue
Block a user