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

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 GHC.Ix (Ix)
import GHC.TypeNats (KnownNat)
import qualified Data.AffineSpace as AffineSpace

import Geomancy.Elementwise (Elementwise(..))
import Graphics.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 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, Point v) -> Int
(Point v, Point v) -> [Point v]
(Point v, Point v) -> Point v -> Bool
(Point v, Point v) -> Point v -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
forall {v}. Ix v => Ord (Point v)
forall v. Ix v => (Point v, Point v) -> Int
forall v. Ix v => (Point v, Point v) -> [Point v]
forall v. Ix v => (Point v, Point v) -> Point v -> Bool
forall v. Ix v => (Point v, Point v) -> Point v -> Int
unsafeRangeSize :: (Point v, Point v) -> Int
$cunsafeRangeSize :: forall v. Ix v => (Point v, Point v) -> Int
rangeSize :: (Point v, Point v) -> Int
$crangeSize :: forall v. Ix v => (Point v, Point v) -> Int
inRange :: (Point v, Point v) -> Point v -> Bool
$cinRange :: forall v. Ix v => (Point v, Point v) -> Point v -> Bool
unsafeIndex :: (Point v, Point v) -> Point v -> Int
$cunsafeIndex :: forall v. Ix v => (Point v, Point v) -> Point v -> Int
index :: (Point v, Point v) -> Point v -> Int
$cindex :: forall v. Ix v => (Point v, Point v) -> Point v -> Int
range :: (Point v, Point v) -> [Point v]
$crange :: forall v. Ix v => (Point v, Point v) -> [Point v]
Ix, 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)

deriving anyclass instance
  ( KnownNat (PackedSize v)
  , Block v
  ) => Block (Point v)

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