{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}

module Geomancy.Point
  ( Point(..)

  , Point2
  , Point3
  , Point3P
  , Point4

  , AffineSpace
  , (AffineSpace..+^)
  , (AffineSpace..-^)
  , (AffineSpace..-.)

  , qd
  , distance
  , lerp
  ) where

import Control.DeepSeq (NFData)
import Data.AffineSpace (AffineSpace)
import Data.MonoTraversable (Element, MonoFunctor(..), MonoPointed(..))
import Foreign.Storable (Storable)
import GHC.Generics (Generic)
import qualified Data.AffineSpace as AffineSpace

import Geomancy.Elementwise (Elementwise(..))
import Geomancy.Gl.Block (Block(..))
import Geomancy.Vec2 (Vec2)
import Geomancy.Vec3 (Vec3, Packed)
import Geomancy.Vec4 (Vec4)
import Geomancy.Vector (VectorSpace(..))
import qualified Geomancy.Vector as Vector

newtype Point v = Point v
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v x. Rep (Point v) x -> Point v
forall v x. Point v -> Rep (Point v) x
$cto :: forall v x. Rep (Point v) x -> Point v
$cfrom :: forall v x. Point v -> Rep (Point v) x
Generic)
  deriving anyclass (forall v (proxy :: * -> *). Block v => proxy (Point v) -> Bool
forall v (proxy :: * -> *). Block v => proxy (Point v) -> Int
forall v (m :: * -> *) a.
(Block v, MonadIO m) =>
Ptr a -> Diff a (Point v) -> m (Point v)
forall v (m :: * -> *) a.
(Block v, MonadIO m) =>
Ptr a -> Diff a (Point v) -> Point v -> m ()
forall b.
(forall (proxy :: * -> *). proxy b -> Int)
-> (forall (proxy :: * -> *). proxy b -> Int)
-> (forall (proxy :: * -> *). proxy b -> Bool)
-> (forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a b -> m b)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a b -> b -> m ())
-> (forall (proxy :: * -> *). proxy b -> Int)
-> (forall (proxy :: * -> *). proxy b -> Int)
-> (forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a b -> m b)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a b -> b -> m ())
-> (forall (proxy :: * -> *). proxy b -> Int)
-> (forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a b -> m b)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a b -> b -> m ())
-> Block b
writePacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a (Point v) -> Point v -> m ()
$cwritePacked :: forall v (m :: * -> *) a.
(Block v, MonadIO m) =>
Ptr a -> Diff a (Point v) -> Point v -> m ()
readPacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a (Point v) -> m (Point v)
$creadPacked :: forall v (m :: * -> *) a.
(Block v, MonadIO m) =>
Ptr a -> Diff a (Point v) -> m (Point v)
sizeOfPacked :: forall (proxy :: * -> *). proxy (Point v) -> Int
$csizeOfPacked :: forall v (proxy :: * -> *). Block v => proxy (Point v) -> Int
write430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a (Point v) -> Point v -> m ()
$cwrite430 :: forall v (m :: * -> *) a.
(Block v, MonadIO m) =>
Ptr a -> Diff a (Point v) -> Point v -> m ()
read430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a (Point v) -> m (Point v)
$cread430 :: forall v (m :: * -> *) a.
(Block v, MonadIO m) =>
Ptr a -> Diff a (Point v) -> m (Point v)
sizeOf430 :: forall (proxy :: * -> *). proxy (Point v) -> Int
$csizeOf430 :: forall v (proxy :: * -> *). Block v => proxy (Point v) -> Int
alignment430 :: forall (proxy :: * -> *). proxy (Point v) -> Int
$calignment430 :: forall v (proxy :: * -> *). Block v => proxy (Point v) -> Int
write140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a (Point v) -> Point v -> m ()
$cwrite140 :: forall v (m :: * -> *) a.
(Block v, MonadIO m) =>
Ptr a -> Diff a (Point v) -> Point v -> m ()
read140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a (Point v) -> m (Point v)
$cread140 :: forall v (m :: * -> *) a.
(Block v, MonadIO m) =>
Ptr a -> Diff a (Point v) -> m (Point v)
isStruct :: forall (proxy :: * -> *). proxy (Point v) -> Bool
$cisStruct :: forall v (proxy :: * -> *). Block v => proxy (Point v) -> Bool
sizeOf140 :: forall (proxy :: * -> *). proxy (Point v) -> Int
$csizeOf140 :: forall v (proxy :: * -> *). Block v => proxy (Point v) -> Int
alignment140 :: forall (proxy :: * -> *). proxy (Point v) -> Int
$calignment140 :: forall v (proxy :: * -> *). Block v => proxy (Point v) -> Int
Block)
  deriving stock (Point v -> Point v -> Bool
forall v. Eq v => Point v -> Point v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Point v -> Point v -> Bool
$c/= :: forall v. Eq v => Point v -> Point v -> Bool
== :: Point v -> Point v -> Bool
$c== :: forall v. Eq v => Point v -> Point v -> Bool
Eq, Point v -> Point v -> Bool
Point v -> Point v -> Ordering
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
forall {v}. Ord v => Eq (Point v)
forall v. Ord v => Point v -> Point v -> Bool
forall v. Ord v => Point v -> Point v -> Ordering
forall v. Ord v => Point v -> Point v -> Point v
min :: Point v -> Point v -> Point v
$cmin :: forall v. Ord v => Point v -> Point v -> Point v
max :: Point v -> Point v -> Point v
$cmax :: forall v. Ord v => Point v -> Point v -> Point v
>= :: Point v -> Point v -> Bool
$c>= :: forall v. Ord v => Point v -> Point v -> Bool
> :: Point v -> Point v -> Bool
$c> :: forall v. Ord v => Point v -> Point v -> Bool
<= :: Point v -> Point v -> Bool
$c<= :: forall v. Ord v => Point v -> Point v -> Bool
< :: Point v -> Point v -> Bool
$c< :: forall v. Ord v => Point v -> Point v -> Bool
compare :: Point v -> Point v -> Ordering
$ccompare :: forall v. Ord v => Point v -> Point v -> Ordering
Ord, Int -> Point v -> ShowS
forall v. Show v => Int -> Point v -> ShowS
forall v. Show v => [Point v] -> ShowS
forall v. Show v => Point v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Point v] -> ShowS
$cshowList :: forall v. Show v => [Point v] -> ShowS
show :: Point v -> String
$cshow :: forall v. Show v => Point v -> String
showsPrec :: Int -> Point v -> ShowS
$cshowsPrec :: forall v. Show v => Int -> Point v -> ShowS
Show)
  deriving newtype (Point v -> ()
forall v. NFData v => Point v -> ()
forall a. (a -> ()) -> NFData a
rnf :: Point v -> ()
$crnf :: forall v. NFData v => Point v -> ()
NFData, Integer -> Point v
Point v -> Point v
Point v -> Point v -> Point v
forall v. Num v => Integer -> Point v
forall v. Num v => Point v -> Point v
forall v. Num v => Point v -> Point v -> Point v
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Point v
$cfromInteger :: forall v. Num v => Integer -> Point v
signum :: Point v -> Point v
$csignum :: forall v. Num v => Point v -> Point v
abs :: Point v -> Point v
$cabs :: forall v. Num v => Point v -> Point v
negate :: Point v -> Point v
$cnegate :: forall v. Num v => Point v -> Point v
* :: Point v -> Point v -> Point v
$c* :: forall v. Num v => Point v -> Point v -> Point v
- :: Point v -> Point v -> Point v
$c- :: forall v. Num v => Point v -> Point v -> Point v
+ :: Point v -> Point v -> Point v
$c+ :: forall v. Num v => Point v -> Point v -> Point v
Num, Rational -> Point v
Point v -> Point v
Point v -> Point v -> Point v
forall {v}. Fractional v => Num (Point v)
forall v. Fractional v => Rational -> Point v
forall v. Fractional v => Point v -> Point v
forall v. Fractional v => Point v -> Point v -> Point v
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Point v
$cfromRational :: forall v. Fractional v => Rational -> Point v
recip :: Point v -> Point v
$crecip :: forall v. Fractional v => Point v -> Point v
/ :: Point v -> Point v -> Point v
$c/ :: forall v. Fractional v => Point v -> Point v -> Point v
Fractional, (Element (Point v) -> Element (Point v)) -> Point v -> Point v
forall v.
MonoFunctor v =>
(Element (Point v) -> Element (Point v)) -> Point v -> Point v
forall mono.
((Element mono -> Element mono) -> mono -> mono)
-> MonoFunctor mono
omap :: (Element (Point v) -> Element (Point v)) -> Point v -> Point v
$comap :: forall v.
MonoFunctor v =>
(Element (Point v) -> Element (Point v)) -> Point v -> Point v
MonoFunctor, Element (Point v) -> Point v
forall v. MonoPointed v => Element (Point v) -> Point v
forall mono. (Element mono -> mono) -> MonoPointed mono
opoint :: Element (Point v) -> Point v
$copoint :: forall v. MonoPointed v => Element (Point v) -> Point v
MonoPointed, Element (Point v) -> Point v
(Element (Point v) -> Element (Point v)) -> Point v -> Point v
(Element (Point v) -> Element (Point v) -> Element (Point v))
-> Point v -> Point v -> Point v
(Element (Point v)
 -> Element (Point v) -> Element (Point v) -> Element (Point v))
-> Point v -> Point v -> Point v -> Point v
(Element (Point v)
 -> Element (Point v)
 -> Element (Point v)
 -> Element (Point v)
 -> Element (Point v))
-> Point v -> Point v -> Point v -> Point v -> Point v
(Element (Point v)
 -> Element (Point v)
 -> Element (Point v)
 -> Element (Point v)
 -> Element (Point v)
 -> Element (Point v))
-> Point v -> Point v -> Point v -> Point v -> Point v -> Point v
forall v. Elementwise v => Element (Point v) -> Point v
forall v.
Elementwise v =>
(Element (Point v) -> Element (Point v)) -> Point v -> Point v
forall v.
Elementwise v =>
(Element (Point v) -> Element (Point v) -> Element (Point v))
-> Point v -> Point v -> Point v
forall v.
Elementwise v =>
(Element (Point v)
 -> Element (Point v) -> Element (Point v) -> Element (Point v))
-> Point v -> Point v -> Point v -> Point v
forall v.
Elementwise v =>
(Element (Point v)
 -> Element (Point v)
 -> Element (Point v)
 -> Element (Point v)
 -> Element (Point v))
-> Point v -> Point v -> Point v -> Point v -> Point v
forall v.
Elementwise v =>
(Element (Point v)
 -> Element (Point v)
 -> Element (Point v)
 -> Element (Point v)
 -> Element (Point v)
 -> Element (Point v))
-> Point v -> Point v -> Point v -> Point v -> Point v -> Point v
forall a.
(Element a -> a)
-> ((Element a -> Element a) -> a -> a)
-> ((Element a -> Element a -> Element a) -> a -> a -> a)
-> ((Element a -> Element a -> Element a -> Element a)
    -> a -> a -> a -> a)
-> ((Element a -> Element a -> Element a -> Element a -> Element a)
    -> a -> a -> a -> a -> a)
-> ((Element a
     -> Element a -> Element a -> Element a -> Element a -> Element a)
    -> a -> a -> a -> a -> a -> a)
-> Elementwise a
emap5 :: (Element (Point v)
 -> Element (Point v)
 -> Element (Point v)
 -> Element (Point v)
 -> Element (Point v)
 -> Element (Point v))
-> Point v -> Point v -> Point v -> Point v -> Point v -> Point v
$cemap5 :: forall v.
Elementwise v =>
(Element (Point v)
 -> Element (Point v)
 -> Element (Point v)
 -> Element (Point v)
 -> Element (Point v)
 -> Element (Point v))
-> Point v -> Point v -> Point v -> Point v -> Point v -> Point v
emap4 :: (Element (Point v)
 -> Element (Point v)
 -> Element (Point v)
 -> Element (Point v)
 -> Element (Point v))
-> Point v -> Point v -> Point v -> Point v -> Point v
$cemap4 :: forall v.
Elementwise v =>
(Element (Point v)
 -> Element (Point v)
 -> Element (Point v)
 -> Element (Point v)
 -> Element (Point v))
-> Point v -> Point v -> Point v -> Point v -> Point v
emap3 :: (Element (Point v)
 -> Element (Point v) -> Element (Point v) -> Element (Point v))
-> Point v -> Point v -> Point v -> Point v
$cemap3 :: forall v.
Elementwise v =>
(Element (Point v)
 -> Element (Point v) -> Element (Point v) -> Element (Point v))
-> Point v -> Point v -> Point v -> Point v
emap2 :: (Element (Point v) -> Element (Point v) -> Element (Point v))
-> Point v -> Point v -> Point v
$cemap2 :: forall v.
Elementwise v =>
(Element (Point v) -> Element (Point v) -> Element (Point v))
-> Point v -> Point v -> Point v
emap :: (Element (Point v) -> Element (Point v)) -> Point v -> Point v
$cemap :: forall v.
Elementwise v =>
(Element (Point v) -> Element (Point v)) -> Point v -> Point v
epoint :: Element (Point v) -> Point v
$cepoint :: forall v. Elementwise v => Element (Point v) -> Point v
Elementwise, Ptr (Point v) -> IO (Point v)
Ptr (Point v) -> Int -> IO (Point v)
Ptr (Point v) -> Int -> Point v -> IO ()
Ptr (Point v) -> Point v -> IO ()
Point v -> Int
forall b. Ptr b -> Int -> IO (Point v)
forall b. Ptr b -> Int -> Point v -> IO ()
forall v. Storable v => Ptr (Point v) -> IO (Point v)
forall v. Storable v => Ptr (Point v) -> Int -> IO (Point v)
forall v. Storable v => Ptr (Point v) -> Int -> Point v -> IO ()
forall v. Storable v => Ptr (Point v) -> Point v -> IO ()
forall v. Storable v => Point v -> Int
forall v b. Storable v => Ptr b -> Int -> IO (Point v)
forall v b. Storable v => Ptr b -> Int -> Point v -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr (Point v) -> Point v -> IO ()
$cpoke :: forall v. Storable v => Ptr (Point v) -> Point v -> IO ()
peek :: Ptr (Point v) -> IO (Point v)
$cpeek :: forall v. Storable v => Ptr (Point v) -> IO (Point v)
pokeByteOff :: forall b. Ptr b -> Int -> Point v -> IO ()
$cpokeByteOff :: forall v b. Storable v => Ptr b -> Int -> Point v -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO (Point v)
$cpeekByteOff :: forall v b. Storable v => Ptr b -> Int -> IO (Point v)
pokeElemOff :: Ptr (Point v) -> Int -> Point v -> IO ()
$cpokeElemOff :: forall v. Storable v => Ptr (Point v) -> Int -> Point v -> IO ()
peekElemOff :: Ptr (Point v) -> Int -> IO (Point v)
$cpeekElemOff :: forall v. Storable v => Ptr (Point v) -> Int -> IO (Point v)
alignment :: Point v -> Int
$calignment :: forall v. Storable v => Point v -> Int
sizeOf :: Point v -> Int
$csizeOf :: forall v. Storable v => Point v -> Int
Storable)

type instance Element (Point v) = Element v

type Point2 = Point Vec2
type Point3 = Point Vec3
type Point3P = Point Packed
type Point4 = Point Vec4

instance VectorSpace v Float => AffineSpace (Point v) v Float where
  origin :: Point v
origin = forall v. v -> Point v
Point forall v a. VectorSpace v a => v
zeroVector

  {-# INLINE (.+^) #-}
  Point v
p .+^ :: Point v -> v -> Point v
.+^ v
v = forall v. v -> Point v
Point (v
p forall v a. VectorSpace v a => v -> v -> v
^+^ v
v)

  {-# INLINE (.-^) #-}
  Point v
p .-^ :: Point v -> v -> Point v
.-^ v
v = forall v. v -> Point v
Point (v
p forall v a. VectorSpace v a => v -> v -> v
^-^ v
v)

  {-# INLINE (.-.) #-}
  Point v
a .-. :: Point v -> Point v -> v
.-. Point v
b = v
a forall v a. VectorSpace v a => v -> v -> v
^-^ v
b

{-# INLINE qd #-}
qd :: VectorSpace v Float => Point v -> Point v -> Float
qd :: forall v. VectorSpace v Float => Point v -> Point v -> Float
qd Point v
a Point v
b = forall v a. VectorSpace v a => v -> a
Vector.quadrance (Point v
a forall p v a. AffineSpace p v a => p -> p -> v
AffineSpace..-. Point v
b)

{-# INLINE distance #-}
distance :: VectorSpace v Float => Point v -> Point v -> Float
distance :: forall v. VectorSpace v Float => Point v -> Point v -> Float
distance Point v
a Point v
b = forall a. Floating a => a -> a
sqrt (forall v. VectorSpace v Float => Point v -> Point v -> Float
qd Point v
a Point v
b)

{-# INLINE lerp #-}
lerp :: VectorSpace v Float => Point v -> Point v -> Float -> Point v
lerp :: forall v.
VectorSpace v Float =>
Point v -> Point v -> Float -> Point v
lerp (Point v
a) (Point v
b) = forall v. v -> Point v
Point forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v a. (VectorSpace v a, Num a) => v -> v -> a -> v
Vector.lerp v
a v
b