module Gamgine.Math.Matrix (
   module Data.Vec,
   Matrix,
   Window,
   Frustum(..),
   mkOrtho,
   mkScale,
   mkTranslate,
   mkWindowMatrix,
   mkWorldToWinMatrix,
   mkWinToWorldMatrix,
   winToWorld,
   inverseOrIdentity) where

import Data.Vec
import Gamgine.Math.Vect

-- row major matrix
type Matrix = Mat44 Double

type Width  = Int
type Height = Int
type Window = (Width, Height)

type X        = Int
type Y        = Int
type WinCoord = (X, Y)

data Frustum = Frustum {
   Frustum -> Double
left   :: Double,
   Frustum -> Double
right  :: Double,
   Frustum -> Double
bottom :: Double,
   Frustum -> Double
top    :: Double,
   Frustum -> Double
near   :: Double,
   Frustum -> Double
far    :: Double
   } deriving (Int -> Frustum -> ShowS
[Frustum] -> ShowS
Frustum -> String
(Int -> Frustum -> ShowS)
-> (Frustum -> String) -> ([Frustum] -> ShowS) -> Show Frustum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Frustum -> ShowS
showsPrec :: Int -> Frustum -> ShowS
$cshow :: Frustum -> String
show :: Frustum -> String
$cshowList :: [Frustum] -> ShowS
showList :: [Frustum] -> ShowS
Show, Frustum -> Frustum -> Bool
(Frustum -> Frustum -> Bool)
-> (Frustum -> Frustum -> Bool) -> Eq Frustum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Frustum -> Frustum -> Bool
== :: Frustum -> Frustum -> Bool
$c/= :: Frustum -> Frustum -> Bool
/= :: Frustum -> Frustum -> Bool
Eq)


mkOrtho :: Frustum -> Matrix
mkOrtho :: Frustum -> Matrix
mkOrtho Frustum {left :: Frustum -> Double
left = Double
l, right :: Frustum -> Double
right = Double
r, bottom :: Frustum -> Double
bottom = Double
b, top :: Frustum -> Double
top = Double
t, near :: Frustum -> Double
near = Double
n, far :: Frustum -> Double
far = Double
f} =
   [Double] -> Matrix
forall i j v m a.
(Vec i v m, Vec j a v, Nat i, VecList a v, VecList v m) =>
[a] -> m
matFromList [Double
2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
rml,       Double
0,       Double
0, -(Double
rpl Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
rml),
                Double
0      , Double
2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
tmb,       Double
0, -(Double
tpb Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
tmb),
                Double
0      ,       Double
0, Double
2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
fmn, -(Double
fpn Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
fmn),
                Double
0      ,       Double
0,       Double
0,            Double
1]
   where
      rml :: Double
rml = Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
l
      rpl :: Double
rpl = Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
l
      tmb :: Double
tmb = Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
b
      tpb :: Double
tpb = Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
b
      fmn :: Double
fmn = Double
f Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
n
      fpn :: Double
fpn = Double
f Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
n


mkScale :: Vect -> Matrix
mkScale :: Vect -> Matrix
mkScale Vect
v = Vect4 -> Matrix -> Matrix
forall m r n a.
(GetDiagonal' N0 () m r, Num r, Vec n a r, Vec n r m,
 SetDiagonal' N0 r m) =>
r -> m -> m
scale (Vect -> Double -> Vect4
forall v a v'. Snoc v a v' => v -> a -> v'
snoc Vect
v Double
1) Matrix
forall n a v m.
(Vec n a v, Vec n v m, Num v, Num m, SetDiagonal v m) =>
m
identity


mkTranslate :: Vect -> Matrix
mkTranslate :: Vect -> Matrix
mkTranslate Vect
v = Vect -> Matrix -> Matrix
forall m mt v' t v'1 a v.
(Transpose m mt, Reverse' () mt (v' :. t),
 Reverse' (v' :. ()) t v'1, Transpose v'1 m, Num v', Num a,
 Snoc v a v') =>
v -> m -> m
translate Vect
v Matrix
forall n a v m.
(Vec n a v, Vec n v m, Num v, Num m, SetDiagonal v m) =>
m
identity


mkWindowMatrix :: Window -> Matrix
mkWindowMatrix :: Window -> Matrix
mkWindowMatrix (Int
width, Int
height) = Double -> Matrix
toGLFW Double
dHeight Matrix -> Matrix -> Matrix
forall v v' m1 m3 a b m2.
(Map v v' m1 m3, Map v a b v', Transpose m2 b, Fold v a,
 ZipWith a a a v v v, Num v, Num a) =>
m1 -> m2 -> m3
`multmm` Double -> Double -> Matrix
unitCubeToWin Double
dWidth Double
dHeight
   where
      unitCubeToWin :: Double -> Double -> Matrix
      unitCubeToWin :: Double -> Double -> Matrix
unitCubeToWin Double
width Double
height =
         Vect -> Matrix
mkScale (Double -> Double -> Double -> Vect
v3 (Double
widthDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
0.5) (Double
heightDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
0.5) Double
0.5) Matrix -> Matrix -> Matrix
forall v v' m1 m3 a b m2.
(Map v v' m1 m3, Map v a b v', Transpose m2 b, Fold v a,
 ZipWith a a a v v v, Num v, Num a) =>
m1 -> m2 -> m3
`multmm` Vect -> Matrix
mkTranslate (Double -> Double -> Double -> Vect
v3 Double
1 Double
1 Double
1)

      toGLFW :: Double -> Matrix
      toGLFW :: Double -> Matrix
toGLFW Double
height = Vect -> Matrix
mkTranslate (Double -> Double -> Double -> Vect
v3 Double
0 Double
height Double
0) Matrix -> Matrix -> Matrix
forall v v' m1 m3 a b m2.
(Map v v' m1 m3, Map v a b v', Transpose m2 b, Fold v a,
 ZipWith a a a v v v, Num v, Num a) =>
m1 -> m2 -> m3
`multmm` Vect -> Matrix
mkScale (Double -> Double -> Double -> Vect
v3 Double
1 (-Double
1) Double
1)

      dWidth :: Double
dWidth  = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width
      dHeight :: Double
dHeight = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height


mkWorldToWinMatrix :: Window -> Frustum -> Matrix
mkWorldToWinMatrix :: Window -> Frustum -> Matrix
mkWorldToWinMatrix Window
win Frustum
frust = Window -> Matrix
mkWindowMatrix Window
win Matrix -> Matrix -> Matrix
forall v v' m1 m3 a b m2.
(Map v v' m1 m3, Map v a b v', Transpose m2 b, Fold v a,
 ZipWith a a a v v v, Num v, Num a) =>
m1 -> m2 -> m3
`multmm` Frustum -> Matrix
mkOrtho Frustum
frust


mkWinToWorldMatrix :: Window -> Frustum -> Matrix
mkWinToWorldMatrix :: Window -> Frustum -> Matrix
mkWinToWorldMatrix Window
win Frustum
frust = Matrix -> Matrix
inverseOrIdentity (Matrix -> Matrix) -> Matrix -> Matrix
forall a b. (a -> b) -> a -> b
$ Window -> Frustum -> Matrix
mkWorldToWinMatrix Window
win Frustum
frust


inverseOrIdentity :: Matrix -> Matrix
inverseOrIdentity :: Matrix -> Matrix
inverseOrIdentity Matrix
m =
   case Matrix -> Maybe Matrix
forall n a r m r' m'.
(Num r, Num m, Vec n a r, Vec n r m, Append r r r',
 ZipWith r r r' m m m', Drop n r' r, Map r' r m' m, SetDiagonal r m,
 GaussElim a m', BackSubstitute m') =>
m -> Maybe m
invert Matrix
m of
        Maybe Matrix
Nothing -> Matrix
forall n a v m.
(Vec n a v, Vec n v m, Num v, Num m, SetDiagonal v m) =>
m
identity
        Just Matrix
m  -> Matrix
m


winToWorld :: Matrix -> WinCoord -> Vect
winToWorld :: Matrix -> Window -> Vect
winToWorld Matrix
winToWorldMatrix (Int
x, Int
y) = Vect4 -> Vect
fromVect4 (Vect4 -> Vect) -> Vect4 -> Vect
forall a b. (a -> b) -> a -> b
$ Matrix
winToWorldMatrix Matrix -> Vect4 -> Vect4
forall v a m v'.
(Map v a m v', Num v, Fold v a, ZipWith a a a v v v, Num a) =>
m -> v -> v'
`multmv` Vect4
posVec
   where
      posVec :: Vect4
posVec = Double -> Double -> Double -> Double -> Vect4
v4 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) Double
0 Double
1