{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
module Geomancy.Vec3
( Vec3
, vec3
, withVec3
, pattern WithVec3
, fromVec2
, fromTuple
, (^*)
, (^/)
, lerp
, cross
, dot
, normalize
, Packed(..)
, packed
) where
import Control.DeepSeq (NFData(rnf))
import Data.Coerce (Coercible, coerce)
import Foreign (Storable(..), castPtr)
import Geomancy.Vec2 (Vec2, withVec2)
data Vec3 = Vec3
{-# UNPACK #-} !Float
{-# UNPACK #-} !Float
{-# UNPACK #-} !Float
deriving (Vec3 -> Vec3 -> Bool
(Vec3 -> Vec3 -> Bool) -> (Vec3 -> Vec3 -> Bool) -> Eq Vec3
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vec3 -> Vec3 -> Bool
$c/= :: Vec3 -> Vec3 -> Bool
== :: Vec3 -> Vec3 -> Bool
$c== :: Vec3 -> Vec3 -> Bool
Eq, Eq Vec3
Eq Vec3
-> (Vec3 -> Vec3 -> Ordering)
-> (Vec3 -> Vec3 -> Bool)
-> (Vec3 -> Vec3 -> Bool)
-> (Vec3 -> Vec3 -> Bool)
-> (Vec3 -> Vec3 -> Bool)
-> (Vec3 -> Vec3 -> Vec3)
-> (Vec3 -> Vec3 -> Vec3)
-> Ord Vec3
Vec3 -> Vec3 -> Bool
Vec3 -> Vec3 -> Ordering
Vec3 -> Vec3 -> Vec3
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 :: Vec3 -> Vec3 -> Vec3
$cmin :: Vec3 -> Vec3 -> Vec3
max :: Vec3 -> Vec3 -> Vec3
$cmax :: Vec3 -> Vec3 -> Vec3
>= :: Vec3 -> Vec3 -> Bool
$c>= :: Vec3 -> Vec3 -> Bool
> :: Vec3 -> Vec3 -> Bool
$c> :: Vec3 -> Vec3 -> Bool
<= :: Vec3 -> Vec3 -> Bool
$c<= :: Vec3 -> Vec3 -> Bool
< :: Vec3 -> Vec3 -> Bool
$c< :: Vec3 -> Vec3 -> Bool
compare :: Vec3 -> Vec3 -> Ordering
$ccompare :: Vec3 -> Vec3 -> Ordering
$cp1Ord :: Eq Vec3
Ord, Int -> Vec3 -> ShowS
[Vec3] -> ShowS
Vec3 -> String
(Int -> Vec3 -> ShowS)
-> (Vec3 -> String) -> ([Vec3] -> ShowS) -> Show Vec3
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vec3] -> ShowS
$cshowList :: [Vec3] -> ShowS
show :: Vec3 -> String
$cshow :: Vec3 -> String
showsPrec :: Int -> Vec3 -> ShowS
$cshowsPrec :: Int -> Vec3 -> ShowS
Show)
{-# INLINE vec3 #-}
vec3 :: Float -> Float -> Float -> Vec3
vec3 :: Float -> Float -> Float -> Vec3
vec3 = Float -> Float -> Float -> Vec3
Vec3
{-# INLINE withVec3 #-}
withVec3
:: Vec3
-> (Float -> Float -> Float -> r)
-> r
withVec3 :: Vec3 -> (Float -> Float -> Float -> r) -> r
withVec3 (Vec3 Float
a Float
b Float
c) Float -> Float -> Float -> r
f = Float -> Float -> Float -> r
f Float
a Float
b Float
c
pattern WithVec3 :: Float -> Float -> Float -> Vec3
pattern $mWithVec3 :: forall r.
Vec3 -> (Float -> Float -> Float -> r) -> (Void# -> r) -> r
WithVec3 a b c <- ((`withVec3` (,,)) -> (a, b, c))
{-# COMPLETE WithVec3 #-}
{-# INLINE fromVec2 #-}
fromVec2 :: Coercible Vec3 a => Vec2 -> Float -> a
fromVec2 :: Vec2 -> Float -> a
fromVec2 Vec2
xy Float
z =
Vec2 -> (Float -> Float -> a) -> a
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
xy \Float
x Float
y ->
Vec3 -> a
coerce (Float -> Float -> Float -> Vec3
vec3 Float
x Float
y Float
z)
{-# INLINE fromTuple #-}
fromTuple :: Coercible Vec3 a => (Float, Float, Float) -> a
fromTuple :: (Float, Float, Float) -> a
fromTuple (Float
x, Float
y, Float
z) = Vec3 -> a
coerce (Float -> Float -> Float -> Vec3
vec3 Float
x Float
y Float
z)
instance NFData Vec3 where
rnf :: Vec3 -> ()
rnf Vec3{} = ()
instance Num Vec3 where
{-# INLINE (+) #-}
Vec3 Float
a Float
b Float
c + :: Vec3 -> Vec3 -> Vec3
+ Vec3 Float
d Float
e Float
f =
Float -> Float -> Float -> Vec3
Vec3
(Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
d)
(Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
e)
(Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
f)
{-# INLINE (-) #-}
Vec3 Float
a Float
b Float
c - :: Vec3 -> Vec3 -> Vec3
- Vec3 Float
d Float
e Float
f =
Float -> Float -> Float -> Vec3
Vec3
(Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
d)
(Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
e)
(Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
f)
{-# INLINE (*) #-}
Vec3 Float
a Float
b Float
c * :: Vec3 -> Vec3 -> Vec3
* Vec3 Float
d Float
e Float
f =
Float -> Float -> Float -> Vec3
Vec3
(Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
d)
(Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
e)
(Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
f)
{-# INLINE abs #-}
abs :: Vec3 -> Vec3
abs (Vec3 Float
a Float
b Float
c) =
Float -> Float -> Float -> Vec3
Vec3 (Float -> Float
forall a. Num a => a -> a
abs Float
a) (Float -> Float
forall a. Num a => a -> a
abs Float
b) (Float -> Float
forall a. Num a => a -> a
abs Float
c)
{-# INLINE signum #-}
signum :: Vec3 -> Vec3
signum (Vec3 Float
a Float
b Float
c) =
Float -> Float -> Float -> Vec3
Vec3 (Float -> Float
forall a. Num a => a -> a
signum Float
a) (Float -> Float
forall a. Num a => a -> a
signum Float
b) (Float -> Float
forall a. Num a => a -> a
signum Float
c)
{-# INLINE fromInteger #-}
fromInteger :: Integer -> Vec3
fromInteger Integer
x = Float -> Float -> Float -> Vec3
Vec3 Float
x' Float
x' Float
x'
where
x' :: Float
x' = Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
x
instance Fractional Vec3 where
{-# INLINE (/) #-}
Vec3 Float
l1 Float
l2 Float
l3 / :: Vec3 -> Vec3 -> Vec3
/ Vec3 Float
r1 Float
r2 Float
r3 =
Float -> Float -> Float -> Vec3
Vec3 (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) (Float
l3 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
r3)
{-# INLINE recip #-}
recip :: Vec3 -> Vec3
recip (Vec3 Float
a Float
b Float
c) =
Float -> Float -> Float -> Vec3
Vec3 (Float -> Float
forall a. Fractional a => a -> a
recip Float
a) (Float -> Float
forall a. Fractional a => a -> a
recip Float
b) (Float -> Float
forall a. Fractional a => a -> a
recip Float
c)
{-# INLINE fromRational #-}
fromRational :: Rational -> Vec3
fromRational Rational
x = Float -> Float -> Float -> Vec3
Vec3 Float
x' Float
x' Float
x'
where
x' :: Float
x' = Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
x
instance Storable Vec3 where
{-# INLINE sizeOf #-}
sizeOf :: Vec3 -> Int
sizeOf Vec3
_ = Int
16
{-# INLINE alignment #-}
alignment :: Vec3 -> Int
alignment Vec3
_ = Int
4
{-# INLINE poke #-}
poke :: Ptr Vec3 -> Vec3 -> IO ()
poke Ptr Vec3
ptr Vec3
v3 =
Vec3 -> (Float -> Float -> Float -> IO ()) -> IO ()
forall r. Vec3 -> (Float -> Float -> Float -> r) -> r
withVec3 Vec3
v3 \Float
a Float
b Float
c -> do
Ptr Float -> Float -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Float
forall b. Ptr b
ptr' Float
a
Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
forall b. Ptr b
ptr' Int
1 Float
b
Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
forall b. Ptr b
ptr' Int
2 Float
c
Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
forall b. Ptr b
ptr' Int
3 (Float
1.0 :: Float)
where
ptr' :: Ptr b
ptr' = Ptr Vec3 -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr Vec3
ptr
{-# INLINE peek #-}
peek :: Ptr Vec3 -> IO Vec3
peek Ptr Vec3
ptr =
Float -> Float -> Float -> Vec3
vec3 (Float -> Float -> Float -> Vec3)
-> IO Float -> IO (Float -> Float -> Vec3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Float -> IO Float
forall a. Storable a => Ptr a -> IO a
peek Ptr Float
forall b. Ptr b
ptr' IO (Float -> Float -> Vec3) -> IO Float -> IO (Float -> Vec3)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
forall b. Ptr b
ptr' Int
1 IO (Float -> Vec3) -> IO Float -> IO Vec3
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
forall b. Ptr b
ptr' Int
2
where
ptr' :: Ptr b
ptr' = Ptr Vec3 -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr Vec3
ptr
{-# INLINE (^*) #-}
(^*) :: Vec3 -> Float -> Vec3
Vec3 Float
a Float
b Float
c ^* :: Vec3 -> Float -> Vec3
^* Float
x =
Float -> Float -> Float -> Vec3
Vec3
(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)
(Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x)
{-# INLINE (^/) #-}
(^/) :: Vec3 -> Float -> Vec3
Vec3 Float
a Float
b Float
c ^/ :: Vec3 -> Float -> Vec3
^/ Float
x =
Float -> Float -> Float -> Vec3
Vec3
(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)
(Float
c Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
x)
{-# INLINE lerp #-}
lerp :: Float -> Vec3 -> Vec3 -> Vec3
lerp :: Float -> Vec3 -> Vec3 -> Vec3
lerp Float
alpha Vec3
u Vec3
v = Vec3
u Vec3 -> Float -> Vec3
^* Float
alpha Vec3 -> Vec3 -> Vec3
forall a. Num a => a -> a -> a
+ Vec3
v Vec3 -> Float -> Vec3
^* (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
alpha)
{-# INLINE cross #-}
cross :: Vec3 -> Vec3 -> Vec3
cross :: Vec3 -> Vec3 -> Vec3
cross (Vec3 Float
a Float
b Float
c) (Vec3 Float
d Float
e Float
f) =
Float -> Float -> Float -> Vec3
Vec3
(Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
f Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
e)
(Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
d Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
f)
(Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
e Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
d)
{-# INLINE dot #-}
dot :: Vec3 -> Vec3 -> Float
dot :: Vec3 -> Vec3 -> Float
dot (Vec3 Float
a Float
b Float
c) (Vec3 Float
d Float
e Float
f) =
Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
d Float -> Float -> Float
forall a. Num a => a -> a -> a
+
Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
e Float -> Float -> Float
forall a. Num a => a -> a -> a
+
Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
f
{-# INLINE normalize #-}
normalize :: Vec3 -> Vec3
normalize :: Vec3 -> Vec3
normalize Vec3
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
1Float -> Float -> Float
forall a. Num a => a -> a -> a
-Float
q) then
Vec3
v
else
let
Vec3 Float
x Float
y Float
z = Vec3
v
in
Float -> Float -> Float -> Vec3
Vec3 (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) (Float
z Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
l)
where
q :: Float
q = Vec3 -> Vec3 -> Float
dot Vec3
v Vec3
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
newtype Packed = Packed { Packed -> Vec3
unPacked :: Vec3 }
deriving (Packed -> Packed -> Bool
(Packed -> Packed -> Bool)
-> (Packed -> Packed -> Bool) -> Eq Packed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Packed -> Packed -> Bool
$c/= :: Packed -> Packed -> Bool
== :: Packed -> Packed -> Bool
$c== :: Packed -> Packed -> Bool
Eq, Eq Packed
Eq Packed
-> (Packed -> Packed -> Ordering)
-> (Packed -> Packed -> Bool)
-> (Packed -> Packed -> Bool)
-> (Packed -> Packed -> Bool)
-> (Packed -> Packed -> Bool)
-> (Packed -> Packed -> Packed)
-> (Packed -> Packed -> Packed)
-> Ord Packed
Packed -> Packed -> Bool
Packed -> Packed -> Ordering
Packed -> Packed -> Packed
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 :: Packed -> Packed -> Packed
$cmin :: Packed -> Packed -> Packed
max :: Packed -> Packed -> Packed
$cmax :: Packed -> Packed -> Packed
>= :: Packed -> Packed -> Bool
$c>= :: Packed -> Packed -> Bool
> :: Packed -> Packed -> Bool
$c> :: Packed -> Packed -> Bool
<= :: Packed -> Packed -> Bool
$c<= :: Packed -> Packed -> Bool
< :: Packed -> Packed -> Bool
$c< :: Packed -> Packed -> Bool
compare :: Packed -> Packed -> Ordering
$ccompare :: Packed -> Packed -> Ordering
$cp1Ord :: Eq Packed
Ord, Int -> Packed -> ShowS
[Packed] -> ShowS
Packed -> String
(Int -> Packed -> ShowS)
-> (Packed -> String) -> ([Packed] -> ShowS) -> Show Packed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Packed] -> ShowS
$cshowList :: [Packed] -> ShowS
show :: Packed -> String
$cshow :: Packed -> String
showsPrec :: Int -> Packed -> ShowS
$cshowsPrec :: Int -> Packed -> ShowS
Show, Packed -> ()
(Packed -> ()) -> NFData Packed
forall a. (a -> ()) -> NFData a
rnf :: Packed -> ()
$crnf :: Packed -> ()
NFData, Integer -> Packed
Packed -> Packed
Packed -> Packed -> Packed
(Packed -> Packed -> Packed)
-> (Packed -> Packed -> Packed)
-> (Packed -> Packed -> Packed)
-> (Packed -> Packed)
-> (Packed -> Packed)
-> (Packed -> Packed)
-> (Integer -> Packed)
-> Num Packed
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Packed
$cfromInteger :: Integer -> Packed
signum :: Packed -> Packed
$csignum :: Packed -> Packed
abs :: Packed -> Packed
$cabs :: Packed -> Packed
negate :: Packed -> Packed
$cnegate :: Packed -> Packed
* :: Packed -> Packed -> Packed
$c* :: Packed -> Packed -> Packed
- :: Packed -> Packed -> Packed
$c- :: Packed -> Packed -> Packed
+ :: Packed -> Packed -> Packed
$c+ :: Packed -> Packed -> Packed
Num, Num Packed
Num Packed
-> (Packed -> Packed -> Packed)
-> (Packed -> Packed)
-> (Rational -> Packed)
-> Fractional Packed
Rational -> Packed
Packed -> Packed
Packed -> Packed -> Packed
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Packed
$cfromRational :: Rational -> Packed
recip :: Packed -> Packed
$crecip :: Packed -> Packed
/ :: Packed -> Packed -> Packed
$c/ :: Packed -> Packed -> Packed
$cp1Fractional :: Num Packed
Fractional)
{-# INLINE packed #-}
packed :: Float -> Float -> Float -> Packed
packed :: Float -> Float -> Float -> Packed
packed Float
x Float
y Float
z = Vec3 -> Packed
Packed (Float -> Float -> Float -> Vec3
vec3 Float
x Float
y Float
z)
instance Storable Packed where
{-# INLINE sizeOf #-}
sizeOf :: Packed -> Int
sizeOf Packed
_ = Int
12
{-# INLINE alignment #-}
alignment :: Packed -> Int
alignment Packed
_ = Int
4
{-# INLINE poke #-}
poke :: Ptr Packed -> Packed -> IO ()
poke Ptr Packed
ptr (Packed Vec3
v3) =
Vec3 -> (Float -> Float -> Float -> IO ()) -> IO ()
forall r. Vec3 -> (Float -> Float -> Float -> r) -> r
withVec3 Vec3
v3 \Float
a Float
b Float
c -> do
Ptr Float -> Float -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Float
forall b. Ptr b
ptr' Float
a
Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
forall b. Ptr b
ptr' Int
1 Float
b
Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
forall b. Ptr b
ptr' Int
2 Float
c
where
ptr' :: Ptr b
ptr' = Ptr Packed -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr Packed
ptr
{-# INLINE peek #-}
peek :: Ptr Packed -> IO Packed
peek Ptr Packed
ptr = Float -> Float -> Float -> Packed
packed
(Float -> Float -> Float -> Packed)
-> IO Float -> IO (Float -> Float -> Packed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Float -> IO Float
forall a. Storable a => Ptr a -> IO a
peek Ptr Float
forall b. Ptr b
ptr'
IO (Float -> Float -> Packed) -> IO Float -> IO (Float -> Packed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
forall b. Ptr b
ptr' Int
1
IO (Float -> Packed) -> IO Float -> IO Packed
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
forall b. Ptr b
ptr' Int
2
where
ptr' :: Ptr b
ptr' = Ptr Packed -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr Packed
ptr