module LC_G_Type where

import GHC.TypeLits

import Data.Int
import Data.Word
import Foreign.Storable
import Foreign.Ptr

data V2 a = V2 !a !a deriving (Eq,Ord,Show)
data V3 a = V3 !a !a !a deriving (Eq,Ord,Show)
data V4 a = V4 !a !a !a !a deriving (Eq,Ord,Show)

-- matrices are stored in column major order
type M22F = V2 V2F
type M23F = V3 V2F
type M24F = V4 V2F
type M32F = V2 V3F
type M33F = V3 V3F
type M34F = V4 V3F
type M42F = V2 V4F
type M43F = V3 V4F
type M44F = V4 V4F

type V2F = V2 Float
type V3F = V3 Float
type V4F = V4 Float
type V2I = V2 Int32
type V3I = V3 Int32
type V4I = V4 Int32
type V2U = V2 Word32
type V3U = V3 Word32
type V4U = V4 Word32
type V2B = V2 Bool
type V3B = V3 Bool
type V4B = V4 Bool

-- vector types: V2, V3, V4
class IsVec (dim :: Nat) vec component | vec -> dim component, dim component -> vec
instance IsVec 2 (V2 Float) Float
instance IsVec 3 (V3 Float) Float
instance IsVec 4 (V4 Float) Float
instance IsVec 2 (V2 Int32) Int32
instance IsVec 3 (V3 Int32) Int32
instance IsVec 4 (V4 Int32) Int32
instance IsVec 2 (V2 Word32) Word32
instance IsVec 3 (V3 Word32) Word32
instance IsVec 4 (V4 Word32) Word32
instance IsVec 2 (V2 Bool) Bool
instance IsVec 3 (V3 Bool) Bool
instance IsVec 4 (V4 Bool) Bool

-- scalar and vector types: scalar, V2, V3, V4
class IsVecScalar (dim :: Nat) vec component | vec -> dim component, dim component -> vec
instance IsVecScalar 1 Float Float
instance IsVecScalar 2 (V2 Float) Float
instance IsVecScalar 3 (V3 Float) Float
instance IsVecScalar 4 (V4 Float) Float
instance IsVecScalar 1 Int32 Int32
instance IsVecScalar 2 (V2 Int32) Int32
instance IsVecScalar 3 (V3 Int32) Int32
instance IsVecScalar 4 (V4 Int32) Int32
instance IsVecScalar 1 Word32 Word32
instance IsVecScalar 2 (V2 Word32) Word32
instance IsVecScalar 3 (V3 Word32) Word32
instance IsVecScalar 4 (V4 Word32) Word32
instance IsVecScalar 1 Bool Bool
instance IsVecScalar 2 (V2 Bool) Bool
instance IsVecScalar 3 (V3 Bool) Bool
instance IsVecScalar 4 (V4 Bool) Bool

-- matrix types of dimension [2..4] x [2..4]
class IsMat mat h w | mat -> h w
instance IsMat M22F V2F V2F
instance IsMat M23F V2F V3F
instance IsMat M24F V2F V4F
instance IsMat M32F V3F V2F
instance IsMat M33F V3F V3F
instance IsMat M34F V3F V4F
instance IsMat M42F V4F V2F
instance IsMat M43F V4F V3F
instance IsMat M44F V4F V4F

-- matrix, vector and scalar types
class IsMatVecScalar a t | a -> t
instance IsMatVecScalar Float Float
instance IsMatVecScalar (V2 Float) Float
instance IsMatVecScalar (V3 Float) Float
instance IsMatVecScalar (V4 Float) Float
instance IsMatVecScalar Int32 Int32
instance IsMatVecScalar (V2 Int32) Int32
instance IsMatVecScalar (V3 Int32) Int32
instance IsMatVecScalar (V4 Int32) Int32
instance IsMatVecScalar Word32 Word32
instance IsMatVecScalar (V2 Word32) Word32
instance IsMatVecScalar (V3 Word32) Word32
instance IsMatVecScalar (V4 Word32) Word32
instance IsMatVecScalar Bool Bool
instance IsMatVecScalar (V2 Bool) Bool
instance IsMatVecScalar (V3 Bool) Bool
instance IsMatVecScalar (V4 Bool) Bool
instance IsMatVecScalar M22F Float
instance IsMatVecScalar M23F Float
instance IsMatVecScalar M24F Float
instance IsMatVecScalar M32F Float
instance IsMatVecScalar M33F Float
instance IsMatVecScalar M34F Float
instance IsMatVecScalar M42F Float
instance IsMatVecScalar M43F Float
instance IsMatVecScalar M44F Float

-- matrix and vector types
class IsMatVec a t | a -> t
instance IsMatVec (V2 Float) Float
instance IsMatVec (V3 Float) Float
instance IsMatVec (V4 Float) Float
instance IsMatVec (V2 Int32) Int32
instance IsMatVec (V3 Int32) Int32
instance IsMatVec (V4 Int32) Int32
instance IsMatVec (V2 Word32) Word32
instance IsMatVec (V3 Word32) Word32
instance IsMatVec (V4 Word32) Word32
instance IsMatVec (V2 Bool) Bool
instance IsMatVec (V3 Bool) Bool
instance IsMatVec (V4 Bool) Bool
instance IsMatVec M22F Float
instance IsMatVec M23F Float
instance IsMatVec M24F Float
instance IsMatVec M32F Float
instance IsMatVec M33F Float
instance IsMatVec M34F Float
instance IsMatVec M42F Float
instance IsMatVec M43F Float
instance IsMatVec M44F Float

-- matrix or vector component type
class IsComponent a
instance IsComponent Float
instance IsComponent Int32
instance IsComponent Word32
instance IsComponent Bool
instance IsComponent V2F
instance IsComponent V3F
instance IsComponent V4F

-- matrix or vector number component type
class IsNumComponent a
instance IsNumComponent Float
instance IsNumComponent Int32
instance IsNumComponent Word32
instance IsNumComponent V2F
instance IsNumComponent V3F
instance IsNumComponent V4F

class IsSigned a
instance IsSigned Float
instance IsSigned Int

class Real a => IsNum a
instance IsNum Float
instance IsNum Int32
instance IsNum Word32

class IsIntegral a
instance IsIntegral Int32
instance IsIntegral Word32

class IsFloating a
instance IsFloating Float
instance IsFloating V2F
instance IsFloating V3F
instance IsFloating V4F
instance IsFloating M22F
instance IsFloating M23F
instance IsFloating M24F
instance IsFloating M32F
instance IsFloating M33F
instance IsFloating M34F
instance IsFloating M42F
instance IsFloating M43F
instance IsFloating M44F


-- storable instances
instance Storable a => Storable (V2 a) where
    sizeOf    _ = 2 * sizeOf (undefined :: a)
    alignment _ = sizeOf (undefined :: a)

    peek q = do
        let p = castPtr q :: Ptr a
            k = sizeOf (undefined :: a)
        x <- peek        p 
        y <- peekByteOff p k
        return $! (V2 x y)

    poke q (V2 x y) = do
        let p = castPtr q :: Ptr a
            k = sizeOf (undefined :: a)
        poke        p   x
        pokeByteOff p k y

instance Storable a => Storable (V3 a) where
    sizeOf    _ = 3 * sizeOf (undefined :: a)
    alignment _ = sizeOf (undefined :: a)

    peek q = do
        let p = castPtr q :: Ptr a
            k = sizeOf (undefined :: a)
        x <- peek        p 
        y <- peekByteOff p k
        z <- peekByteOff p (k*2)
        return $! (V3 x y z)

    poke q (V3 x y z) = do
        let p = castPtr q :: Ptr a
            k = sizeOf (undefined :: a)
        poke        p   x
        pokeByteOff p k y
        pokeByteOff p (k*2) z

instance Storable a => Storable (V4 a) where
    sizeOf    _ = 4 * sizeOf (undefined :: a)
    alignment _ = sizeOf (undefined :: a)

    peek q = do
        let p = castPtr q :: Ptr a
            k = sizeOf (undefined :: a)
        x <- peek        p 
        y <- peekByteOff p k
        z <- peekByteOff p (k*2)
        w <- peekByteOff p (k*3)
        return $! (V4 x y z w)

    poke q (V4 x y z w) = do
        let p = castPtr q :: Ptr a
            k = sizeOf (undefined :: a)
        poke        p   x
        pokeByteOff p k y
        pokeByteOff p (k*2) z
        pokeByteOff p (k*3) w