diff --git a/Graphics/Rendering/Ombra/Backend/OpenGL.hs b/Graphics/Rendering/Ombra/Backend/OpenGL.hs --- a/Graphics/Rendering/Ombra/Backend/OpenGL.hs +++ b/Graphics/Rendering/Ombra/Backend/OpenGL.hs @@ -14,7 +14,7 @@ import qualified Graphics.GL.Ext.EXT.BlendColor as GL import Graphics.GL.Types as GL -makeContext :: IO () +makeContext :: IO Ctx makeContext = return () genToCreate :: Storable a => (GLsizei -> Ptr a -> IO ()) -> ctx -> IO a diff --git a/Graphics/Rendering/Ombra/D2.hs b/Graphics/Rendering/Ombra/D2.hs --- a/Graphics/Rendering/Ombra/D2.hs +++ b/Graphics/Rendering/Ombra/D2.hs @@ -61,7 +61,7 @@ -- | A rectangle with a specified 'Texture'. rect :: GLES => Texture -> Object2D -rect = flip poly . rectGeometry $ Vec2 1 1 +rect = flip poly rectGeometry -- | A 2D object with a specified 'Geometry'. poly :: GLES => Texture -> Geometry is -> Object Uniforms2D is diff --git a/Graphics/Rendering/Ombra/Draw.hs b/Graphics/Rendering/Ombra/Draw.hs --- a/Graphics/Rendering/Ombra/Draw.hs +++ b/Graphics/Rendering/Ombra/Draw.hs @@ -1,21 +1,27 @@ module Graphics.Rendering.Ombra.Draw ( - Buffer(..), + Draw, DrawState, Ctx, + -- * Running the Draw monad refDrawCtx, runDrawCtx, execDrawCtx, evalDrawCtx, - drawInit, drawState, + -- * Draw actions + drawInit, clearBuffers, drawLayer, - drawGet, + resizeViewport, + -- ** Resources + -- $resources + preloadGeometry, + preloadTexture, + preloadProgram, removeGeometry, removeTexture, removeProgram, - resizeViewport, - renderLayer, + -- * gl ) where @@ -43,3 +49,12 @@ evalDrawCtx :: Ctx -> Draw a -> DrawState -> IO a evalDrawCtx ctx d = flip evalGL ctx . evalDraw d + +-- renderSubLayer :: + +-- $resources +-- In Ombra, GPU resources are allocated when they're needed, and they're kept +-- alive by their corresponding CPU resources. Specifically, these resources are +-- Geometries, Textures and Programs. This means that, when a CPU resource is +-- garbage collected, the GPU resource is also removed. The functions below let +-- you manage allocation and deallocation manually. diff --git a/Graphics/Rendering/Ombra/Draw/Internal.hs b/Graphics/Rendering/Ombra/Draw/Internal.hs --- a/Graphics/Rendering/Ombra/Draw/Internal.hs +++ b/Graphics/Rendering/Ombra/Draw/Internal.hs @@ -10,6 +10,9 @@ clearBuffers, drawLayer, drawObject, + preloadGeometry, + preloadTexture, + preloadProgram, removeGeometry, removeTexture, removeProgram, @@ -50,17 +53,19 @@ import Control.Monad (when) import Control.Monad.IO.Class import Control.Monad.Trans.Class +import Control.Monad.Trans.Except import Control.Monad.Trans.State -- | The state of the 'Draw' monad. data DrawState = DrawState { - currentProgram :: Maybe (Program '[] '[]), + currentProgram :: Maybe ProgramIndex, loadedProgram :: Maybe LoadedProgram, - programs :: ResMap (Program '[] '[]) LoadedProgram, - uniforms :: ResMap (LoadedProgram, String) UniformLocation, - gpuBuffers :: ResMap (Geometry '[]) GPUBufferGeometry, - gpuVAOs :: ResMap (Geometry '[]) GPUVAOGeometry, - textureImages :: ResMap TextureImage LoadedTexture, + programs :: ResMap LoadedProgram, + uniforms :: ResMap UniformLocation, + elemBuffers :: ResMap LoadedBuffer, + attributes :: ResMap LoadedAttribute, + geometries :: ResMap LoadedGeometry, + textureImages :: ResMap LoadedTexture, activeTextures :: Int, viewportSize :: (Int, Int), blendMode :: Maybe Blend.Mode, @@ -86,15 +91,17 @@ -> Int -- ^ Viewport height -> IO DrawState drawState w h = do programs <- newGLResMap - gpuBuffers <- newGLResMap - gpuVAOs <- newDrawResMap + elemBuffers <- newGLResMap + attributes <- newGLResMap + geometries <- newDrawResMap uniforms <- newGLResMap textureImages <- newGLResMap return DrawState { currentProgram = Nothing , loadedProgram = Nothing , programs = programs - , gpuBuffers = gpuBuffers - , gpuVAOs = gpuVAOs + , elemBuffers = elemBuffers + , attributes = attributes + , geometries = geometries , uniforms = uniforms , textureImages = textureImages , activeTextures = 0 @@ -103,17 +110,17 @@ , depthTest = True , depthMask = True , stencilMode = Nothing - , cullFace = Just CullBack + , cullFace = Nothing , colorMask = (True, True, True, True) } - where newGLResMap :: (Hashable i, Resource i r GL) => IO (ResMap i r) + where newGLResMap :: IO (ResMap r) newGLResMap = newResMap - newDrawResMap :: (Hashable i, Resource i r Draw) - => IO (ResMap i r) + newDrawResMap :: IO (ResMap r) newDrawResMap = newResMap +-- | Initialize the render engine. drawInit :: GLES => Draw () drawInit = viewportSize <$> Draw get >>= \(w, h) -> gl $ do clearColor 0.0 0.0 0.0 1.0 @@ -159,13 +166,21 @@ buffer DepthBuffer = gl_DEPTH_BUFFER_BIT buffer StencilBuffer = gl_STENCIL_BUFFER_BIT --- | Manually delete a 'Geometry' from the GPU (this is automatically done when --- the 'Geometry' becomes unreachable). Note that if you try to draw it, it will --- be allocated again. +-- | Manually allocate a 'Geometry' in the GPU. +preloadGeometry :: GLES => Geometry is -> Draw () +preloadGeometry g = () <$ getGeometry g + +-- | Manually allocate a 'Texture' in the GPU. +preloadTexture :: GLES => Texture -> Draw () +preloadTexture t = () <$ getTexture t + +-- | Manually allocate a 'Program' in the GPU. +preloadProgram :: GLES => Program gs is -> Draw () +preloadProgram p = () <$ getProgram p + +-- | Manually delete a 'Geometry' from the GPU. Note that if you try to draw it, it will be allocated again. removeGeometry :: GLES => Geometry is -> Draw () -removeGeometry gi = let g = castGeometry gi in - do removeDrawResource gl gpuBuffers g - removeDrawResource id gpuVAOs g +removeGeometry g = removeDrawResource id geometries g -- | Manually delete a 'Texture' from the GPU. removeTexture :: GLES => Texture -> Draw () @@ -175,7 +190,7 @@ -- | Manually delete a 'Program' from the GPU. removeProgram :: GLES => Program gs is -> Draw () -removeProgram = removeDrawResource gl programs . castProgram +removeProgram = removeDrawResource gl programs -- | Draw a 'Layer'. drawLayer :: GLES => Layer -> Draw () @@ -190,8 +205,7 @@ -- | Draw an 'Object'. drawObject :: GLES => Object gs is -> Draw () drawObject (g :~> o) = withGlobal g $ drawObject o -drawObject (Mesh g) = withRes_ (getGPUVAOGeometry $ castGeometry g) - drawGPUVAOGeometry +drawObject (Mesh g) = withRes_ (getGeometry g) drawGeometry drawObject NoMesh = return () drawObject (Prop p o) = withObjProp p $ drawObject o drawObject (Append o o') = drawObject o >> drawObject o' @@ -252,11 +266,12 @@ -- | Set the program. setProgram :: GLES => Program g i -> Draw () setProgram p = do current <- currentProgram <$> Draw get - when (current /= Just (castProgram p)) $ - withRes_ (getProgram $ castProgram p) $ + when (current /= Just (programIndex p)) $ + withRes_ (getProgram p) $ \lp@(LoadedProgram glp _ _) -> do Draw . modify $ \s -> s { - currentProgram = Just $ castProgram p, + currentProgram = + Just $ programIndex p, loadedProgram = Just lp, activeTextures = 0 } @@ -276,12 +291,8 @@ Just prg -> getDrawResource gl uniforms (prg, name) Nothing -> return $ Left "No loaded program." -getGPUVAOGeometry :: GLES => Geometry '[] -> Draw (Either String GPUVAOGeometry) -getGPUVAOGeometry = getDrawResource id gpuVAOs - -getGPUBufferGeometry :: GLES => Geometry '[] - -> Draw (Either String GPUBufferGeometry) -getGPUBufferGeometry = getDrawResource gl gpuBuffers +getGeometry :: GLES => Geometry is -> Draw (Either String LoadedGeometry) +getGeometry = getDrawResource id geometries getTexture :: GLES => Texture -> Draw (Either String LoadedTexture) getTexture (TextureLoaded l) = return $ Right l @@ -291,8 +302,7 @@ -> Draw (Either String LoadedTexture) getTextureImage = getDrawResource gl textureImages -getProgram :: GLES - => Program '[] '[] -> Draw (Either String LoadedProgram) +getProgram :: GLES => Program gs is -> Draw (Either String LoadedProgram) getProgram = getDrawResource gl programs -- | Realize a 'RenderLayer'. It returns the list of allocated 'Texture's so @@ -520,9 +530,9 @@ bool True = true bool False = false -getDrawResource :: (Resource i r m, Hashable i) +getDrawResource :: Resource i r m => (m (Either String r) -> Draw (Either String r)) - -> (DrawState -> ResMap i r) + -> (DrawState -> ResMap r) -> i -> Draw (Either String r) getDrawResource lft mg i = do @@ -531,15 +541,15 @@ removeDrawResource :: (Resource i r m, Hashable i) => (m () -> Draw ()) - -> (DrawState -> ResMap i r) + -> (DrawState -> ResMap r) -> i -> Draw () removeDrawResource lft mg i = do s <- mg <$> Draw get lft $ removeResource i s -drawGPUVAOGeometry :: GLES => GPUVAOGeometry -> Draw () -drawGPUVAOGeometry (GPUVAOGeometry _ ec vao) = currentProgram <$> Draw get >>= +drawGeometry :: GLES => LoadedGeometry -> Draw () +drawGeometry (LoadedGeometry ec vao) = currentProgram <$> Draw get >>= \mcp -> case mcp of Just _ -> gl $ do bindVertexArray vao drawElements gl_TRIANGLES @@ -555,15 +565,12 @@ return . Right $ UniformLocation loc unloadResource _ _ = return () -instance GLES => Resource (Geometry '[]) GPUVAOGeometry Draw where - loadResource g = - do ge <- getGPUBufferGeometry g - case ge of - Left err -> return $ Left err - Right buf -> gl $ loadResource buf - - unloadResource _ = - gl . unloadResource (Nothing :: Maybe GPUBufferGeometry) +instance GLES => Resource (Geometry is) LoadedGeometry Draw where + loadResource = runExceptT . + loadGeometry (ExceptT . getDrawResource gl attributes) + (ExceptT . getDrawResource gl elemBuffers) + (lift . gl) + unloadResource _ = gl . deleteGeometry -- | Perform a 'GL' action in the 'Draw' monad. gl :: GL a -> Draw a diff --git a/Graphics/Rendering/Ombra/Geometry.hs b/Graphics/Rendering/Ombra/Geometry.hs --- a/Graphics/Rendering/Ombra/Geometry.hs +++ b/Graphics/Rendering/Ombra/Geometry.hs @@ -1,14 +1,188 @@ +{-# LANGUAGE GADTs, KindSignatures, DataKinds, ScopedTypeVariables, + TypeOperators, FlexibleContexts #-} + module Graphics.Rendering.Ombra.Geometry ( Geometry, - emptyGeometry, - extend, - remove, - -- ** 2D and 3D geometries + Vertex(..), + Triangle(..), + mkGeometry, + mkGeometryInd, + removeAttribute, + -- * 2D and 3D geometries Geometry2D, Geometry3D, + positionOnly, mkGeometry2D, mkGeometry3D, - positionOnly + mkGeometry2D', + mkGeometry3D', + mkGeometry2DInd, + mkGeometry3DInd, + mkGeometry2DInd', + mkGeometry3DInd', ) where +import Control.Monad +import Control.Monad.ST +import Data.Foldable (foldrM) +import Data.Hashable +import Data.Proxy +import Data.Vect.Float +import Data.Word (Word16) +import qualified Data.HashTable.ST.Basic as H +import Graphics.Rendering.Ombra.Backend (GLES) +import Graphics.Rendering.Ombra.Internal.TList (Append) import Graphics.Rendering.Ombra.Geometry.Internal +import Graphics.Rendering.Ombra.Shader.CPU +import Graphics.Rendering.Ombra.Shader.Default2D (Position2) +import Graphics.Rendering.Ombra.Shader.Default3D (Position3, Normal3) +import qualified Graphics.Rendering.Ombra.Shader.Default2D as D2 +import qualified Graphics.Rendering.Ombra.Shader.Default3D as D3 + +data Triangle a = Triangle a a a + +-- | A list of the attributes of a vertex. +-- +-- For instance: @Attr Position3 p :~ Attr UV u :~ Attr Normal3 n@ +data Vertex (is :: [*]) where + Attr :: (Hashable (CPU S i), Attribute S i) + => (a -> i) + -> CPU S i + -> Vertex '[i] + (:~) :: Vertex '[i] -> Vertex is -> Vertex (i ': is) + +infixr 5 :~ + +-- | A 3D geometry. +type Geometry3D = '[Position3, D3.UV, D3.Normal3] + +-- | A 2D geometry. +type Geometry2D = '[Position2, D2.UV] + +-- | Create a generic 'Geometry'. +mkGeometry :: (GLES, Attributes is) + => [Triangle (Vertex is)] + -> Geometry is +mkGeometry (ts :: [Triangle (Vertex is)]) = + geometry attrList (ElemData (map (lastElem -) elemList) (hash elemList)) + where (attrList, elemList, lastElem) = + runST (H.new >>= \table -> + foldrM (\(Triangle x y z) -> addVertex table x <=< + addVertex table y <=< + addVertex table z) + (emptyAttrList (Proxy :: Proxy is), [], 0) + ts) + + addVertex :: H.HashTable s Int Word16 + -> Vertex is + -> (AttrList is, [Word16], Word16) + -> ST s (AttrList is, [Word16], Word16) + addVertex t v (attrList, elemList, lastElem) = + do melem <- H.lookup t $ hash v + (newElem, attrList') <- + case melem of + Just elem -> return (elem, attrList) + Nothing -> do H.insert t (hash v) + (lastElem + 1) + return ( lastElem + 1 + , addAttrList v + attrList + ) + let lastElem' = max lastElem newElem + return (attrList', newElem : elemList, lastElem') + +-- | Create a 'Geometry' using a list of indices to a list of vertices. This +-- is faster than 'mkGeometry'. +mkGeometryInd :: (GLES, Attributes is) + => [Vertex is] + -> [Triangle Word16] + -> Geometry is +mkGeometryInd (vs :: [Vertex is]) ts = + geometry attrList $ ElemData elemList (hash elemList) + where elemList = foldr (\(Triangle x y z) l -> x : y : z : l) [] ts + attrList = foldr addAttrList + (emptyAttrList (Proxy :: Proxy is)) + vs + +addAttrList :: Vertex is -> AttrList is -> AttrList is +addAttrList (Attr _ x) (AttrListCons (AttrData xs h) rest) = + AttrListCons (AttrData (x : xs) $ hashWithSalt (hash x) h) rest +addAttrList (Attr _ x :~ v') (AttrListCons (AttrData xs h) rest) = + AttrListCons (AttrData (x : xs) $ hashWithSalt (hash x) h) $ + addAttrList v' rest + +-- | Create a 3D 'Geometry'. +mkGeometry3D :: GLES + => [Triangle (Vec3, Vec2, Vec3)] -- ^ (Position, UV, Normal) + -> Geometry Geometry3D +mkGeometry3D = mkGeometry . map (fmap $ \(v, u, n) -> vertex3D v u n) + +-- | Create an extended 3D 'Geometry'. +mkGeometry3D' :: (GLES, Attributes (Append is Geometry3D)) + => [Triangle (Vertex is, Vec3, Vec2, Vec3)] + -> Geometry (Append is Geometry3D) +mkGeometry3D' = mkGeometry . + map (fmap $ \(e, v, u, n) -> extend e $ vertex3D v u n) + +-- | Create a 2D 'Geometry'. +mkGeometry2D :: GLES + => [Triangle (Vec2, Vec2)] -- ^ (Position, Texture UV coordinates) + -> Geometry Geometry2D +mkGeometry2D = mkGeometry . map (fmap $ \(v, u) -> vertex2D v u) + +-- | Create an extended 2D 'Geometry'. +mkGeometry2D' :: (GLES, Attributes (Append is Geometry2D)) + => [Triangle (Vertex is, Vec2, Vec2)] + -> Geometry (Append is Geometry2D) +mkGeometry2D' = mkGeometry . map (fmap $ \(e, v, u) -> extend e $ vertex2D v u) + +-- | Create a 3D 'Geometry' using a list of indices. +mkGeometry3DInd :: GLES + => [(Vec3, Vec2, Vec3)] + -> [Triangle Word16] + -> Geometry Geometry3D +mkGeometry3DInd = mkGeometryInd . map (\(v, u, n) -> vertex3D v u n) + +-- | Create an extended 3D 'Geometry' using a list of indices. +mkGeometry3DInd' :: (GLES, Attributes (Append is Geometry3D)) + => [(Vertex is, Vec3, Vec2, Vec3)] + -> [Triangle Word16] + -> Geometry (Append is Geometry3D) +mkGeometry3DInd' = mkGeometryInd . + map (\(e, v, u, n) -> extend e $ vertex3D v u n) + +-- | Create a 2D 'Geometry' using a list of indices. +mkGeometry2DInd :: GLES + => [(Vec2, Vec2)] + -> [Triangle Word16] + -> Geometry Geometry2D +mkGeometry2DInd = mkGeometryInd . map (\(v, u) -> vertex2D v u) + +-- | Create an extended 2D 'Geometry' using a list of indices. +mkGeometry2DInd' :: (GLES, Attributes (Append is Geometry2D)) + => [(Vertex is, Vec2, Vec2)] + -> [Triangle Word16] + -> Geometry (Append is Geometry2D) +mkGeometry2DInd' = mkGeometryInd . map (\(e, v, u) -> extend e $ vertex2D v u) + +vertex3D :: GLES => Vec3 -> Vec2 -> Vec3 -> Vertex Geometry3D +vertex3D p u n = Attr D3.Position3 p :~ Attr D3.UV u :~ Attr D3.Normal3 n + +vertex2D :: GLES => Vec2 -> Vec2 -> Vertex Geometry2D +vertex2D p u = Attr D2.Position2 p :~ Attr D2.UV u + +extend :: Vertex is -> Vertex is' -> Vertex (Append is is') +extend (Attr c x) v = Attr c x :~ v +extend (Attr c x :~ v') v = Attr c x :~ extend v' v + +-- | Remove the 'UV' and 'Normal3' attributes from a 3D Geometry. +positionOnly :: Geometry Geometry3D -> Geometry '[Position3] +positionOnly (Geometry (AttrListCons pd _) es _) = + geometry (AttrListCons pd AttrListNil) es + +instance Hashable (Vertex is) where + hashWithSalt s (Attr _ a) = hashWithSalt s a + hashWithSalt s (x :~ y) = hashWithSalt (hashWithSalt s x) y + +instance Functor Triangle where + fmap f (Triangle x y z) = Triangle (f x) (f y) (f z) diff --git a/Graphics/Rendering/Ombra/Geometry/Internal.hs b/Graphics/Rendering/Ombra/Geometry/Internal.hs --- a/Graphics/Rendering/Ombra/Geometry/Internal.hs +++ b/Graphics/Rendering/Ombra/Geometry/Internal.hs @@ -1,23 +1,20 @@ {-# LANGUAGE GADTs, TypeOperators, KindSignatures, DataKinds, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables, - PolyKinds #-} + PolyKinds, UndecidableInstances, RankNTypes #-} module Graphics.Rendering.Ombra.Geometry.Internal ( AttrList(..), + AttrData(..), Geometry(..), - Geometry2D, - Geometry3D, - GPUBufferGeometry(..), - GPUVAOGeometry(..), - emptyGeometry, - extend, - remove, - positionOnly, - withGPUBufferGeometry, - mkGeometry, - mkGeometry2D, - mkGeometry3D, - castGeometry + ElemData(..), + LoadedBuffer, + LoadedAttribute, + LoadedGeometry(..), + Attributes(..), + geometry, + removeAttribute, + loadGeometry, + deleteGeometry ) where import Control.Monad.Trans.Class @@ -41,192 +38,145 @@ data AttrList (is :: [*]) where AttrListNil :: AttrList '[] AttrListCons :: (H.Hashable (CPU S i), Attribute S i) - => (a -> i) - -> [CPU S i] + => AttrData i -> AttrList is -> AttrList (i ': is) +data AttrData i = AttrData [CPU S i] Int + -- | A set of attributes and indices. -data Geometry (is :: [*]) = Geometry (AttrList is) [Word16] Int +data Geometry (is :: [*]) = Geometry (AttrList is) ElemData Int -data GPUBufferGeometry = GPUBufferGeometry { - attributeBuffers :: [(Buffer, GLUInt, GLUInt -> GL ())], - elementBuffer :: Buffer, +data LoadedGeometry = LoadedGeometry { elementCount :: Int, - geometryHash :: Int -} - -data GPUVAOGeometry = GPUVAOGeometry { - vaoBoundBuffers :: [Buffer], - vaoElementCount :: Int, vao :: VertexArrayObject } --- | A 3D geometry. -type Geometry3D = '[Position3, D3.UV, Normal3] +newtype LoadedBuffer = LoadedBuffer Buffer --- | A 2D geometry. -type Geometry2D = '[Position2, D2.UV] +data ElemData = ElemData [Word16] Int -instance H.Hashable (AttrList is) where - hashWithSalt salt AttrListNil = salt - hashWithSalt salt (AttrListCons _ i is) = H.hashWithSalt salt (i, is) +data LoadedAttribute = LoadedAttribute GLUInt [(Buffer, GLUInt -> GL ())] +instance Eq (Geometry is) where + (Geometry _ _ h) == (Geometry _ _ h') = h == h' + instance H.Hashable (Geometry is) where hashWithSalt salt (Geometry _ _ h) = H.hashWithSalt salt h -instance Eq (Geometry is) where - (Geometry _ _ h) == (Geometry _ _ h') = h == h' +instance H.Hashable ElemData where + hashWithSalt salt (ElemData _ h) = H.hashWithSalt salt h -instance H.Hashable GPUBufferGeometry where - hashWithSalt salt = H.hashWithSalt salt . geometryHash +instance Eq ElemData where + (ElemData _ h) == (ElemData _ h') = h == h' -instance Eq GPUBufferGeometry where - g == g' = geometryHash g == geometryHash g' +instance H.Hashable (AttrData i) where + hashWithSalt salt (AttrData _ h) = H.hashWithSalt salt h --- | Create a 3D 'Geometry'. The first three lists should have the same length. -mkGeometry3D :: GLES - => [Vec3] -- ^ List of vertices. - -> [Vec2] -- ^ List of UV coordinates. - -> [Vec3] -- ^ List of normals. - -> [Word16] -- ^ Triangles expressed as triples of indices to the - -- three lists above. - -> Geometry Geometry3D -mkGeometry3D v u n = mkGeometry (AttrListCons D3.Position3 v $ - AttrListCons D3.UV u $ - AttrListCons D3.Normal3 n - AttrListNil) +instance Eq (AttrData i) where + (AttrData _ h) == (AttrData _ h') = h == h' --- | Create a 2D 'Geometry'. The first two lists should have the same length. -mkGeometry2D :: GLES - => [Vec2] -- ^ List of vertices. - -> [Vec2] -- ^ List of UV coordinates. - -> [Word16] -- ^ Triangles expressed as triples of indices to the - -- two lists above. - -> Geometry Geometry2D -mkGeometry2D v u = mkGeometry (AttrListCons D2.Position2 v $ - AttrListCons D2.UV u - AttrListNil) +instance H.Hashable (AttrList is) where + hashWithSalt salt AttrListNil = salt + hashWithSalt salt (AttrListCons (AttrData _ h) al) = + H.hashWithSalt (H.hashWithSalt salt h) al +class Attributes (is :: [*]) where + emptyAttrList :: Proxy (is :: [*]) -> AttrList is + +instance Attributes '[] where + emptyAttrList _ = AttrListNil --- | Add an attribute to a geometry. -extend :: (Attribute 'S i, H.Hashable (CPU 'S i), ShaderType i, GLES) - => (a -> i) -- ^ Attribute constructor (or any other - -- function with that type). - -> [CPU 'S i] -- ^ List of values - -> Geometry is - -> Geometry (i ': is) -extend g c (Geometry al es _) = mkGeometry (AttrListCons g c al) es +instance (H.Hashable (CPU S i), Attribute S i, Attributes is) => + Attributes (i ': is) where + emptyAttrList (_ :: Proxy (i ': is)) = + AttrListCons (AttrData [] (H.hash (0 :: Int)) :: AttrData i) $ + emptyAttrList (Proxy :: Proxy is) --- | Remove an attribute from a geometry. -remove :: (RemoveAttr i is is', GLES) - => (a -> i) -- ^ Attribute constructor (or any other function with - -- that type). - -> Geometry is -> Geometry is' -remove g (Geometry al es _) = mkGeometry (removeAttr g al) es +geometry :: AttrList is -> ElemData -> Geometry is +geometry al es = Geometry al es $ H.hashWithSalt (H.hash al) es --- | Remove the 'UV' and 'Normal3' attributes from a 3D Geometry. -positionOnly :: Geometry Geometry3D -> Geometry '[Position3] -positionOnly (Geometry (AttrListCons pg pc _) es h) = - Geometry (AttrListCons pg pc AttrListNil) es h +-- | Remove an attribute from a geometry. +removeAttribute :: (RemoveAttr i is is', GLES) + => (a -> i) -- ^ Attribute constructor (or any other + -- function with that type). + -> Geometry is -> Geometry is' +removeAttribute g (Geometry al es _) = geometry (removeAttr g al) es class RemoveAttr i is is' where removeAttr :: (a -> i) -> AttrList is -> AttrList is' instance RemoveAttr i (i ': is) is where - removeAttr _ (AttrListCons _ _ al) = al + removeAttr _ (AttrListCons _ al) = al instance RemoveAttr i is is' => RemoveAttr i (i1 ': is) (i1 ': is') where - removeAttr g (AttrListCons g' c al) = - AttrListCons g' c $ removeAttr g al - --- | Create a 'Geometry' without attributes. You can add them using 'extend'. -emptyGeometry :: [Word16] -- ^ Triangles. - -> Geometry '[] -emptyGeometry = mkGeometry AttrListNil - --- | Create a custom 'Geometry'. -mkGeometry :: AttrList is -> [Word16] -> Geometry is -mkGeometry al e = Geometry al e $ H.hash (al, e) - -castGeometry :: Geometry is -> Geometry is' -castGeometry = unsafeCoerce - -instance GLES => Resource (Geometry i) GPUBufferGeometry GL where - loadResource i = Right <$> loadGeometry i - unloadResource _ = deleteGPUBufferGeometry - -instance GLES => Resource GPUBufferGeometry GPUVAOGeometry GL where - loadResource i = Right <$> loadGPUVAOGeometry i - unloadResource _ = deleteGPUVAOGeometry + removeAttr g (AttrListCons c al) = + AttrListCons c $ removeAttr g al -loadGPUVAOGeometry :: GLES - => GPUBufferGeometry - -> GL GPUVAOGeometry -loadGPUVAOGeometry g = - do vao <- createVertexArray - bindVertexArray vao - (ec, bufs) <- withGPUBufferGeometry g $ - \ec bufs -> bindVertexArray noVAO >> return (ec, bufs) - return $ GPUVAOGeometry bufs ec vao +instance (GLES, Attribute 'S i) => Resource (AttrData i) LoadedAttribute GL where + loadResource (AttrData vs _ :: AttrData i) = + fmap (Right . uncurry LoadedAttribute) . + flip execStateT (0, []) $ + withAttributes (Proxy :: Proxy 'S) (undefined :: i) vs $ + \_ (g :: Proxy g) c -> + do (i, as) <- get + arr <- lift $ encodeAttribute g c + buf <- lift $ + loadBuffer gl_ARRAY_BUFFER + arr + let sz = fromIntegral . size $ + (undefined :: g) + set = setAttribute g . (+ i) + put (i + sz, (buf, set) : as) + unloadResource _ (LoadedAttribute _ as) = + mapM_ (\(buf, _) -> deleteBuffer buf) as -loadGeometry :: GLES => Geometry i -> GL GPUBufferGeometry -loadGeometry (Geometry al es h) = - GPUBufferGeometry <$> loadAttrList al - <*> (liftIO (encodeUShorts es) >>= - loadBuffer gl_ELEMENT_ARRAY_BUFFER . - fromUInt16Array) - <*> pure (length es) - <*> pure h +instance GLES => Resource ElemData LoadedBuffer GL where + loadResource (ElemData elems _) = + liftIO (encodeUShorts elems) >>= + fmap (Right . LoadedBuffer) . + loadBuffer gl_ELEMENT_ARRAY_BUFFER + . fromUInt16Array + unloadResource _ (LoadedBuffer buf) = deleteBuffer buf -loadAttrList :: GLES => AttrList is -> GL [(Buffer, GLUInt, GLUInt -> GL ())] -loadAttrList = loadFrom 0 - where loadFrom :: GLUInt -> AttrList is - -> GL [(Buffer, GLUInt, GLUInt -> GL ())] - loadFrom _ AttrListNil = return [] - loadFrom idx (AttrListCons g c al) = - do (newIdx, attrInfo) <- loadAttribute idx (g undefined) c - (attrInfo ++) <$> loadFrom newIdx al - - loadAttribute :: Attribute 'S g => GLUInt -> g -> [CPU 'S g] - -> GL (GLUInt, [(Buffer, GLUInt, GLUInt -> GL ())]) - loadAttribute ii g c = flip execStateT (ii, []) $ - withAttributes (Proxy :: Proxy 'S) g c $ \_ (g :: Proxy g) c -> - do (i, infos) <- get - arr <- lift $ encodeAttribute g c - buf <- lift $ loadBuffer gl_ARRAY_BUFFER arr - put ( i + fromIntegral (size (undefined :: g)) - , (buf, i, setAttribute g) : infos ) +loadGeometry :: (GLES, Monad m) + => (forall i. Attribute 'S i => AttrData i -> m LoadedAttribute) + -> (ElemData -> m LoadedBuffer) + -> (forall a. GL a -> m a) + -> Geometry is + -> m LoadedGeometry +loadGeometry getAttr getElems gl (Geometry attrList elems@(ElemData es _) _) = + do vao <- gl createVertexArray + gl $ bindVertexArray vao -withGPUBufferGeometry :: GLES - => GPUBufferGeometry -> (Int -> [Buffer] -> GL a) -> GL a -withGPUBufferGeometry (GPUBufferGeometry abs eb ec _) f = - do bindBuffer gl_ARRAY_BUFFER noBuffer - (_, bufs) <- unzip <$> - mapM (\(buf, loc, setAttr) -> - do bindBuffer gl_ARRAY_BUFFER buf - enableVertexAttribArray loc - setAttr loc - return (loc, buf) - ) abs + setAttrList getAttr gl (0 :: GLUInt) attrList + LoadedBuffer eb <- getElems elems - bindBuffer gl_ELEMENT_ARRAY_BUFFER eb - r <- f ec $ eb : bufs - bindBuffer gl_ELEMENT_ARRAY_BUFFER noBuffer - bindBuffer gl_ARRAY_BUFFER noBuffer - -- mapM_ (disableVertexAttribArray . fromIntegral) locs - return r + gl $ do bindBuffer gl_ELEMENT_ARRAY_BUFFER eb + bindVertexArray noVAO + bindBuffer gl_ELEMENT_ARRAY_BUFFER noBuffer + bindBuffer gl_ARRAY_BUFFER noBuffer -deleteGPUVAOGeometry :: GLES => GPUVAOGeometry -> GL () -deleteGPUVAOGeometry (GPUVAOGeometry bufs _ vao) = - do mapM_ deleteBuffer bufs - deleteVertexArray vao + return $ LoadedGeometry (length es) vao +setAttrList :: (GLES, Monad m) + => (forall i. Attribute 'S i => AttrData i -> m LoadedAttribute) + -> (forall a. GL a -> m a) + -> GLUInt + -> AttrList is + -> m () +setAttrList getAttr gl i (AttrListCons attrData rest) = + do (LoadedAttribute sz as) <- getAttr attrData + gl $ mapM_ (\(buf, set) -> do bindBuffer gl_ARRAY_BUFFER buf + enableVertexAttribArray i + set i + ) as + setAttrList getAttr gl (i + sz) rest +setAttrList _ _ _ AttrListNil = return () -deleteGPUBufferGeometry :: GLES => GPUBufferGeometry -> GL () -deleteGPUBufferGeometry (GPUBufferGeometry abs eb _ _) = - mapM_ (\(buf, _, _) -> deleteBuffer buf) abs >> deleteBuffer eb +deleteGeometry :: GLES => LoadedGeometry -> GL () +deleteGeometry (LoadedGeometry _ vao) = deleteVertexArray vao loadBuffer :: GLES => GLEnum -> AnyArray -> GL Buffer loadBuffer ty bufData = diff --git a/Graphics/Rendering/Ombra/Internal/Resource.hs b/Graphics/Rendering/Ombra/Internal/Resource.hs --- a/Graphics/Rendering/Ombra/Internal/Resource.hs +++ b/Graphics/Rendering/Ombra/Internal/Resource.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, - FunctionalDependencies, ScopedTypeVariables #-} +{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, TypeFamilies, + FunctionalDependencies, ScopedTypeVariables, FlexibleContexts #-} module Graphics.Rendering.Ombra.Internal.Resource ( ResMap, @@ -17,45 +17,45 @@ import Data.Hashable import System.Mem.Weak -data ResMap i r = forall m. (Resource i r m, Hashable i) => - ResMap (H.LinearHashTable Int (Either String r)) +data ResMap r = ResMap (H.LinearHashTable Int (Either String r)) data ResStatus r = Loaded r | Unloaded | Error String -class (Eq i, Applicative m, EmbedIO m) => - Resource i r m | i r -> m where +class (Eq i, Applicative m, EmbedIO m, Hashable i) => + Resource i r m | r -> m where loadResource :: i -> m (Either String r) unloadResource :: Maybe i -> r -> m () class MonadIO m => EmbedIO m where embedIO :: (IO a -> IO b) -> m a -> m b -newResMap :: (Hashable i, MonadIO io) => Resource i r m => io (ResMap i r) +newResMap :: MonadIO m => m (ResMap r) newResMap = ResMap <$> liftIO H.new -addResource :: (Resource i r m, Hashable i) => i -> ResMap i r -> m () +addResource :: Resource i r m => i -> ResMap r -> m () addResource i m = () <$ getResource i m -checkResource :: Hashable i - => Resource i r m +checkResource :: Resource i r m => i - -> ResMap i r + -> ResMap r -> m (ResStatus r) -checkResource i = checkResource' $ hash i +checkResource i = checkResource' (Just i) $ hash i -checkResource' :: Resource i r m => Int -> ResMap i r -> m (ResStatus r) -checkResource' i (ResMap map) = do m <- liftIO $ H.lookup map i - return $ case m of - Just (Right r) -> Loaded r - Just (Left e) -> Error e - Nothing -> Unloaded +checkResource' :: Resource i r m + => Maybe i + -> Int + -> ResMap r + -> m (ResStatus r) +checkResource' _ i (ResMap map) = do m <- liftIO $ H.lookup map i + return $ case m of + Just (Right r) -> Loaded r + Just (Left e) -> Error e + Nothing -> Unloaded -getResource :: (Resource i r m, Hashable i) - => i -> ResMap i r - -> m (Either String r) -getResource i rmap@(ResMap map) = +getResource :: Resource i r m => i -> ResMap r -> m (Either String r) +getResource (i :: i) rmap@(ResMap map) = do status <- checkResource i rmap case status of Unloaded -> @@ -65,8 +65,10 @@ Left s -> H.insert map ihash $ Left s Right r -> H.insert map ihash $ Right r - embedIO (addFinalizer i) $ removeResource' ihash rmap - meRes <- liftIO . H.lookup map $ hash i + embedIO (addFinalizer i) $ + removeResource' (Nothing :: Maybe i) + ihash rmap + meRes <- liftIO . H.lookup map $ ihash return $ case meRes of Just eRes -> eRes Nothing -> Left "Resource finalized" @@ -76,13 +78,13 @@ -- reloadResource -removeResource :: (Resource i r m, Hashable i) => i -> ResMap i r -> m () -removeResource i = removeResource' $ hash i +removeResource :: Resource i r m => i -> ResMap r -> m () +removeResource i = removeResource' (Just i) $ hash i -removeResource' :: (Resource i r m, Hashable i) => Int -> ResMap i r -> m () -removeResource' i rmap@(ResMap map :: ResMap i r) = - do status <- checkResource' i rmap +removeResource' :: Resource i r m => Maybe i -> Int -> ResMap r -> m () +removeResource' mi i rmap@(ResMap map) = + do status <- checkResource' mi i rmap case status of - Loaded r -> unloadResource (Nothing :: Maybe i) r + Loaded r -> unloadResource mi r _ -> return () liftIO $ H.delete map i diff --git a/Graphics/Rendering/Ombra/Object.hs b/Graphics/Rendering/Ombra/Object.hs --- a/Graphics/Rendering/Ombra/Object.hs +++ b/Graphics/Rendering/Ombra/Object.hs @@ -34,6 +34,7 @@ withTexture, withTexSize, withFramebufferSize, + ActiveTexture, -- ** Mirror globals mirror, CPUMirror, @@ -118,12 +119,14 @@ f ~~> (g :~> o) = globalApply f g :~> o f ~~> (Prop p o) = Prop p $ f ~~> o f ~~> (Append o o') = Append (f ~~> o) (f ~~> o') + f ~~> NoMesh = NoMesh instance {-# OVERLAPPABLE #-} ((g == g1) ~ False, MemberGlobal g gs) => MemberGlobal g (g1 ': gs) where f ~~> (g :~> o) = g :~> (f ~~> o) f ~~> (Prop p o) = Prop p $ f ~~> o f ~~> (Append o o') = Append (f ~~> o) (f ~~> o') + f ~~> NoMesh = NoMesh globalApply :: (Uniform 'S g) => (CPU 'S g -> Global g) @@ -145,12 +148,14 @@ _ *~> (_ :~> o) = o r *~> (Prop p o) = Prop p $ r *~> o r *~> (Append o o') = Append (r *~> o) (r *~> o') + r *~> NoMesh = NoMesh instance {-# OVERLAPPABLE #-} ((g == g1) ~ False, RemoveGlobal g gs gs') => RemoveGlobal g (g1 ': gs) (g1 ': gs') where r *~> (g :~> o) = g :~> (r *~> o) r *~> (Prop p o) = Prop p $ r *~> o r *~> (Append o o') = Append (r *~> o) (r *~> o') + r *~> NoMesh = NoMesh infixr 2 *~> @@ -162,6 +167,7 @@ modifyGeometry fg (Prop p o) = Prop p $ modifyGeometry fg o modifyGeometry fg (Append o o') = Append (modifyGeometry fg o) (modifyGeometry fg o') +modifyGeometry fg NoMesh = NoMesh -- | Create a 'Global' from a pure value. The first argument is ignored, -- it just provides the type (you can use the constructor of the GPU type). @@ -184,6 +190,7 @@ withFramebufferSize :: ((Int, Int) -> Global g) -> Global g withFramebufferSize = WithFramebufferSize +-- TODO: remove Proxy? -- | Like '-=' but for mirror types. mirror :: (ShaderVar g, Uniform 'M g) => Proxy g -> CPU 'M g -> Global g mirror = Mirror diff --git a/Graphics/Rendering/Ombra/Shader/Program.hs b/Graphics/Rendering/Ombra/Shader/Program.hs --- a/Graphics/Rendering/Ombra/Shader/Program.hs +++ b/Graphics/Rendering/Ombra/Shader/Program.hs @@ -7,15 +7,16 @@ LoadedProgram(..), Compatible, Program, + ProgramIndex, program, loadProgram, - castProgram, DefaultUniforms2D, DefaultAttributes2D, DefaultUniforms3D, DefaultAttributes3D, defaultProgram3D, - defaultProgram2D + defaultProgram2D, + programIndex ) where import Data.Hashable @@ -37,6 +38,8 @@ data LoadedProgram = LoadedProgram !GL.Program (H.HashMap String Int) Int +newtype ProgramIndex = ProgramIndex Int deriving Eq + -- | The uniforms used in the default 3D program. type DefaultUniforms3D = Default3D.Uniforms @@ -66,10 +69,6 @@ loadResource i = Right <$> loadProgram i unloadResource _ (LoadedProgram p _ _) = deleteProgram p -castProgram :: Program gs is -> Program gs' is' --- castProgram (Program v f h) = Program v f h -castProgram = unsafeCoerce - -- | Compatible shaders. type Compatible pgs vgs fgs = EqualOrErr pgs (Union vgs fgs) @@ -91,6 +90,9 @@ program vs fs = let (vss, attrs) = vertexToGLSLAttr vs fss = fragmentToGLSL fs in Program (vss, attrs) fss (hash (vss, fss)) + +programIndex :: Program gs is -> ProgramIndex +programIndex (Program _ _ h) = ProgramIndex h defaultProgram3D :: Program DefaultUniforms3D DefaultAttributes3D defaultProgram3D = program Default3D.vertexShader Default3D.fragmentShader diff --git a/Graphics/Rendering/Ombra/Shapes.hs b/Graphics/Rendering/Ombra/Shapes.hs --- a/Graphics/Rendering/Ombra/Shapes.hs +++ b/Graphics/Rendering/Ombra/Shapes.hs @@ -4,102 +4,52 @@ import Graphics.Rendering.Ombra.Geometry import Graphics.Rendering.Ombra.Internal.GL (GLES) -rectGeometry :: GLES => Vec2 -> Geometry Geometry2D -rectGeometry (Vec2 w h) = mkGeometry2D [ Vec2 (-hw) (-hh) - , Vec2 hw (-hh) - , Vec2 hw hh - , Vec2 (-hw) hh ] - [ Vec2 0 0 - , Vec2 1 0 - , Vec2 1 1 - , Vec2 0 1 ] - [ 0, 1, 2, 0, 3, 2 ] - where (hw, hh) = (w / 2, h / 2) +rectGeometry :: GLES => Geometry Geometry2D +rectGeometry = mkGeometry2DInd [ (Vec2 (-0.5) (-0.5), Vec2 0 0) + , (Vec2 0.5 (-0.5), Vec2 1 0) + , (Vec2 0.5 0.5 , Vec2 1 1) + , (Vec2 (-0.5) 0.5 , Vec2 0 1) + ] + [ Triangle 0 1 2 + , Triangle 0 3 2 + ] cubeGeometry :: GLES => Geometry Geometry3D -cubeGeometry = - mkGeometry3D - [ Vec3 1.0 1.0 (-0.999999), - Vec3 1.0 (-1.0) (-1.0), - Vec3 (-1.0) 1.0 (-1.0), - Vec3 (-1.0) (-1.0) 1.0, - Vec3 (-1.0) 1.0 1.0, - Vec3 (-1.0) (-1.0) (-1.0), - Vec3 (-1.0) (-1.0) 1.0, - Vec3 1.0 (-1.0) 1.0, - Vec3 (-1.0) 1.0 1.0, - Vec3 1.0 (-1.0) 1.0, - Vec3 1.0 (-1.0) (-1.0), - Vec3 0.999999 1.0 1.000001, - Vec3 1.0 1.0 (-0.999999), - Vec3 (-1.0) 1.0 (-1.0), - Vec3 0.999999 1.0 1.000001, - Vec3 1.0 (-1.0) (-1.0), - Vec3 1.0 (-1.0) 1.0, - Vec3 (-1.0) (-1.0) (-1.0), - Vec3 (-1.0) (-1.0) (-1.0), - Vec3 (-1.0) 1.0 (-1.0), - Vec3 0.999999 1.0 1.000001, - Vec3 1.0 1.0 (-0.999999), - Vec3 (-1.0) 1.0 1.0, - Vec3 (-1.0) (-1.0) 1.0 ] - [ Vec2 0.9999 1.0e-4, - Vec2 0.9999 0.9999, - Vec2 1.0e-4 1.0e-4, - Vec2 1.0e-4 0.9999, - Vec2 1.0e-4 1.0e-4, - Vec2 0.9999 0.9999, - Vec2 1.0e-4 1.0e-4, - Vec2 0.9999 1.0e-4, - Vec2 1.0e-4 0.9999, - Vec2 1.0e-4 1.0e-4, - Vec2 0.9999 1.0e-4, - Vec2 1.0e-4 0.9999, - Vec2 0.9999 0.9999, - Vec2 1.0e-4 0.9999, - Vec2 0.9999 1.0e-4, - Vec2 0.9999 0.9999, - Vec2 1.0e-4 0.9999, - Vec2 0.9999 1.0e-4, - Vec2 1.0e-4 0.9999, - Vec2 0.9999 1.0e-4, - Vec2 0.9999 0.9999, - Vec2 0.9999 0.9999, - Vec2 1.0e-4 1.0e-4, - Vec2 1.0e-4 1.0e-4 ] - [ Vec3 0.0 0.0 (-1.0), - Vec3 0.0 0.0 (-1.0), - Vec3 0.0 0.0 (-1.0), - Vec3 (-1.0) (-0.0) (-0.0), - Vec3 (-1.0) (-0.0) (-0.0), - Vec3 (-1.0) (-0.0) (-0.0), - Vec3 (-0.0) (-0.0) 1.0, - Vec3 (-0.0) (-0.0) 1.0, - Vec3 (-0.0) (-0.0) 1.0, - Vec3 1.0 (-0.0) 0.0, - Vec3 1.0 (-0.0) 0.0, - Vec3 1.0 (-0.0) 0.0, - Vec3 0.0 1.0 0.0, - Vec3 0.0 1.0 0.0, - Vec3 0.0 1.0 0.0, - Vec3 0.0 (-1.0) 0.0, - Vec3 0.0 (-1.0) 0.0, - Vec3 0.0 (-1.0) 0.0, - Vec3 0.0 0.0 (-1.0), - Vec3 (-1.0) (-0.0) (-0.0), - Vec3 (-0.0) (-0.0) 1.0, - Vec3 1.0 (-0.0) 0.0, - Vec3 0.0 1.0 0.0, - Vec3 0.0 (-1.0) 0.0 ] - [ 0, 1, 2, - 3, 4, 5, - 6, 7, 8, - 9, 10, 11, - 12, 13, 14, - 15, 16, 17, - 1, 18, 2, - 4, 19, 5, - 7, 20, 8, - 10, 21, 11, - 13, 22, 14, - 16, 23, 17 ] +cubeGeometry = mkGeometry3DInd [ (Vec3 1 1 (-1), Vec2 1 0, Vec3 0 0 (-1)) + , (Vec3 1 (-1) (-1), Vec2 1 1, Vec3 0 0 (-1)) + , (Vec3 (-1) 1 (-1), Vec2 0 0, Vec3 0 0 (-1)) + , (Vec3 (-1) (-1) 1, Vec2 0 1, Vec3 (-1) 0 0) + , (Vec3 (-1) 1 1, Vec2 0 0, Vec3 (-1) 0 0) + , (Vec3 (-1) (-1) (-1), Vec2 1 1, Vec3 (-1) 0 0) + , (Vec3 (-1) (-1) 1, Vec2 0 0, Vec3 0 0 1) + , (Vec3 1 (-1) 1, Vec2 1 0, Vec3 0 0 1) + , (Vec3 (-1) 1 1, Vec2 0 1, Vec3 0 0 1) + , (Vec3 1 (-1) 1, Vec2 0 0, Vec3 1 0 0) + , (Vec3 1 (-1) (-1), Vec2 1 0, Vec3 1 0 0) + , (Vec3 1 1 1, Vec2 0 1, Vec3 1 0 0) + , (Vec3 1 1 (-1), Vec2 1 1, Vec3 0 1 0) + , (Vec3 (-1) 1 (-1), Vec2 0 1, Vec3 0 1 0) + , (Vec3 1 1 1, Vec2 1 0, Vec3 0 1 0) + , (Vec3 1 (-1) (-1), Vec2 1 1, Vec3 0 (-1) 0) + , (Vec3 1 (-1) 1, Vec2 0 1, Vec3 0 (-1) 0) + , (Vec3 (-1) (-1) (-1), Vec2 1 0, Vec3 0 (-1) 0) + , (Vec3 (-1) (-1) (-1), Vec2 0 1, Vec3 0 0 (-1)) + , (Vec3 (-1) 1 (-1), Vec2 1 0, Vec3 (-1) 0 0) + , (Vec3 1 1 1, Vec2 1 1, Vec3 0 0 1) + , (Vec3 1 1 (-1), Vec2 1 1, Vec3 1 0 0) + , (Vec3 (-1) 1 1, Vec2 0 0, Vec3 0 1 0) + , (Vec3 (-1) (-1) 1, Vec2 0 0, Vec3 0 (-1) 0) + ] + [ Triangle 0 1 2 + , Triangle 3 4 5 + , Triangle 6 7 8 + , Triangle 9 10 11 + , Triangle 12 13 14 + , Triangle 15 16 17 + , Triangle 1 18 2 + , Triangle 4 19 5 + , Triangle 7 20 8 + , Triangle 10 21 11 + , Triangle 13 22 14 + , Triangle 16 23 17 + ] diff --git a/ombra.cabal b/ombra.cabal --- a/ombra.cabal +++ b/ombra.cabal @@ -1,5 +1,5 @@ name: ombra -version: 0.2.0.0 +version: 0.2.1.0 synopsis: Render engine. description: Type-safe render engine, with a purely functional API and a shader EDSL. Ombra supports both OpenGL (2.0 with some extensions) and WebGL, through GHCJS. homepage: https://github.com/ziocroc/Ombra