module Dyna.Gloss.Data.Vec(
    Vec(..)
  , magV
  , argV
  , dotV
  , detV
  , mulSV
  , rotateV
  , angleVV
  , normalizeV
  , unitVecAtAngle
  , e
  , VecBasis(..)
  , fromTuple
  , toTuple
  ) where

import Graphics.Gloss.Geometry.Angle
import Dyna (BasisArity(..))
import Data.AdditiveGroup
import Data.AffineSpace
import Data.Basis
import Data.Cross
import Data.VectorSpace

-- | Pair of unboxed floats. All operations on vectors are strict
-- which is more suitable for computation intensive domains such as computer graphics.
data Vec = Vec
  { Vec -> Float
vec'x :: {-# UNPACK #-} !Float
  , Vec -> Float
vec'y :: {-# UNPACK #-} !Float
  }
  deriving (Int -> Vec -> ShowS
[Vec] -> ShowS
Vec -> String
(Int -> Vec -> ShowS)
-> (Vec -> String) -> ([Vec] -> ShowS) -> Show Vec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vec] -> ShowS
$cshowList :: [Vec] -> ShowS
show :: Vec -> String
$cshow :: Vec -> String
showsPrec :: Int -> Vec -> ShowS
$cshowsPrec :: Int -> Vec -> ShowS
Show, Vec -> Vec -> Bool
(Vec -> Vec -> Bool) -> (Vec -> Vec -> Bool) -> Eq Vec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vec -> Vec -> Bool
$c/= :: Vec -> Vec -> Bool
== :: Vec -> Vec -> Bool
$c== :: Vec -> Vec -> Bool
Eq, Eq Vec
Eq Vec
-> (Vec -> Vec -> Ordering)
-> (Vec -> Vec -> Bool)
-> (Vec -> Vec -> Bool)
-> (Vec -> Vec -> Bool)
-> (Vec -> Vec -> Bool)
-> (Vec -> Vec -> Vec)
-> (Vec -> Vec -> Vec)
-> Ord Vec
Vec -> Vec -> Bool
Vec -> Vec -> Ordering
Vec -> Vec -> Vec
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 :: Vec -> Vec -> Vec
$cmin :: Vec -> Vec -> Vec
max :: Vec -> Vec -> Vec
$cmax :: Vec -> Vec -> Vec
>= :: Vec -> Vec -> Bool
$c>= :: Vec -> Vec -> Bool
> :: Vec -> Vec -> Bool
$c> :: Vec -> Vec -> Bool
<= :: Vec -> Vec -> Bool
$c<= :: Vec -> Vec -> Bool
< :: Vec -> Vec -> Bool
$c< :: Vec -> Vec -> Bool
compare :: Vec -> Vec -> Ordering
$ccompare :: Vec -> Vec -> Ordering
$cp1Ord :: Eq Vec
Ord)

-- | Converts vector to tuple of Floats
toTuple :: Vec -> (Float, Float)
toTuple :: Vec -> (Float, Float)
toTuple (Vec Float
x Float
y) = (Float
x, Float
y)

-- | Converts tuple of floats to vector
fromTuple :: (Float, Float) -> Vec
fromTuple :: (Float, Float) -> Vec
fromTuple (Float
x, Float
y) = Float -> Float -> Vec
Vec Float
x Float
y

lift0 :: Float -> Vec
lift0 :: Float -> Vec
lift0 Float
a = Float -> Float -> Vec
Vec Float
a Float
a

lift1 :: (Float -> Float) -> Vec -> Vec
lift1 :: (Float -> Float) -> Vec -> Vec
lift1 Float -> Float
f (Vec Float
a Float
b) = Float -> Float -> Vec
Vec (Float -> Float
f Float
a) (Float -> Float
f Float
b)

lift2 :: (Float -> Float -> Float) -> Vec -> Vec -> Vec
lift2 :: (Float -> Float -> Float) -> Vec -> Vec -> Vec
lift2 Float -> Float -> Float
f (Vec Float
a1 Float
b1) (Vec Float
a2 Float
b2) = Float -> Float -> Vec
Vec (Float -> Float -> Float
f Float
a1 Float
a2) (Float -> Float -> Float
f Float
b1 Float
b2)

-- numeric instances

instance Num Vec where
  fromInteger :: Integer -> Vec
fromInteger = Float -> Vec
lift0 (Float -> Vec) -> (Integer -> Float) -> Integer -> Vec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Float
forall a. Num a => Integer -> a
fromInteger
  + :: Vec -> Vec -> Vec
(+) = (Float -> Float -> Float) -> Vec -> Vec -> Vec
lift2 Float -> Float -> Float
forall a. Num a => a -> a -> a
(+)
  * :: Vec -> Vec -> Vec
(*) = (Float -> Float -> Float) -> Vec -> Vec -> Vec
lift2 Float -> Float -> Float
forall a. Num a => a -> a -> a
(*)
  (-) = (Float -> Float -> Float) -> Vec -> Vec -> Vec
lift2 (-)
  negate :: Vec -> Vec
negate = (Float -> Float) -> Vec -> Vec
lift1 Float -> Float
forall a. Num a => a -> a
negate
  abs :: Vec -> Vec
abs = (Float -> Float) -> Vec -> Vec
lift1 Float -> Float
forall a. Num a => a -> a
abs
  signum :: Vec -> Vec
signum = (Float -> Float) -> Vec -> Vec
lift1 Float -> Float
forall a. Num a => a -> a
signum

instance Fractional Vec where
  fromRational :: Rational -> Vec
fromRational = Float -> Vec
lift0 (Float -> Vec) -> (Rational -> Float) -> Rational -> Vec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Float
forall a. Fractional a => Rational -> a
fromRational
  recip :: Vec -> Vec
recip = (Float -> Float) -> Vec -> Vec
lift1 Float -> Float
forall a. Fractional a => a -> a
recip
  / :: Vec -> Vec -> Vec
(/) = (Float -> Float -> Float) -> Vec -> Vec -> Vec
lift2 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
(/)

-- vector space instances

instance AdditiveGroup Vec where
  zeroV :: Vec
zeroV = Float -> Vec
lift0 Float
forall v. AdditiveGroup v => v
zeroV
  ^+^ :: Vec -> Vec -> Vec
(^+^) = (Float -> Float -> Float) -> Vec -> Vec -> Vec
lift2 Float -> Float -> Float
forall v. AdditiveGroup v => v -> v -> v
(^+^)
  ^-^ :: Vec -> Vec -> Vec
(^-^) = (Float -> Float -> Float) -> Vec -> Vec -> Vec
lift2 Float -> Float -> Float
forall v. AdditiveGroup v => v -> v -> v
(^-^)
  negateV :: Vec -> Vec
negateV = (Float -> Float) -> Vec -> Vec
lift1 Float -> Float
forall v. AdditiveGroup v => v -> v
negateV

instance VectorSpace Vec where
  type Scalar Vec = Float
  *^ :: Scalar Vec -> Vec -> Vec
(*^) Scalar Vec
k = (Float -> Float) -> Vec -> Vec
lift1 (Scalar Float
Scalar Vec
k Scalar Float -> Float -> Float
forall v. VectorSpace v => Scalar v -> v -> v
*^)

instance AffineSpace Vec where
  type Diff Vec = Vec
  .-. :: Vec -> Vec -> Diff Vec
(.-.) = (Float -> Float -> Float) -> Vec -> Vec -> Vec
lift2 Float -> Float -> Float
forall p. AffineSpace p => p -> p -> Diff p
(.-.)
  .+^ :: Vec -> Diff Vec -> Vec
(.+^) = (Float -> Float -> Float) -> Vec -> Vec -> Vec
lift2 Float -> Float -> Float
forall p. AffineSpace p => p -> Diff p -> p
(.+^)

instance BasisArity Vec where
  basisArity :: Vec -> Int
basisArity Vec
_ = Int
2

data VecBasis = VecX | VecY

instance HasBasis Vec where
  type Basis Vec = VecBasis
  basisValue :: Basis Vec -> Vec
basisValue = \case
    Basis Vec
VecX -> Float -> Float -> Vec
Vec Float
1 Float
0
    Basis Vec
VecY -> Float -> Float -> Vec
Vec Float
0 Float
1

  decompose :: Vec -> [(Basis Vec, Scalar Vec)]
decompose (Vec Float
x Float
y) = [(Basis Vec
VecBasis
VecX, Float
Scalar Vec
x), (Basis Vec
VecBasis
VecY, Float
Scalar Vec
y)]

  decompose' :: Vec -> Basis Vec -> Scalar Vec
decompose' (Vec Float
x Float
y) = \case
    Basis Vec
VecX -> Float
Scalar Vec
x
    Basis Vec
VecY -> Float
Scalar Vec
y

instance HasNormal Vec where
  normalVec :: Vec -> Vec
normalVec = Vec -> Vec
normalizeV

instance HasCross2 Vec where
  cross2 :: Vec -> Vec
cross2 (Vec Float
x Float
y) = Float -> Float -> Vec
Vec (Float -> Float
forall a. Num a => a -> a
negate Float
y) Float
x -- or @(y,-x)@?

-------------------------------------------------------------------
-- gloss functions on Vectors

-- | Normalise a vector, so it has a magnitude of 1.
normalizeV :: Vec -> Vec
normalizeV :: Vec -> Vec
normalizeV Vec
v = (Float -> Float) -> Vec -> Vec
lift1 ((Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Vec -> Float
magV Vec
v) Float -> Float -> Float
forall a. Num a => a -> a -> a
* ) Vec
v
{-# INLINE normalizeV #-}

-- | The magnitude of a vector.
magV :: Vec -> Float
magV :: Vec -> Float
magV (Vec Float
x Float
y) = Float -> Float
forall a. Floating a => a -> a
sqrt (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
y)
{-# INLINE magV #-}

-- | The angle of this vector, relative to the +ve x-axis.
argV :: Vec -> Float
argV :: Vec -> Float
argV (Vec Float
x Float
y) = Float -> Float
normalizeAngle (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float
forall a. RealFloat a => a -> a -> a
atan2 Float
y Float
x
{-# INLINE argV #-}

-- | The dot product of two vectors.
dotV :: Vec -> Vec -> Float
dotV :: Vec -> Vec -> Float
dotV (Vec Float
x1 Float
x2) (Vec Float
y1 Float
y2) = Float
x1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
y1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
x2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
y2
{-# INLINE dotV #-}

-- | The determinant of two vectors.
detV :: Vec -> Vec -> Float
detV :: Vec -> Vec -> Float
detV (Vec Float
x1 Float
y1) (Vec Float
x2 Float
y2) = Float
x1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
y2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x2
{-# INLINE detV #-}

-- | Multiply a vector by a scalar.
mulSV :: Float -> Vec -> Vec
mulSV :: Float -> Vec -> Vec
mulSV Float
s (Vec Float
x Float
y) = Float -> Float -> Vec
Vec (Float
s Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x) (Float
s Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
y)
{-# INLINE mulSV #-}

-- | Rotate a vector by an angle (in radians). +ve angle is counter-clockwise.
rotateV :: Float -> Vec -> Vec
rotateV :: Float -> Vec -> Vec
rotateV Float
r (Vec Float
x Float
y)
 = Float -> Float -> Vec
Vec (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float
forall a. Floating a => a -> a
cos Float
r Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float
forall a. Floating a => a -> a
sin Float
r)
       (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float
forall a. Floating a => a -> a
sin Float
r Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float
forall a. Floating a => a -> a
cos Float
r)
{-# INLINE rotateV #-}

-- | Compute the inner angle (in radians) between two vectors.
angleVV :: Vec -> Vec -> Float
angleVV :: Vec -> Vec -> Float
angleVV Vec
p1 Vec
p2
 = let  m1 :: Float
m1      = Vec -> Float
magV Vec
p1
        m2 :: Float
m2      = Vec -> Float
magV Vec
p2
        d :: Float
d       = Vec
p1 Vec -> Vec -> Float
`dotV` Vec
p2
        aDiff :: Float
aDiff   = Float -> Float
forall a. Floating a => a -> a
acos (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
d Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
m1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
m2)

   in   Float
aDiff
{-# INLINE angleVV #-}

-- | Produce a unit vector at a given angle relative to the +ve x-axis.
--      The provided angle is in radians.
unitVecAtAngle :: Float -> Vec
unitVecAtAngle :: Float -> Vec
unitVecAtAngle Float
r = Float -> Float -> Vec
Vec (Float -> Float
forall a. Floating a => a -> a
cos Float
r) (Float -> Float
forall a. Floating a => a -> a
sin Float
r)
{-# INLINE unitVecAtAngle #-}

-- | Shortcut for @unitVecAtAngle@
e :: Float -> Vec
e :: Float -> Vec
e = Float -> Vec
unitVecAtAngle
{-# INLINE e #-}