module LambdaCube.GL.Type where
import Data.ByteString.Char8 (ByteString)
import Data.IORef
import Data.Word
import Data.Map (Map)
import Data.Set (Set)
import Data.Trie (Trie)
import Data.Vector.Unboxed.Mutable (IOVector)
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed.Mutable as MV
import Graphics.Rendering.OpenGL.Raw.Core32 (GLint, GLuint)
import Foreign.Storable
import Foreign.Ptr
import Data.Int
import Data.Typeable
import LambdaCube.Core.Type
import LambdaCube.Core.DeBruijn
data Renderer
= Renderer
{ slotUniform :: Trie (Trie InputType)
, slotStream :: Trie (FetchPrimitive, Trie InputType)
, uniformSetter :: Trie InputSetter
, render :: IO ()
, dispose :: IO ()
, setScreenSize :: Word -> Word -> IO ()
, samplerOutput :: Trie TextureData
, mkUniformSetup :: Trie (GLint -> IO ())
, slotDescriptor :: Trie SlotDescriptor
, renderDescriptor :: Map Exp RenderDescriptor
, renderState :: RenderState
, objectIDSeed :: IORef Int
}
data RenderDescriptor
= RenderDescriptor
{ uniformLocation :: Trie GLint
, streamLocation :: Trie GLuint
, renderAction :: IO ()
, disposeAction :: IO ()
, drawObjectsIORef :: IORef ObjectSet
, fragmentOutCount :: Int
}
data SlotDescriptor
= SlotDescriptor
{ attachedGP :: Set Exp
, objectSet :: IORef (Set Object)
}
data ObjectSet
= ObjectSet
{ drawObject :: IO ()
, drawObjectMap :: Map Object (IO ())
}
data Object
= Object
{ objectSlotName :: ByteString
, objectUniformSetter :: Trie InputSetter
, objectID :: Int
, objectEnabledIORef :: IORef Bool
}
instance Eq Object where
a == b = objectID a == objectID b
instance Ord Object where
a `compare` b = objectID a `compare` objectID b
data RenderState
= RenderState
{ textureUnitState :: IOVector Int
, renderTargetSize :: IORef V2U
}
type StreamSetter = Stream Buffer -> IO ()
data Buffer
= Buffer
{ bufArrays :: V.Vector ArrayDesc
, bufGLObj :: GLuint
}
deriving (Show,Eq)
data ArrayDesc
= ArrayDesc
{ arrType :: ArrayType
, arrLength :: Int
, arrOffset :: Int
, arrSize :: Int
}
deriving (Show,Eq)
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
data TextureData
= TextureData
{ textureObject :: GLuint
} deriving Show
type SetterFun a = a -> IO ()
newtype Getter a = Getter (IO a)
newtype Setter a = Setter (SetterFun a)
type InputGetter = Input Getter
type InputSetter = Input Setter
data Input a
= SBool (a Bool)
| SV2B (a V2B)
| SV3B (a V3B)
| SV4B (a V4B)
| SWord (a Word32)
| SV2U (a V2U)
| SV3U (a V3U)
| SV4U (a V4U)
| SInt (a Int32)
| SV2I (a V2I)
| SV3I (a V3I)
| SV4I (a V4I)
| SFloat (a Float)
| SV2F (a V2F)
| SV3F (a V3F)
| SV4F (a V4F)
| SM22F (a M22F)
| SM23F (a M23F)
| SM24F (a M24F)
| SM32F (a M32F)
| SM33F (a M33F)
| SM34F (a M34F)
| SM42F (a M42F)
| SM43F (a M43F)
| SM44F (a M44F)
| SSTexture1D
| SSTexture2D
| SSTextureCube
| SSTexture1DArray
| SSTexture2DArray
| SSTexture2DRect
| SFTexture1D
| SFTexture2D (a TextureData)
| SFTexture3D
| SFTextureCube
| SFTexture1DArray
| SFTexture2DArray
| SFTexture2DMS
| SFTexture2DMSArray
| SFTextureBuffer
| SFTexture2DRect
| SITexture1D
| SITexture2D
| SITexture3D
| SITextureCube
| SITexture1DArray
| SITexture2DArray
| SITexture2DMS
| SITexture2DMSArray
| SITextureBuffer
| SITexture2DRect
| SUTexture1D
| SUTexture2D
| SUTexture3D
| SUTextureCube
| SUTexture1DArray
| SUTexture2DArray
| SUTexture2DMS
| SUTexture2DMSArray
| SUTextureBuffer
| SUTexture2DRect
type BufferSetter = (Ptr () -> IO ()) -> IO ()
data ArrayType
= ArrWord8
| ArrWord16
| ArrWord32
| ArrInt8
| ArrInt16
| ArrInt32
| ArrFloat
| ArrHalf
deriving (Read,Typeable,Show,Eq,Ord)
sizeOfArrayType :: ArrayType -> Int
sizeOfArrayType ArrWord8 = 1
sizeOfArrayType ArrWord16 = 2
sizeOfArrayType ArrWord32 = 4
sizeOfArrayType ArrInt8 = 1
sizeOfArrayType ArrInt16 = 2
sizeOfArrayType ArrInt32 = 4
sizeOfArrayType ArrFloat = 4
sizeOfArrayType ArrHalf = 2
data Array
= Array ArrayType Int BufferSetter
data Primitive
= TriangleStrip
| TriangleList
| TriangleFan
| LineStrip
| LineList
| PointList
| TriangleStripAdjacency
| TriangleListAdjacency
| LineStripAdjacency
| LineListAdjacency
deriving (Read,Typeable,Eq,Ord,Bounded,Enum,Show)
data StreamType
= TWord
| TV2U
| TV3U
| TV4U
| TInt
| TV2I
| TV3I
| TV4I
| TFloat
| TV2F
| TV3F
| TV4F
| TM22F
| TM23F
| TM24F
| TM32F
| TM33F
| TM34F
| TM42F
| TM43F
| TM44F
deriving (Read,Typeable,Show,Eq,Ord)
toStreamType :: InputType -> Maybe StreamType
toStreamType Word = Just TWord
toStreamType V2U = Just TV2U
toStreamType V3U = Just TV3U
toStreamType V4U = Just TV4U
toStreamType Int = Just TInt
toStreamType V2I = Just TV2I
toStreamType V3I = Just TV3I
toStreamType V4I = Just TV4I
toStreamType Float = Just TFloat
toStreamType V2F = Just TV2F
toStreamType V3F = Just TV3F
toStreamType V4F = Just TV4F
toStreamType M22F = Just TM22F
toStreamType M23F = Just TM23F
toStreamType M24F = Just TM24F
toStreamType M32F = Just TM32F
toStreamType M33F = Just TM33F
toStreamType M34F = Just TM34F
toStreamType M42F = Just TM42F
toStreamType M43F = Just TM43F
toStreamType M44F = Just TM44F
toStreamType _ = Nothing
fromStreamType :: StreamType -> InputType
fromStreamType TWord = Word
fromStreamType TV2U = V2U
fromStreamType TV3U = V3U
fromStreamType TV4U = V4U
fromStreamType TInt = Int
fromStreamType TV2I = V2I
fromStreamType TV3I = V3I
fromStreamType TV4I = V4I
fromStreamType TFloat = Float
fromStreamType TV2F = V2F
fromStreamType TV3F = V3F
fromStreamType TV4F = V4F
fromStreamType TM22F = M22F
fromStreamType TM23F = M23F
fromStreamType TM24F = M24F
fromStreamType TM32F = M32F
fromStreamType TM33F = M33F
fromStreamType TM34F = M34F
fromStreamType TM42F = M42F
fromStreamType TM43F = M43F
fromStreamType TM44F = M44F
data Stream b
= ConstWord Word32
| ConstV2U V2U
| ConstV3U V3U
| ConstV4U V4U
| ConstInt Int32
| ConstV2I V2I
| ConstV3I V3I
| ConstV4I V4I
| ConstFloat Float
| ConstV2F V2F
| ConstV3F V3F
| ConstV4F V4F
| ConstM22F M22F
| ConstM23F M23F
| ConstM24F M24F
| ConstM32F M32F
| ConstM33F M33F
| ConstM34F M34F
| ConstM42F M42F
| ConstM43F M43F
| ConstM44F M44F
| Stream
{ streamType :: StreamType
, streamBuffer :: b
, streamArrIdx :: Int
, streamStart :: Int
, streamLength :: Int
}
data IndexStream b
= IndexStream
{ indexBuffer :: b
, indexArrIdx :: Int
, indexStart :: Int
, indexLength :: Int
}