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
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)
toTuple :: Vec -> (Float, Float)
toTuple :: Vec -> (Float, Float)
toTuple (Vec Float
x Float
y) = (Float
x, Float
y)
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)
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
(/)
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
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
e :: Float -> Vec
e :: Float -> Vec
e = Float -> Vec
unitVecAtAngle
{-# INLINE e #-}