{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
module Geomancy.Vec2
( Vec2
, vec2
, withVec2
, pattern WithVec2
, fromTuple
, (^*)
, (^/)
, lerp
, dot
, normalize
) where
import Control.DeepSeq (NFData(rnf))
import Foreign (Storable(..))
data Vec2 = Vec2
{-# UNPACK #-} !Float
{-# UNPACK #-} !Float
deriving (Vec2 -> Vec2 -> Bool
(Vec2 -> Vec2 -> Bool) -> (Vec2 -> Vec2 -> Bool) -> Eq Vec2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vec2 -> Vec2 -> Bool
$c/= :: Vec2 -> Vec2 -> Bool
== :: Vec2 -> Vec2 -> Bool
$c== :: Vec2 -> Vec2 -> Bool
Eq, Eq Vec2
Eq Vec2
-> (Vec2 -> Vec2 -> Ordering)
-> (Vec2 -> Vec2 -> Bool)
-> (Vec2 -> Vec2 -> Bool)
-> (Vec2 -> Vec2 -> Bool)
-> (Vec2 -> Vec2 -> Bool)
-> (Vec2 -> Vec2 -> Vec2)
-> (Vec2 -> Vec2 -> Vec2)
-> Ord Vec2
Vec2 -> Vec2 -> Bool
Vec2 -> Vec2 -> Ordering
Vec2 -> Vec2 -> Vec2
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 :: Vec2 -> Vec2 -> Vec2
$cmin :: Vec2 -> Vec2 -> Vec2
max :: Vec2 -> Vec2 -> Vec2
$cmax :: Vec2 -> Vec2 -> Vec2
>= :: Vec2 -> Vec2 -> Bool
$c>= :: Vec2 -> Vec2 -> Bool
> :: Vec2 -> Vec2 -> Bool
$c> :: Vec2 -> Vec2 -> Bool
<= :: Vec2 -> Vec2 -> Bool
$c<= :: Vec2 -> Vec2 -> Bool
< :: Vec2 -> Vec2 -> Bool
$c< :: Vec2 -> Vec2 -> Bool
compare :: Vec2 -> Vec2 -> Ordering
$ccompare :: Vec2 -> Vec2 -> Ordering
$cp1Ord :: Eq Vec2
Ord, Int -> Vec2 -> ShowS
[Vec2] -> ShowS
Vec2 -> String
(Int -> Vec2 -> ShowS)
-> (Vec2 -> String) -> ([Vec2] -> ShowS) -> Show Vec2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vec2] -> ShowS
$cshowList :: [Vec2] -> ShowS
show :: Vec2 -> String
$cshow :: Vec2 -> String
showsPrec :: Int -> Vec2 -> ShowS
$cshowsPrec :: Int -> Vec2 -> ShowS
Show)
{-# INLINE vec2 #-}
vec2 :: Float -> Float -> Vec2
vec2 :: Float -> Float -> Vec2
vec2 = Float -> Float -> Vec2
Vec2
{-# INLINE withVec2 #-}
withVec2
:: Vec2
-> (Float -> Float -> r)
-> r
withVec2 :: Vec2 -> (Float -> Float -> r) -> r
withVec2 (Vec2 Float
a Float
b) Float -> Float -> r
f = Float -> Float -> r
f Float
a Float
b
pattern WithVec2 :: Float -> Float -> Vec2
pattern $mWithVec2 :: forall r. Vec2 -> (Float -> Float -> r) -> (Void# -> r) -> r
WithVec2 a b <- ((`withVec2` (,)) -> (a, b))
{-# COMPLETE WithVec2 #-}
{-# INLINE fromTuple #-}
fromTuple :: (Float, Float) -> Vec2
fromTuple :: (Float, Float) -> Vec2
fromTuple (Float
x, Float
y) = Float -> Float -> Vec2
vec2 Float
x Float
y
instance NFData Vec2 where
rnf :: Vec2 -> ()
rnf Vec2{} = ()
instance Num Vec2 where
{-# INLINE (+) #-}
Vec2 Float
l1 Float
l2 + :: Vec2 -> Vec2 -> Vec2
+ Vec2 Float
r1 Float
r2 =
Float -> Float -> Vec2
Vec2
(Float
l1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
r1)
(Float
l2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
r2)
{-# INLINE (-) #-}
Vec2 Float
l1 Float
l2 - :: Vec2 -> Vec2 -> Vec2
- Vec2 Float
r1 Float
r2 =
Float -> Float -> Vec2
Vec2
(Float
l1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
r1)
(Float
l2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
r2)
{-# INLINE (*) #-}
Vec2 Float
l1 Float
l2 * :: Vec2 -> Vec2 -> Vec2
* Vec2 Float
r1 Float
r2 =
Float -> Float -> Vec2
Vec2
(Float
l1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
r1)
(Float
l2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
r2)
{-# INLINE abs #-}
abs :: Vec2 -> Vec2
abs (Vec2 Float
a Float
b) =
Float -> Float -> Vec2
Vec2 (Float -> Float
forall a. Num a => a -> a
abs Float
a) (Float -> Float
forall a. Num a => a -> a
abs Float
b)
{-# INLINE signum #-}
signum :: Vec2 -> Vec2
signum (Vec2 Float
a Float
b) =
Float -> Float -> Vec2
Vec2 (Float -> Float
forall a. Num a => a -> a
signum Float
a) (Float -> Float
forall a. Num a => a -> a
signum Float
b)
{-# INLINE fromInteger #-}
fromInteger :: Integer -> Vec2
fromInteger Integer
x = Float -> Float -> Vec2
Vec2 Float
x' Float
x'
where
x' :: Float
x' = Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
x
instance Fractional Vec2 where
{-# INLINE (/) #-}
Vec2 Float
l1 Float
l2 / :: Vec2 -> Vec2 -> Vec2
/ Vec2 Float
r1 Float
r2 =
Float -> Float -> Vec2
Vec2 (Float
l1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
r1) (Float
l2 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
r2)
{-# INLINE recip #-}
recip :: Vec2 -> Vec2
recip (Vec2 Float
a Float
b) =
Float -> Float -> Vec2
Vec2 (Float -> Float
forall a. Fractional a => a -> a
recip Float
a) (Float -> Float
forall a. Fractional a => a -> a
recip Float
b)
{-# INLINE fromRational #-}
fromRational :: Rational -> Vec2
fromRational Rational
x = Float -> Float -> Vec2
Vec2 Float
x' Float
x'
where
x' :: Float
x' = Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
x
{-# INLINE (^*) #-}
(^*) :: Vec2 -> Float -> Vec2
Vec2 Float
a Float
b ^* :: Vec2 -> Float -> Vec2
^* Float
x =
Float -> Float -> Vec2
Vec2
(Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x)
(Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x)
{-# INLINE (^/) #-}
(^/) :: Vec2 -> Float -> Vec2
Vec2 Float
a Float
b ^/ :: Vec2 -> Float -> Vec2
^/ Float
x =
Float -> Float -> Vec2
Vec2
(Float
a Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
x)
(Float
b Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
x)
{-# INLINE lerp #-}
lerp :: Float -> Vec2 -> Vec2 -> Vec2
lerp :: Float -> Vec2 -> Vec2 -> Vec2
lerp Float
alpha Vec2
u Vec2
v = Vec2
u Vec2 -> Float -> Vec2
^* Float
alpha Vec2 -> Vec2 -> Vec2
forall a. Num a => a -> a -> a
+ Vec2
v Vec2 -> Float -> Vec2
^* (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
alpha)
{-# INLINE dot #-}
dot :: Vec2 -> Vec2 -> Float
dot :: Vec2 -> Vec2 -> Float
dot (Vec2 Float
l1 Float
l2) (Vec2 Float
r1 Float
r2) =
Float
l1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
r1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
l2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
r2
{-# INLINE normalize #-}
normalize :: Vec2 -> Vec2
normalize :: Vec2 -> Vec2
normalize Vec2
v =
if Float -> Bool
forall a. (Ord a, Fractional a) => a -> Bool
nearZero Float
q Bool -> Bool -> Bool
|| Float -> Bool
forall a. (Ord a, Fractional a) => a -> Bool
nearZero (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
q) then
Vec2
v
else
let
Vec2 Float
x Float
y = Vec2
v
in
Float -> Float -> Vec2
Vec2 (Float
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
l) (Float
y Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
l)
where
q :: Float
q = Vec2 -> Vec2 -> Float
dot Vec2
v Vec2
v
l :: Float
l = Float -> Float
forall a. Floating a => a -> a
sqrt Float
q
nearZero :: a -> Bool
nearZero a
a = a -> a
forall a. Num a => a -> a
abs a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
1e-6
instance Storable Vec2 where
{-# INLINE sizeOf #-}
sizeOf :: Vec2 -> Int
sizeOf Vec2
_ = Int
8
{-# INLINE alignment #-}
alignment :: Vec2 -> Int
alignment Vec2
_ = Int
8
{-# INLINE poke #-}
poke :: Ptr Vec2 -> Vec2 -> IO ()
poke Ptr Vec2
ptr Vec2
v4 =
Vec2 -> (Float -> Float -> IO ()) -> IO ()
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
v4 \Float
a Float
b -> do
Ptr Vec2 -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Vec2
ptr Int
0 Float
a
Ptr Vec2 -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Vec2
ptr Int
4 Float
b
{-# INLINE peek #-}
peek :: Ptr Vec2 -> IO Vec2
peek Ptr Vec2
ptr = Float -> Float -> Vec2
vec2
(Float -> Float -> Vec2) -> IO Float -> IO (Float -> Vec2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Vec2 -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Vec2
ptr Int
0
IO (Float -> Vec2) -> IO Float -> IO Vec2
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Vec2 -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Vec2
ptr Int
4