ombra 0.2.2.0 → 0.3.0.0
raw patch · 27 files changed
+1768/−870 lines, 27 filesdep +Booleandep +vector-spacedep −vectdep ~gl
Dependencies added: Boolean, vector-space
Dependencies removed: vect
Dependency ranges changed: gl
Files
- Graphics/Rendering/Ombra.hs +2/−2
- Graphics/Rendering/Ombra/Backend.hs +1/−35
- Graphics/Rendering/Ombra/Backend/OpenGL.hs +3/−2
- Graphics/Rendering/Ombra/Backend/WebGL.hs +1/−1
- Graphics/Rendering/Ombra/Blend/Internal.hs +1/−2
- Graphics/Rendering/Ombra/D2.hs +1/−1
- Graphics/Rendering/Ombra/D3.hs +1/−1
- Graphics/Rendering/Ombra/Draw/Internal.hs +7/−5
- Graphics/Rendering/Ombra/Geometry.hs +4/−3
- Graphics/Rendering/Ombra/Geometry/Internal.hs +1/−10
- Graphics/Rendering/Ombra/Layer/Internal.hs +4/−3
- Graphics/Rendering/Ombra/Object.hs +0/−1
- Graphics/Rendering/Ombra/Object/Internal.hs +0/−1
- Graphics/Rendering/Ombra/Shader.hs +422/−180
- Graphics/Rendering/Ombra/Shader/CPU.hs +97/−105
- Graphics/Rendering/Ombra/Shader/Default2D.hs +23/−14
- Graphics/Rendering/Ombra/Shader/Default3D.hs +25/−16
- Graphics/Rendering/Ombra/Shader/Language.hs +186/−0
- Graphics/Rendering/Ombra/Shader/Language/Functions.hs +246/−235
- Graphics/Rendering/Ombra/Shader/Language/Types.hs +177/−169
- Graphics/Rendering/Ombra/Shader/Stages.hs +25/−25
- Graphics/Rendering/Ombra/Shapes.hs +1/−1
- Graphics/Rendering/Ombra/Texture.hs +39/−21
- Graphics/Rendering/Ombra/Texture/Internal.hs +34/−20
- Graphics/Rendering/Ombra/Transformation.hs +23/−10
- Graphics/Rendering/Ombra/Vector.hs +381/−0
- ombra.cabal +63/−7
Graphics/Rendering/Ombra.hs view
@@ -9,6 +9,8 @@ "Graphics.Rendering.Ombra.D2": 2D graphics +"Graphics.Rendering.Ombra.Vector": vectors and matrices+ "Graphics.Rendering.Ombra.Shader": to write shaders "Graphics.Rendering.Ombra.Draw": to render the layers@@ -19,13 +21,11 @@ module Graphics.Rendering.Ombra.Layer, module Graphics.Rendering.Ombra.Object, module Graphics.Rendering.Ombra.Texture,- module Data.Vect.Float, -- * Backend constraint GLES ) where -import Data.Vect.Float import Graphics.Rendering.Ombra.Backend import Graphics.Rendering.Ombra.Color import Graphics.Rendering.Ombra.Geometry
Graphics/Rendering/Ombra/Backend.hs view
@@ -4,16 +4,12 @@ import Control.Concurrent (ThreadId) import Data.Bits (Bits)-import Data.Vect.Float import Data.Int import Data.Word import Foreign.Storable import Foreign.Ptr (castPtr) import Graphics.Rendering.Ombra.Color--data IVec2 = IVec2 !Int32 !Int32 -data IVec3 = IVec3 !Int32 !Int32 !Int32-data IVec4 = IVec4 !Int32 !Int32 !Int32 !Int32+import Graphics.Rendering.Ombra.Vector -- Mixed OpenGL ES 2.0/WebGL 1.0/OpenGL 2.0 API, with VAOs and FBOs. -- | Backend API.@@ -550,33 +546,3 @@ gl_RENDERBUFFER_BINDING :: GLEnum gl_MAX_RENDERBUFFER_SIZE :: GLEnum gl_INVALID_FRAMEBUFFER_OPERATION :: GLEnum--instance Storable IVec2 where- sizeOf _ = 8- alignment _ = 4- peek ptr = IVec2 <$> peekElemOff (castPtr ptr) 0- <*> peekElemOff (castPtr ptr) 1- poke ptr (IVec2 x y) = do pokeElemOff (castPtr ptr) 0 x- pokeElemOff (castPtr ptr) 1 y--instance Storable IVec3 where- sizeOf _ = 12- alignment _ = 4- peek ptr = IVec3 <$> peekElemOff (castPtr ptr) 0- <*> peekElemOff (castPtr ptr) 1- <*> peekElemOff (castPtr ptr) 2- poke ptr (IVec3 x y z) = do pokeElemOff (castPtr ptr) 0 x- pokeElemOff (castPtr ptr) 1 y- pokeElemOff (castPtr ptr) 2 z--instance Storable IVec4 where- sizeOf _ = 16- alignment _ = 4- peek ptr = IVec4 <$> peekElemOff (castPtr ptr) 0- <*> peekElemOff (castPtr ptr) 1- <*> peekElemOff (castPtr ptr) 2- <*> peekElemOff (castPtr ptr) 3- poke ptr (IVec4 x y z w) = do pokeElemOff (castPtr ptr) 0 x- pokeElemOff (castPtr ptr) 1 y- pokeElemOff (castPtr ptr) 2 z- pokeElemOff (castPtr ptr) 3 w
Graphics/Rendering/Ombra/Backend/OpenGL.hs view
@@ -3,10 +3,10 @@ module Graphics.Rendering.Ombra.Backend.OpenGL (makeContext) where import Data.Word-import Data.Vect.Float import Foreign import Foreign.C.String import Graphics.Rendering.Ombra.Backend+import Graphics.Rendering.Ombra.Vector import qualified Graphics.GL.Standard20 as GL import qualified Graphics.GL.Ext.ARB.FramebufferObject as GL import qualified Graphics.GL.Ext.ARB.TextureFloat as GL@@ -100,7 +100,8 @@ noUInt8Array = fmap ((,) 0) $ newForeignPtr_ nullPtr noFloat32Array = fmap ((,) 0) $ newForeignPtr_ nullPtr - encodeMat2 (Mat2 (Vec2 a1 a2) (Vec2 b1 b2)) = mkArray [ a1, a2, b1, b2 ]+ encodeMat2 (Mat2 (Vec2 a1 a2) (Vec2 b1 b2)) =+ mkArray [ a1, a2, b1, b2 ] encodeMat3 (Mat3 (Vec3 a1 a2 a3) (Vec3 b1 b2 b3)
Graphics/Rendering/Ombra/Backend/WebGL.hs view
@@ -15,13 +15,13 @@ import Data.IORef import Data.List (unfoldr) import Data.JSString (JSString, pack)-import Data.Vect.Float import Data.Word import Graphics.Rendering.Ombra.Backend import qualified Graphics.Rendering.Ombra.Backend.WebGL.Const as JS import qualified Graphics.Rendering.Ombra.Backend.WebGL.Raw as JS import qualified Graphics.Rendering.Ombra.Backend.WebGL.Types as JS import Graphics.Rendering.Ombra.Color+import Graphics.Rendering.Ombra.Vector import GHCJS.Foreign hiding (Object) import GHCJS.Types import GHCJS.Marshal
Graphics/Rendering/Ombra/Blend/Internal.hs view
@@ -1,8 +1,7 @@ module Graphics.Rendering.Ombra.Blend.Internal where -import Data.Vect.Float (Vec4(..))-import Data.Vect.Float.Instances () import Graphics.Rendering.Ombra.Internal.GL+import Graphics.Rendering.Ombra.Vector -- | Blend mode data Mode = Mode {
Graphics/Rendering/Ombra/D2.hs view
@@ -37,7 +37,6 @@ View2(..), ) where -import Data.Vect.Float import Graphics.Rendering.Ombra.Backend hiding (Texture, Program) import Graphics.Rendering.Ombra.Geometry import Graphics.Rendering.Ombra.Draw@@ -49,6 +48,7 @@ import Graphics.Rendering.Ombra.Shader.Program import Graphics.Rendering.Ombra.Texture import Graphics.Rendering.Ombra.Transformation+import Graphics.Rendering.Ombra.Vector type Uniforms2D = '[Image, Depth, Transform2]
Graphics/Rendering/Ombra/D3.hs view
@@ -45,7 +45,6 @@ View3(..), ) where -import Data.Vect.Float import Graphics.Rendering.Ombra.Backend hiding (Texture, Program) import Graphics.Rendering.Ombra.Geometry import Graphics.Rendering.Ombra.Color@@ -53,6 +52,7 @@ import Graphics.Rendering.Ombra.Layer import Graphics.Rendering.Ombra.Object import Graphics.Rendering.Ombra.Shapes+import Graphics.Rendering.Ombra.Vector import Graphics.Rendering.Ombra.Internal.TList import Graphics.Rendering.Ombra.Shader.Default3D (Texture2(..), Transform3(..), View3(..)) import Graphics.Rendering.Ombra.Shader.Program hiding (program)
Graphics/Rendering/Ombra/Draw/Internal.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE GADTs, DataKinds, FlexibleContexts, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, KindSignatures,- GeneralizedNewtypeDeriving #-}+ GeneralizedNewtypeDeriving, PolyKinds #-} module Graphics.Rendering.Ombra.Draw.Internal ( Draw,@@ -26,6 +26,7 @@ drawGet ) where +import Data.Proxy import qualified Graphics.Rendering.Ombra.Blend.Internal as Blend import Graphics.Rendering.Ombra.Color import Graphics.Rendering.Ombra.Geometry.Internal@@ -44,9 +45,9 @@ import Graphics.Rendering.Ombra.Shader.Program import Graphics.Rendering.Ombra.Shader.ShaderVar import qualified Graphics.Rendering.Ombra.Stencil.Internal as Stencil+import Graphics.Rendering.Ombra.Vector import Data.Hashable (Hashable)-import Data.Vect.Float import Data.Word (Word8) import Control.Monad (when) import Control.Monad.IO.Class@@ -258,8 +259,9 @@ return b withGlobal :: GLES => Global g -> Draw () -> Draw ()-withGlobal (Single g c) a = uniform single (g undefined) c >> a-withGlobal (Mirror g c) a = uniform mirror (varBuild (const undefined) g) c >> a+withGlobal (Single g c) a = uniform (Proxy :: Proxy 'S) (g undefined) c >> a+withGlobal (Mirror g c) a = uniform (Proxy :: Proxy 'M)+ (varBuild (const undefined) g) c >> a withGlobal (WithTexture t gf) a = withActiveTexture t $ flip withGlobal a . gf withGlobal (WithTextureSize t gf) a = textureSize t >>= flip withGlobal a . gf withGlobal (WithFramebufferSize gf) a = viewportSize <$> drawGet >>=@@ -417,7 +419,7 @@ (ts, attchs, buffersToClear) <- fmap unzip3 . gl . flip mapM infos $ \(internalFormat, format, pixelType, attachment, buffer) ->- do t <- emptyTexture Linear Linear+ do t <- emptyTexture (Linear, Nothing) Linear bindTexture gl_TEXTURE_2D t if pixelType == gl_FLOAT then liftIO noFloat32Array >>=
Graphics/Rendering/Ombra/Geometry.hs view
@@ -27,7 +27,6 @@ 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)@@ -38,6 +37,7 @@ 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+import Graphics.Rendering.Ombra.Vector data Triangle a = Triangle a a a @@ -106,9 +106,10 @@ addAttrList :: Vertex is -> AttrList is -> AttrList is addAttrList (Attr _ x) (AttrListCons (AttrData xs h) rest) =- AttrListCons (AttrData (x : xs) $ hashWithSalt (hash x) h) rest+ --- XXX: ???+ AttrListCons (AttrData (x : xs) $ hashWithSalt (hash x + h) h) rest addAttrList (Attr _ x :~ v') (AttrListCons (AttrData xs h) rest) =- AttrListCons (AttrData (x : xs) $ hashWithSalt (hash x) h) $+ AttrListCons (AttrData (x : xs) $ hashWithSalt (hash x + h) h) $ addAttrList v' rest -- | Create a 3D 'Geometry'.
Graphics/Rendering/Ombra/Geometry/Internal.hs view
@@ -21,7 +21,6 @@ import Control.Monad.Trans.State import qualified Data.Hashable as H import Data.Typeable-import Data.Vect.Float hiding (Normal3) import Data.Word (Word16) import Unsafe.Coerce @@ -33,6 +32,7 @@ import qualified Graphics.Rendering.Ombra.Shader.Default2D as D2 import qualified Graphics.Rendering.Ombra.Shader.Default3D as D3 import Graphics.Rendering.Ombra.Shader.Language.Types (ShaderType(size))+import Graphics.Rendering.Ombra.Vector -- | A heterogeneous list of attributes. data AttrList (is :: [*]) where@@ -185,12 +185,3 @@ bufferData ty bufData gl_STATIC_DRAW bindBuffer ty noBuffer return buffer--instance H.Hashable Vec2 where- hashWithSalt s (Vec2 x y) = H.hashWithSalt s (x, y)--instance H.Hashable Vec3 where- hashWithSalt s (Vec3 x y z) = H.hashWithSalt s (x, y, z)--instance H.Hashable Vec4 where- hashWithSalt s (Vec4 x y z w) = H.hashWithSalt s (x, y, z, w)
Graphics/Rendering/Ombra/Layer/Internal.hs view
@@ -68,9 +68,10 @@ return = Return -- TODO: document buffers.--- | Clear some buffers before drawing a Layer.-clear :: [Buffer] -> Layer' s t a -> Layer' s t a-clear bs = (Clear bs >>)+-- | Layer that clear some buffers. For instance, @clear ['ColorBuffer']@ fills+-- the screen with a black rectangle, without affecting the depth buffer.+clear :: [Buffer] -> Layer' s t ()+clear = Clear -- | Free the temporary resources associated with a NonDrawable layer, before -- drawing it.
Graphics/Rendering/Ombra/Object.hs view
@@ -45,7 +45,6 @@ import Data.Typeable import Data.Type.Equality-import Data.Vect.Float import Data.Word (Word8) import Graphics.Rendering.Ombra.Backend (GLES) import qualified Graphics.Rendering.Ombra.Blend as Blend
Graphics/Rendering/Ombra/Object/Internal.hs view
@@ -5,7 +5,6 @@ import Data.Proxy (Proxy) import Data.Monoid-import Data.Vect.Float import qualified Graphics.Rendering.Ombra.Blend as Blend import qualified Graphics.Rendering.Ombra.Stencil as Stencil import Graphics.Rendering.Ombra.Geometry
Graphics/Rendering/Ombra/Shader.hs view
@@ -1,10 +1,12 @@-{-# LANGUAGE FlexibleContexts, RankNTypes, TypeFamilies #-}+{-# LANGUAGE DataKinds, FlexibleContexts, RankNTypes, MultiParamTypeClasses,+ TypeFamilyDependencies, TypeFamilies, FlexibleInstances,+ UndecidableInstances, DeriveGeneric #-} {-| An example of shader variable: @- data Transform2 = Transform2 Mat3 deriving Generic+ data Transform2 = Transform2 GMat3 deriving Generic @ An example of vertex shader:@@ -21,198 +23,438 @@ -- Set of uniforms: (Transform2 trans :- View2 view :- Depth z :- N) -- Set of attributes:- (Position2 (Vec2 x y) :- uv@(UV _) :- N) =+ (Position2 (GVec2 x y) :- uv@(UV _) :- N) = -- Matrix and vector multiplication:- let Vec3 x' y' _ = view * trans * Vec3 x y 1+ let GVec3 x' y' _ = view .*. trans .* GVec3 x y 1 -- Set of outputs:- in Vertex (Vec4 x' y' z 1) -- Vertex position.+ in Vertex (GVec4 x' y' z 1) -- Vertex position. :- uv :- N @ -Required extensions:--@-\{\-# LANGUAGE DataKinds, RebindableSyntax, DeriveGeneric, GADTs #\-\}-@- -} --- TODO: Alternative version of the module that can be used without--- RebindableSyntax and with Prelude functions. Use Num for scalars, vect--- typeclasses for vectors and matrices, and prefixed functions for the other--- clashing functions.- module Graphics.Rendering.Ombra.Shader (+ module Data.Boolean,+ module Data.VectorSpace, -- * Types- Shader,- VertexShader,- FragmentShader,- VertexShaderOutput(Vertex),- FragmentShaderOutput(..),- ShaderVars,- VOShaderVars,- Uniform,- Attribute,- Generic,- SVList((:-), N),+ Shader.Shader,+ Shader.VertexShader,+ Shader.FragmentShader,+ Shader.VertexShaderOutput(..),+ Shader.FragmentShaderOutput(..),+ Shader.ShaderVars,+ Shader.VOShaderVars,+ Shader.Uniform,+ Shader.Attribute,+ Shader.Generic,+ Shader.SVList(..), -- ** GPU types- Bool,- Float,- Int,- Sampler2D,- SamplerCube,- Vec2(..),- Vec3(..),- Vec4(..),- BVec2(..),- BVec3(..),- BVec4(..),- IVec2(..),- IVec3(..),- IVec4(..),- Mat2(..),- Mat3(..),- Mat4(..),- Array,- -- * Functions- loop,- store,- texture2D,- texture2DBias,- texture2DProj,- texture2DProjBias,- texture2DProj4,- texture2DProjBias4,- texture2DLod,- texture2DProjLod,- texture2DProjLod4,- arrayLength,- -- ** Math functions- radians,- degrees,- sin,- cos,- tan,- asin,- acos,- atan,- atan2,- exp,- log,- exp2,- log2,- sqrt,- inversesqrt,- abs,- sign,- floor,- ceil,- fract,- mod,- min,- max,- clamp,- mix,- step,- smoothstep,- length,- distance,- dot,- cross,- normalize,- faceforward,- reflect,- refract,- matrixCompMult,+ Shader.GBool,+ Shader.GFloat,+ Shader.GInt,+ Shader.GSampler2D,+ Shader.GSamplerCube,+ Shader.GVec2(..),+ Shader.GVec3(..),+ Shader.GVec4(..),+ Shader.GBVec2(..),+ Shader.GBVec3(..),+ Shader.GBVec4(..),+ Shader.GIVec2(..),+ Shader.GIVec3(..),+ Shader.GIVec4(..),+ Shader.GMat2(..),+ Shader.GMat3(..),+ Shader.GMat4(..),+ Shader.GArray,+ -- * GPU functions+ (Shader.!),+ Shader.loop,+ Shader.store,+ Shader.texture2D,+ Shader.texture2DBias,+ Shader.texture2DProj,+ Shader.texture2DProjBias,+ Shader.texture2DProj4,+ Shader.texture2DProjBias4,+ Shader.texture2DLod,+ Shader.texture2DProjLod,+ Shader.texture2DProjLod4,+ Shader.arrayLength,+ -- ** Various math functions+ Matrix(..),+ Ext(..),+ minG,+ maxG,+ modG,+ floorG,+ ceilingG,+ Shader.radians,+ Shader.degrees,+ Shader.exp2,+ Shader.log2,+ Shader.inversesqrt,+ Shader.fract,+ Shader.clamp,+ Shader.mix,+ Shader.step,+ Shader.smoothstep,+ Shader.distance, -- TODO: implement AffineSpace?+ -- Shader.length,+ Shader.faceforward,+ Shader.reflect,+ Shader.refract,+ Shader.matrixCompMult, -- *** Vector relational functions- VecOrd,- VecEq,- lessThan,- lessThanEqual,- greaterThan,- greaterThanEqual,- equal,- notEqual,- BoolVector,- anyB,- allB,- notB,+ Shader.VecOrd,+ Shader.VecEq,+ Shader.lessThan,+ Shader.lessThanEqual,+ Shader.greaterThan,+ Shader.greaterThanEqual,+ Shader.equal,+ Shader.notEqual,+ Shader.GBoolVector,+ Shader.anyBV,+ Shader.allBV,+ Shader.notBV, -- ** Constructors- true,- false,- ToBool,- bool,- ToInt,- int,- ToFloat,- float,- Components,- CompList,- ToCompList,- (#),- ToVec2,- vec2,- ToVec3,- vec3,- ToVec4,- vec4,- ToBVec2,- bvec2,- ToBVec3,- bvec3,- ToBVec4,- bvec4,- ToIVec2,- ivec2,- ToIVec3,- ivec3,- ToIVec4,- ivec4,- ToMat2,- mat2,- ToMat3,- mat3,- ToMat4,- mat4,- -- ** Operators- (*),- (/),- (+),- (-),- (^),- (&&),- (||),- (==),- (>=),- (<=),- (<),- (>),- (!),- -- ** Rebinding functions- fromInteger,- fromRational,- ifThenElse,- negate,- -- ** Prelude functions- (.),- id,- const,- flip,- ($),- CPU.fst,- CPU.snd,- -- * Variables- position,- fragData,- fragCoord,- fragFrontFacing+ Shader.ToGBool,+ Shader.bool,+ Shader.ToGInt,+ Shader.int,+ Shader.ToGFloat,+ Shader.float,+ -- TODO: better vector constructors+ {-+ Shader.Components,+ Shader.CompList,+ Shader.ToCompList,+ (Shader.#),+ Shader.ToGVec2,+ Shader.vec2,+ Shader.ToGVec3,+ Shader.vec3,+ Shader.ToGVec4,+ Shader.vec4,+ Shader.ToGBVec2,+ Shader.bvec2,+ Shader.ToGBVec3,+ Shader.bvec3,+ Shader.ToGBVec4,+ Shader.bvec4,+ Shader.ToGIVec2,+ Shader.ivec2,+ Shader.ToGIVec3,+ Shader.ivec3,+ Shader.ToGIVec4,+ Shader.ivec4,+ Shader.ToGMat2,+ Shader.mat2,+ Shader.ToGMat3,+ Shader.mat3,+ Shader.ToGMat4,+ Shader.mat4,+ -}+ -- ** Other+ Shader.position,+ Shader.fragData,+ Shader.fragCoord,+ Shader.fragFrontFacing,+ -- * Common shader variables+ UV(..) ) where +import Data.Proxy import GHC.Generics (Generic) import Graphics.Rendering.Ombra.Shader.CPU-import Graphics.Rendering.Ombra.Shader.Language.Types-import Graphics.Rendering.Ombra.Shader.Language.Functions-import Graphics.Rendering.Ombra.Shader.ShaderVar+import Graphics.Rendering.Ombra.Shader.Language ((#))+import qualified Graphics.Rendering.Ombra.Shader.Language as Shader+import Graphics.Rendering.Ombra.Shader.ShaderVar hiding (Shader) import Graphics.Rendering.Ombra.Shader.Stages-import Prelude ((.), id, const, flip, ($))-import qualified Prelude as CPU+import Graphics.Rendering.Ombra.Vector++import Data.Boolean+import qualified Data.Boolean.Numbers as B+import Data.Cross+import Data.VectorSpace+import Prelude++data UV = UV Shader.GVec2 deriving Generic++type instance BooleanOf Shader.GBool = Shader.GBool+type instance BooleanOf Shader.GFloat = Shader.GBool+type instance BooleanOf Shader.GInt = Shader.GBool+type instance BooleanOf Shader.GSampler2D = Shader.GBool+type instance BooleanOf Shader.GSamplerCube = Shader.GBool+type instance BooleanOf Shader.GVec2 = Shader.GBool+type instance BooleanOf Shader.GVec3 = Shader.GBool+type instance BooleanOf Shader.GVec4 = Shader.GBool+type instance BooleanOf Shader.GBVec2 = Shader.GBool+type instance BooleanOf Shader.GBVec3 = Shader.GBool+type instance BooleanOf Shader.GBVec4 = Shader.GBool+type instance BooleanOf Shader.GIVec2 = Shader.GBool+type instance BooleanOf Shader.GIVec3 = Shader.GBool+type instance BooleanOf Shader.GIVec4 = Shader.GBool+type instance BooleanOf Shader.GMat2 = Shader.GBool+type instance BooleanOf Shader.GMat3 = Shader.GBool+type instance BooleanOf Shader.GMat4 = Shader.GBool+type instance BooleanOf (Shader.GArray n t) = Shader.GBool++instance Boolean Shader.GBool where+ true = Shader.true+ false = Shader.false+ (&&*) = (Shader.&&)+ (||*) = (Shader.||)+ notB = Shader.not++instance (Shader.ShaderType a, BooleanOf a ~ Shader.GBool) => IfB a where+ ifB = Shader.ifThenElse++instance (Shader.ShaderType a, BooleanOf a ~ Shader.GBool) => EqB a where+ (==*) = (Shader.==)+ (/=*) = (Shader./=)++instance (Shader.ShaderType a, BooleanOf a ~ Shader.GBool) => OrdB a where+ (<*) = (Shader.<)+ (<=*) = (Shader.<=)+ (>*) = (Shader.>)+ (>=*) = (Shader.>=)+ +-- | Faster GPU 'max'/'B.maxB'.+maxG :: Shader.GenTypeGFloat a b => a -> b -> a+maxG = Shader.max++-- | Faster GPU 'min'/'B.minB'.+minG :: Shader.GenTypeGFloat a b => a -> b -> a+minG = Shader.min++instance Num Shader.GFloat where+ (+) = (Shader.+)+ (-) = (Shader.-)+ (*) = (Shader.*)+ abs = Shader.abs+ signum = Shader.sign+ fromInteger = Shader.fromInteger+ negate = Shader.negate++instance Num Shader.GInt where+ (+) = (Shader.+)+ (-) = (Shader.-)+ (*) = (Shader.*)+ abs = Shader.absI+ signum = Shader.signI+ fromInteger = Shader.fromInteger+ negate = Shader.negateI++instance B.NumB Shader.GFloat where+ type IntegerOf Shader.GFloat = Shader.GInt+ fromIntegerB = Shader.float++instance B.NumB Shader.GInt where+ type IntegerOf Shader.GInt = Shader.GInt+ fromIntegerB = id++instance AdditiveGroup Shader.GFloat where+ zeroV = Shader.zero+ (^+^) = (Shader.+)+ (^-^) = (Shader.-)+ negateV = Shader.negate++-- | GPU 'mod' that can be used on floats and float vectors.+modG :: Shader.GenType a => a -> a -> a+modG = Shader.mod++instance B.IntegralB Shader.GInt where+ quotRem a b = let q = a Shader./ b in (q, a - b * q)+ -- XXX: ???+ divMod a b = let (q, r) = B.quotRem a b+ f = 1 - abs (signum r + signum b)+ in (q - f, r + b * f)+ toIntegerB = id++instance Fractional Shader.GFloat where+ (/) = (Shader./)+ fromRational = Shader.fromRational++instance Floating Shader.GFloat where+ pi = 3.1415926535897932384626433832795+ exp = Shader.exp+ log = Shader.log+ sqrt = Shader.sqrt+ (**) = (Shader.^)+ sin = Shader.sin+ cos = Shader.cos+ tan = Shader.tan+ asin = Shader.asin+ acos = Shader.acos+ atan = Shader.atan+ -- TODO+ sinh = error "Hyperbolic functions are not implemented."+ cosh = error "Hyperbolic functions are not implemented."+ asinh = error "Hyperbolic functions are not implemented."+ acosh = error "Hyperbolic functions are not implemented."+ atanh = error "Hyperbolic functions are not implemented."++floatToInt :: (B.NumB b, B.IntegerOf b ~ Shader.GInt) => Shader.GFloat -> b+floatToInt = B.fromIntegerB . Shader.int++instance B.RealFracB Shader.GFloat where+ properFraction x = let tx = signum x * floorG (abs x)+ in (floatToInt tx, x - tx)+ -- truncate x = floatToInt $ signum x * floorG (abs x)+ round x = floatToInt . floorG $ x + 0.5+ ceiling = floatToInt . ceilingG+ floor = floatToInt . floorG++floorG :: Shader.GenType a => a -> a+floorG = Shader.floor++ceilingG :: Shader.GenType a => a -> a+ceilingG = Shader.ceil++instance B.RealFloatB Shader.GFloat where+ isNaN = error "isNaN: not supported"+ isInfinite = error "isInfinite: not supported"+ isNegativeZero = error "isNegativeZero: not supported"+ isIEEE = error "isIEEE: not supported"+ atan2 = Shader.atan2++-- Vectors++instance AdditiveGroup Shader.GVec2 where+ zeroV = Shader.zero+ (^+^) = (Shader.+)+ (^-^) = (Shader.-)+ negateV = Shader.negate++instance VectorSpace Shader.GVec2 where+ type Scalar Shader.GVec2 = Shader.GFloat+ (*^) = (Shader.*)++instance InnerSpace Shader.GVec2 where+ (<.>) = Shader.dot++instance Ext Shader.GVec2 where+ type Extended Shader.GVec2 = Shader.GVec3+ v ^| z = Shader.vec3 $ v # z+ v ^|^ Shader.GVec3 _ _ z = Shader.vec3 $ v # z+ extract = Shader.vec2++instance AdditiveGroup Shader.GVec3 where+ zeroV = Shader.zero+ (^+^) = (Shader.+)+ (^-^) = (Shader.-)+ negateV = Shader.negate++instance VectorSpace Shader.GVec3 where+ type Scalar Shader.GVec3 = Shader.GFloat+ (*^) = (Shader.*)++instance InnerSpace Shader.GVec3 where+ (<.>) = Shader.dot++instance HasCross3 Shader.GVec3 where+ cross3 = Shader.cross++instance Ext Shader.GVec3 where+ type Extended Shader.GVec3 = Shader.GVec4+ v ^| w = Shader.vec4 $ v # w+ v ^|^ Shader.GVec4 _ _ _ w = Shader.vec4 $ v # w+ extract = Shader.vec3++instance AdditiveGroup Shader.GVec4 where+ zeroV = Shader.zero+ (^+^) = (Shader.+)+ (^-^) = (Shader.-)+ negateV = Shader.negate++instance VectorSpace Shader.GVec4 where+ type Scalar Shader.GVec4 = Shader.GFloat+ (*^) = (Shader.*)++instance InnerSpace Shader.GVec4 where+ (<.>) = Shader.dot++-- Matrices++instance AdditiveGroup Shader.GMat2 where+ zeroV = Shader.zero+ (^+^) = (Shader.+)+ (^-^) = (Shader.-)+ negateV = Shader.negateM++instance VectorSpace Shader.GMat2 where+ type Scalar Shader.GMat2 = Shader.GFloat+ (*^) = (Shader.*)++instance AdditiveGroup Shader.GMat3 where+ zeroV = Shader.zero+ (^+^) = (Shader.+)+ (^-^) = (Shader.-)+ negateV = Shader.negateM++instance Ext Shader.GMat2 where+ type Extended Shader.GMat2 = Shader.GMat3+ v ^| z = Shader.mat3 $ v # z # z # z # z # z+ Shader.GMat2 x y ^|^ Shader.GMat3 x' y' z' =+ Shader.GMat3 (x ^|^ x') (y ^|^ y') z'+ extract = Shader.mat2++instance Matrix Shader.GMat2 where+ type Row Shader.GMat2 = Shader.GVec2+ idmtx = Shader.mat2 (1.0 :: Shader.GFloat)+ (.*.) = (Shader.*)+ (.*) = (Shader.*)+ (*.) = (Shader.*)+ transpose (Shader.GMat2 (Shader.GVec2 a b) (Shader.GVec2 c d)) =+ Shader.GMat2 (Shader.GVec2 a c) (Shader.GVec2 b d)++instance VectorSpace Shader.GMat3 where+ type Scalar Shader.GMat3 = Shader.GFloat+ (*^) = (Shader.*)++instance Ext Shader.GMat3 where+ type Extended Shader.GMat3 = Shader.GMat4+ v ^| z = Shader.mat4 $ v # z # z # z # z # z # z # z+ Shader.GMat3 x y z ^|^ Shader.GMat4 x' y' z' w' =+ Shader.GMat4 (x ^|^ x') (y ^|^ y') (z ^|^ z') w'+ extract = Shader.mat3++instance Matrix Shader.GMat3 where+ type Row Shader.GMat3 = Shader.GVec3+ idmtx = Shader.mat3 (1.0 :: Shader.GFloat)+ (.*.) = (Shader.*)+ (.*) = (Shader.*)+ (*.) = (Shader.*)+ transpose (Shader.GMat3 (Shader.GVec3 a b c)+ (Shader.GVec3 d e f)+ (Shader.GVec3 g h i)) =+ Shader.GMat3 (Shader.GVec3 a d g)+ (Shader.GVec3 b e h)+ (Shader.GVec3 c f i)++instance AdditiveGroup Shader.GMat4 where+ zeroV = Shader.zero+ (^+^) = (Shader.+)+ (^-^) = (Shader.-)+ negateV = Shader.negateM++instance VectorSpace Shader.GMat4 where+ type Scalar Shader.GMat4 = Shader.GFloat+ (*^) = (Shader.*)++instance Matrix Shader.GMat4 where+ type Row Shader.GMat4 = Shader.GVec4+ idmtx = Shader.mat4 (1.0 :: Shader.GFloat)+ (.*.) = (Shader.*)+ (.*) = (Shader.*)+ (*.) = (Shader.*)+ transpose (Shader.GMat4 (Shader.GVec4 a b c d)+ (Shader.GVec4 e f g h)+ (Shader.GVec4 i j k l)+ (Shader.GVec4 m n o p)) =+ Shader.GMat4 (Shader.GVec4 a e i m)+ (Shader.GVec4 b f j n)+ (Shader.GVec4 c g k o)+ (Shader.GVec4 d h l p)
Graphics/Rendering/Ombra/Shader/CPU.hs view
@@ -11,26 +11,18 @@ BaseAttribute(..), Uniform(..), Attribute(..),- toGPUBool,- single,- mirror+ toGPUBool ) where -import qualified Data.Int as CPU+import Data.Int import Data.Typeable-import qualified Graphics.Rendering.Ombra.Shader.Language.Types as GPU-import Graphics.Rendering.Ombra.Internal.GL as CPU+import Graphics.Rendering.Ombra.Shader.Language.Types+import Graphics.Rendering.Ombra.Internal.GL+import Graphics.Rendering.Ombra.Vector import GHC.Generics hiding (S) import qualified GHC.Generics as G-import qualified Data.Vect.Float as CPU import Prelude as CPU -single :: Proxy S-single = Proxy--mirror :: Proxy M-mirror = Proxy- -- | This kind represents the way you are setting a GPU value. data CPUSetterType k = S -- ^ Single CPU type (only for types with one field)@@ -48,7 +40,7 @@ -- For instance: -- -- @--- data T = T Vec3 Float -- In the shader module+-- data T = T GVec3 Float -- In the shader module -- data T = T Vec3 Float -- CPU version of the uniform type -- type CPUMirror GPU.T = T -- @@@ -63,7 +55,7 @@ setUniform :: UniformLocation -> proxy g -> CPUBase g -> GL () -- | CPU types convertible to GPU types (as attributes).-class GPU.ShaderType g => BaseAttribute g where+class ShaderType g => BaseAttribute g where encodeAttribute :: proxy g -> [CPUBase g] -> GL AnyArray setAttribute :: proxy g -> GLUInt -> GL () @@ -85,13 +77,13 @@ -> [CPUBase g] -> f ()) -> f () -instance (BaseUniform (GCPUValue (Rep g)), Generic g) => Uniform S g where+instance (BaseUniform (GGPUValue (Rep g)), Generic g) => Uniform S g where withUniforms _ (_ :: g) c f =- f 0 (Proxy :: Proxy (GCPUValue (Rep g))) c+ f 0 (Proxy :: Proxy (GGPUValue (Rep g))) c -instance (BaseAttribute (GCPUValue (Rep g)), Generic g) => Attribute S g where+instance (BaseAttribute (GGPUValue (Rep g)), Generic g) => Attribute S g where withAttributes _ (_ :: g) c f =- f 0 (Proxy :: Proxy (GCPUValue (Rep g))) c+ f 0 (Proxy :: Proxy (GGPUValue (Rep g))) c instance ( GUniformMirror (Rep g) (Rep (CPUMirror g)) (TData (Rep (CPUMirror g)))@@ -124,12 +116,12 @@ TCons (M1 D d a) = TCons a TCons (M1 C c a) = c -type family GCPUValue (g :: * -> *) where- GCPUValue (M1 i c a) = GCPUValue a- GCPUValue (K1 i a) = a+type family GGPUValue (g :: * -> *) where+ GGPUValue (M1 i c a) = GGPUValue a+ GGPUValue (K1 i a) = a type CPUSingle g = GCPUSingle (Rep g)-type GCPUSingle g = CPUBase (GCPUValue g)+type GCPUSingle g = CPUBase (GGPUValue g) type family GCPUMirror (g :: * -> *) d c :: * -> * where@@ -205,209 +197,209 @@ -- Float -type instance CPUBase GPU.Float = CPU.Float-type instance CPUBase (GPU.Array n GPU.Float) = [CPU.Float]+type instance CPUBase GFloat = Float+type instance CPUBase (GArray n GFloat) = [Float] -instance GLES => BaseUniform GPU.Float where+instance GLES => BaseUniform GFloat where setUniform l _ = uniform1f l -instance GLES => BaseUniform (GPU.Array n GPU.Float) where+instance GLES => BaseUniform (GArray n GFloat) where setUniform l _ v = liftIO (encodeFloats v) >>= uniform1fv l -instance GLES => BaseAttribute GPU.Float where+instance GLES => BaseAttribute GFloat where encodeAttribute _ a = liftIO . fmap fromFloat32Array $ encodeFloats a setAttribute _ i = attr gl_FLOAT i 1 -- Bool -type instance CPUBase GPU.Bool = CPU.Int32-type instance CPUBase (GPU.Array n GPU.Bool) = [CPU.Int32]+type instance CPUBase GBool = Int32+type instance CPUBase (GArray n GBool) = [Int32] -instance GLES => BaseUniform GPU.Bool where+instance GLES => BaseUniform GBool where setUniform l _ = uniform1i l -instance GLES => BaseUniform (GPU.Array n GPU.Bool) where+instance GLES => BaseUniform (GArray n GBool) where setUniform l _ v = liftIO (encodeInts v) >>= uniform1iv l -instance GLES => BaseAttribute GPU.Bool where+instance GLES => BaseAttribute GBool where encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeInts a setAttribute _ i = attr gl_INT i 1 -- Int -type instance CPUBase GPU.Int = CPU.Int32-type instance CPUBase (GPU.Array n GPU.Int) = [CPU.Int32]+type instance CPUBase GInt = Int32+type instance CPUBase (GArray n GInt) = [Int32] -instance GLES => BaseUniform GPU.Int where+instance GLES => BaseUniform GInt where setUniform l _ = uniform1i l -instance GLES => BaseUniform (GPU.Array n GPU.Int) where+instance GLES => BaseUniform (GArray n GInt) where setUniform l _ v = liftIO (encodeInts v) >>= uniform1iv l -instance GLES => BaseAttribute GPU.Int where+instance GLES => BaseAttribute GInt where encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeInts a setAttribute _ i = attr gl_INT i 1 -- TODO: sampler arrays (they're problematic to safely access in the shaders) -- Samplers -type instance CPUBase GPU.Sampler2D = CPU.ActiveTexture-type instance CPUBase GPU.SamplerCube = CPU.ActiveTexture+type instance CPUBase GSampler2D = ActiveTexture+type instance CPUBase GSamplerCube = ActiveTexture -instance GLES => BaseUniform GPU.Sampler2D where- setUniform l _ (CPU.ActiveTexture v) = uniform1i l $ fromIntegral v+instance GLES => BaseUniform GSampler2D where+ setUniform l _ (ActiveTexture v) = uniform1i l $ fromIntegral v -instance GLES => BaseUniform GPU.SamplerCube where- setUniform l _ (CPU.ActiveTexture v) = uniform1i l $ fromIntegral v+instance GLES => BaseUniform GSamplerCube where+ setUniform l _ (ActiveTexture v) = uniform1i l $ fromIntegral v -- Vec2 -type instance CPUBase GPU.Vec2 = CPU.Vec2-type instance CPUBase (GPU.Array n GPU.Vec2) = [CPU.Vec2]+type instance CPUBase GVec2 = Vec2+type instance CPUBase (GArray n GVec2) = [Vec2] -instance GLES => BaseUniform GPU.Vec2 where- setUniform l _ (CPU.Vec2 x y) = uniform2f l x y+instance GLES => BaseUniform GVec2 where+ setUniform l _ (Vec2 x y) = uniform2f l x y -instance GLES => BaseUniform (GPU.Array n GPU.Vec2) where+instance GLES => BaseUniform (GArray n GVec2) where setUniform l _ v = liftIO (encodeVec2s v) >>= uniform2fv l -instance GLES => BaseAttribute GPU.Vec2 where+instance GLES => BaseAttribute GVec2 where encodeAttribute _ a = liftIO . fmap fromFloat32Array $ encodeVec2s a setAttribute _ i = attr gl_FLOAT i 2 -- Vec3 -type instance CPUBase GPU.Vec3 = CPU.Vec3-type instance CPUBase (GPU.Array n GPU.Vec3) = [CPU.Vec3]+type instance CPUBase GVec3 = Vec3+type instance CPUBase (GArray n GVec3) = [Vec3] -instance GLES => BaseUniform GPU.Vec3 where- setUniform l _ (CPU.Vec3 x y z) = uniform3f l x y z+instance GLES => BaseUniform GVec3 where+ setUniform l _ (Vec3 x y z) = uniform3f l x y z -instance GLES => BaseUniform (GPU.Array n GPU.Vec3) where+instance GLES => BaseUniform (GArray n GVec3) where setUniform l _ v = liftIO (encodeVec3s v) >>= uniform3fv l -instance GLES => BaseAttribute GPU.Vec3 where+instance GLES => BaseAttribute GVec3 where encodeAttribute _ a = liftIO . fmap fromFloat32Array $ encodeVec3s a setAttribute _ i = attr gl_FLOAT i 3 -- Vec4 -type instance CPUBase GPU.Vec4 = CPU.Vec4-type instance CPUBase (GPU.Array n GPU.Vec4) = [CPU.Vec4]+type instance CPUBase GVec4 = Vec4+type instance CPUBase (GArray n GVec4) = [Vec4] -instance GLES => BaseUniform GPU.Vec4 where- setUniform l _ (CPU.Vec4 x y z w) = uniform4f l x y z w+instance GLES => BaseUniform GVec4 where+ setUniform l _ (Vec4 x y z w) = uniform4f l x y z w -instance GLES => BaseUniform (GPU.Array n GPU.Vec4) where+instance GLES => BaseUniform (GArray n GVec4) where setUniform l _ v = liftIO (encodeVec4s v) >>= uniform4fv l -instance GLES => BaseAttribute GPU.Vec4 where+instance GLES => BaseAttribute GVec4 where encodeAttribute _ a = liftIO . fmap fromFloat32Array $ encodeVec4s a setAttribute _ i = attr gl_FLOAT i 4 -- IVec2 -type instance CPUBase GPU.IVec2 = CPU.IVec2-type instance CPUBase (GPU.Array n GPU.IVec2) = [CPU.IVec2]+type instance CPUBase GIVec2 = IVec2+type instance CPUBase (GArray n GIVec2) = [IVec2] -instance GLES => BaseUniform GPU.IVec2 where- setUniform l _ (CPU.IVec2 x y) = uniform2i l x y+instance GLES => BaseUniform GIVec2 where+ setUniform l _ (IVec2 x y) = uniform2i l x y -instance GLES => BaseUniform (GPU.Array n GPU.IVec2) where+instance GLES => BaseUniform (GArray n GIVec2) where setUniform l _ v = liftIO (encodeIVec2s v) >>= uniform2iv l -instance GLES => BaseAttribute GPU.IVec2 where+instance GLES => BaseAttribute GIVec2 where encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeIVec2s a setAttribute _ i = attr gl_INT i 2 -- IVec3 -type instance CPUBase GPU.IVec3 = CPU.IVec3-type instance CPUBase (GPU.Array n GPU.IVec3) = [CPU.IVec3]+type instance CPUBase GIVec3 = IVec3+type instance CPUBase (GArray n GIVec3) = [IVec3] -instance GLES => BaseUniform GPU.IVec3 where- setUniform l _ (CPU.IVec3 x y z) = uniform3i l x y z+instance GLES => BaseUniform GIVec3 where+ setUniform l _ (IVec3 x y z) = uniform3i l x y z -instance GLES => BaseUniform (GPU.Array n GPU.IVec3) where+instance GLES => BaseUniform (GArray n GIVec3) where setUniform l _ v = liftIO (encodeIVec3s v) >>= uniform3iv l -instance GLES => BaseAttribute GPU.IVec3 where+instance GLES => BaseAttribute GIVec3 where encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeIVec3s a setAttribute _ i = attr gl_INT i 3 -- IVec4 -type instance CPUBase GPU.IVec4 = CPU.IVec4-type instance CPUBase (GPU.Array n GPU.IVec4) = [CPU.IVec4]+type instance CPUBase GIVec4 = IVec4+type instance CPUBase (GArray n GIVec4) = [IVec4] -instance GLES => BaseUniform GPU.IVec4 where- setUniform l _ (CPU.IVec4 x y z w) = uniform4i l x y z w+instance GLES => BaseUniform GIVec4 where+ setUniform l _ (IVec4 x y z w) = uniform4i l x y z w -instance GLES => BaseUniform (GPU.Array n GPU.IVec4) where+instance GLES => BaseUniform (GArray n GIVec4) where setUniform l _ v = liftIO (encodeIVec4s v) >>= uniform4iv l -instance GLES => BaseAttribute GPU.IVec4 where+instance GLES => BaseAttribute GIVec4 where encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeIVec4s a setAttribute _ i = attr gl_INT i 4 -- BVec2 -type instance CPUBase GPU.BVec2 = CPU.IVec2-type instance CPUBase (GPU.Array n GPU.BVec2) = [CPU.IVec2]+type instance CPUBase GBVec2 = IVec2+type instance CPUBase (GArray n GBVec2) = [IVec2] -instance GLES => BaseUniform GPU.BVec2 where- setUniform l _ (CPU.IVec2 x y) = uniform2i l x y+instance GLES => BaseUniform GBVec2 where+ setUniform l _ (IVec2 x y) = uniform2i l x y -instance GLES => BaseUniform (GPU.Array n GPU.BVec2) where+instance GLES => BaseUniform (GArray n GBVec2) where setUniform l _ v = liftIO (encodeIVec2s v) >>= uniform2iv l -instance GLES => BaseAttribute GPU.BVec2 where+instance GLES => BaseAttribute GBVec2 where encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeIVec2s a setAttribute _ i = attr gl_INT i 2 -- BVec3 -type instance CPUBase GPU.BVec3 = CPU.IVec3-type instance CPUBase (GPU.Array n GPU.BVec3) = [CPU.IVec3]+type instance CPUBase GBVec3 = IVec3+type instance CPUBase (GArray n GBVec3) = [IVec3] -instance GLES => BaseUniform GPU.BVec3 where- setUniform l _ (CPU.IVec3 x y z) = uniform3i l x y z+instance GLES => BaseUniform GBVec3 where+ setUniform l _ (IVec3 x y z) = uniform3i l x y z -instance GLES => BaseUniform (GPU.Array n GPU.BVec3) where+instance GLES => BaseUniform (GArray n GBVec3) where setUniform l _ v = liftIO (encodeIVec3s v) >>= uniform3iv l -instance GLES => BaseAttribute GPU.BVec3 where+instance GLES => BaseAttribute GBVec3 where encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeIVec3s a setAttribute _ i = attr gl_INT i 3 -- BVec4 -type instance CPUBase GPU.BVec4 = CPU.IVec4-type instance CPUBase (GPU.Array n GPU.BVec4) = [CPU.IVec4]+type instance CPUBase GBVec4 = IVec4+type instance CPUBase (GArray n GBVec4) = [IVec4] -instance GLES => BaseUniform GPU.BVec4 where- setUniform l _ (CPU.IVec4 x y z w) = uniform4i l x y z w+instance GLES => BaseUniform GBVec4 where+ setUniform l _ (IVec4 x y z w) = uniform4i l x y z w -instance GLES => BaseUniform (GPU.Array n GPU.BVec4) where+instance GLES => BaseUniform (GArray n GBVec4) where setUniform l _ v = liftIO (encodeIVec4s v) >>= uniform4iv l -instance GLES => BaseAttribute GPU.BVec4 where+instance GLES => BaseAttribute GBVec4 where encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeIVec4s a setAttribute _ i = attr gl_INT i 4 -- Matrices -type instance CPUBase GPU.Mat2 = CPU.Mat2-type instance CPUBase GPU.Mat3 = CPU.Mat3-type instance CPUBase GPU.Mat4 = CPU.Mat4+type instance CPUBase GMat2 = Mat2+type instance CPUBase GMat3 = Mat3+type instance CPUBase GMat4 = Mat4 -instance GLES => BaseUniform GPU.Mat2 where+instance GLES => BaseUniform GMat2 where setUniform l _ m = liftIO (encodeMat2 m) >>= uniformMatrix2fv l false -instance GLES => BaseUniform GPU.Mat3 where+instance GLES => BaseUniform GMat3 where setUniform l _ m = liftIO (encodeMat3 m) >>= uniformMatrix3fv l false -instance GLES => BaseUniform GPU.Mat4 where+instance GLES => BaseUniform GMat4 where setUniform l _ m = liftIO (encodeMat4 m) >>= uniformMatrix4fv l false class BaseUniforms (xs :: [*])@@ -423,6 +415,6 @@ attr :: GLES => GLEnum -> GLUInt -> GLInt -> GL () attr t i s = vertexAttribPointer i s t false 0 nullGLPtr -toGPUBool :: CPU.Bool -> CPU.Int32+toGPUBool :: Bool -> Int32 toGPUBool True = 1 toGPUBool False = 0
Graphics/Rendering/Ombra/Shader/Default2D.hs view
@@ -1,6 +1,17 @@-{-# LANGUAGE DataKinds, RebindableSyntax, DeriveGeneric, GADTs #-}+{-# LANGUAGE DataKinds, DeriveGeneric, GADTs #-} -module Graphics.Rendering.Ombra.Shader.Default2D where+module Graphics.Rendering.Ombra.Shader.Default2D (+ Uniforms,+ Attributes,+ Image(..),+ Depth(..),+ Transform2(..),+ View2(..),+ Position2(..),+ UV(..),+ vertexShader,+ fragmentShader+) where import Graphics.Rendering.Ombra.Shader @@ -8,28 +19,26 @@ type Attributes = '[Position2, UV] -- | An uniform that represents the texture used in the default 2D shader.-data Image = Image Sampler2D deriving Generic+data Image = Image GSampler2D deriving Generic -- | An uniform that represents the depth used in the default 2D shader.-data Depth = Depth Float deriving Generic+data Depth = Depth GFloat deriving Generic -- | An uniform that represents the transformation matrix used in the default -- 2D shader.-data Transform2 = Transform2 Mat3 deriving Generic+data Transform2 = Transform2 GMat3 deriving Generic -- | An uniform that represents the view matrix used in the default 2D shader.-data View2 = View2 Mat3 deriving Generic--data Position2 = Position2 Vec2 deriving Generic+data View2 = View2 GMat3 deriving Generic -data UV = UV Vec2 deriving Generic+data Position2 = Position2 GVec2 deriving Generic vertexShader :: VertexShader '[Transform2, View2, Depth] '[Position2, UV] '[UV] vertexShader (Transform2 trans :- View2 view :- Depth z :- N)- (Position2 (Vec2 x y) :- uv@(UV _) :- N) =- let Vec3 x' y' _ = view * trans * Vec3 x y 1- in Vertex (Vec4 x' y' z 1) :- uv :- N+ (Position2 pos :- uv@(UV _) :- N) =+ let GVec3 x' y' _ = view .*. trans .* (pos ^| 1)+ in Vertex (GVec4 x' y' z 1) :- uv :- N fragmentShader :: FragmentShader '[Image] '[UV]-fragmentShader (Image sampler :- N) (UV (Vec2 s t) :- N) =- Fragment (texture2D sampler (Vec2 s $ 1 - t)) :- N+fragmentShader (Image sampler :- N) (UV (GVec2 s t) :- N) =+ Fragment (texture2D sampler (GVec2 s $ 1 - t)) :- N
Graphics/Rendering/Ombra/Shader/Default3D.hs view
@@ -1,35 +1,44 @@-{-# LANGUAGE DataKinds, RebindableSyntax, DeriveGeneric, GADTs #-}+{-# LANGUAGE DataKinds, DeriveGeneric, GADTs #-} -module Graphics.Rendering.Ombra.Shader.Default3D where+module Graphics.Rendering.Ombra.Shader.Default3D (+ Uniforms,+ Attributes,+ Texture2(..),+ Transform3(..),+ View3(..),+ Position3(..),+ UV(..),+ Normal3(..),+ vertexShader,+ fragmentShader+) where import Graphics.Rendering.Ombra.Shader type Uniforms = '[View3, Transform3, Texture2] type Attributes = '[Position3, UV, Normal3] -data Texture2 = Texture2 Sampler2D deriving Generic--data Transform3 = Transform3 Mat4 deriving Generic+data Texture2 = Texture2 GSampler2D deriving Generic -data View3 = View3 Mat4 deriving Generic+data Transform3 = Transform3 GMat4 deriving Generic -data Position3 = Position3 Vec3 deriving Generic+data View3 = View3 GMat4 deriving Generic -data Normal3 = Normal3 Vec3 deriving Generic+data Position3 = Position3 GVec3 deriving Generic -data UV = UV Vec2 deriving Generic+data Normal3 = Normal3 GVec3 deriving Generic vertexShader :: VertexShader '[ Transform3, View3 ] '[ Position3, UV, Normal3 ] '[ Position3, UV, Normal3 ]-vertexShader (Transform3 modelMatrix :- View3 viewMatrix :- N)+vertexShader (Transform3 modelGMatrix :- View3 viewGMatrix :- N) (Position3 pos :- uv :- Normal3 norm :- N) =- let worldPos = modelMatrix * vec4 (pos # 1.0)- viewPos = viewMatrix * worldPos- worldNorm = vec3 $ modelMatrix * vec4 (norm # 0.0)- in Vertex viewPos :- Position3 (vec3 worldPos) :-+ let worldPos = store $ modelGMatrix .* (pos ^| 1.0)+ viewPos = viewGMatrix .* worldPos+ worldNorm = extract $ modelGMatrix .* (norm ^| 0)+ in Vertex viewPos :- Position3 (extract worldPos) :- uv :- Normal3 worldNorm :- N fragmentShader :: FragmentShader '[ Texture2 ] [ Position3, UV, Normal3 ]-fragmentShader (Texture2 sampler :- N) (_ :- UV (Vec2 s t) :- _ :- N) =- Fragment (texture2D sampler $ Vec2 s (1 - t)) :- N+fragmentShader (Texture2 sampler :- N) (_ :- UV (GVec2 s t) :- _ :- N) =+ Fragment (texture2D sampler $ GVec2 s (1 - t)) :- N
+ Graphics/Rendering/Ombra/Shader/Language.hs view
@@ -0,0 +1,186 @@+{-# LANGUAGE FlexibleContexts, RankNTypes, TypeFamilies #-}++module Graphics.Rendering.Ombra.Shader.Language (+ -- * Types+ Shader,+ VertexShader,+ FragmentShader,+ VertexShaderOutput(Vertex),+ FragmentShaderOutput(..),+ ShaderType(zero),+ ShaderVars,+ VOShaderVars,+ Uniform,+ Attribute,+ Generic,+ SVList((:-), N),+ -- ** GPU types+ GenType,+ GenTypeGFloat,+ GMatrix,+ GBool,+ GFloat,+ GInt,+ GSampler2D,+ GSamplerCube,+ GVec2(..),+ GVec3(..),+ GVec4(..),+ GBVec2(..),+ GBVec3(..),+ GBVec4(..),+ GIVec2(..),+ GIVec3(..),+ GIVec4(..),+ GMat2(..),+ GMat3(..),+ GMat4(..),+ GArray,+ -- * Functions+ loop,+ store,+ texture2D,+ texture2DBias,+ texture2DProj,+ texture2DProjBias,+ texture2DProj4,+ texture2DProjBias4,+ texture2DLod,+ texture2DProjLod,+ texture2DProjLod4,+ arrayLength,+ -- ** Math functions+ radians,+ degrees,+ sin,+ cos,+ tan,+ asin,+ acos,+ atan,+ atan2,+ exp,+ log,+ exp2,+ log2,+ sqrt,+ inversesqrt,+ abs,+ absI,+ sign,+ signI,+ floor,+ ceil,+ fract,+ mod,+ min,+ max,+ clamp,+ mix,+ step,+ smoothstep,+ length,+ distance,+ dot,+ cross,+ normalize,+ faceforward,+ reflect,+ refract,+ matrixCompMult,+ -- *** Vector relational functions+ VecOrd,+ VecEq,+ lessThan,+ lessThanEqual,+ greaterThan,+ greaterThanEqual,+ equal,+ notEqual,+ GBoolVector,+ anyBV,+ allBV,+ notBV,+ -- ** Constructors+ true,+ false,+ ToGBool,+ bool,+ ToGInt,+ int,+ ToGFloat,+ float,+ Components,+ CompList,+ ToCompList,+ (#),+ ToGVec2,+ vec2,+ ToGVec3,+ vec3,+ ToGVec4,+ vec4,+ ToGBVec2,+ bvec2,+ ToGBVec3,+ bvec3,+ ToGBVec4,+ bvec4,+ ToGIVec2,+ ivec2,+ ToGIVec3,+ ivec3,+ ToGIVec4,+ ivec4,+ ToGMat2,+ mat2,+ ToGMat3,+ mat3,+ ToGMat4,+ mat4,+ -- ** Operators+ (*),+ (/),+ (+),+ (-),+ (^),+ (&&),+ (||),+ (==),+ (/=),+ (>=),+ (<=),+ (<),+ (>),+ (!),+ not,+ -- ** Rebinding functions+ fromInteger,+ fromRational,+ ifThenElse,+ negate,+ negateI,+ negateM,+ -- ** Prelude functions+ (.),+ id,+ const,+ flip,+ ($),+ CPU.fst,+ CPU.snd,+ -- * Variables+ position,+ fragData,+ fragCoord,+ fragFrontFacing+) where++import GHC.Generics (Generic)+import Graphics.Rendering.Ombra.Shader.CPU+import Graphics.Rendering.Ombra.Shader.Language.Types+import Graphics.Rendering.Ombra.Shader.Language.Functions+import Graphics.Rendering.Ombra.Shader.ShaderVar+import Graphics.Rendering.Ombra.Shader.Stages+import Prelude ((.), id, const, flip, ($))+import qualified Prelude as CPU
Graphics/Rendering/Ombra/Shader/Language/Functions.hs view
@@ -8,23 +8,23 @@ import GHC.TypeLits import Text.Printf-import Prelude (String, (.), ($), error)+import Prelude (String, (.), ($), error, Int, Integer, Float) import qualified Prelude -- TODO: memoized versions of the functions class Base a b | a -> b-instance Base Int Int-instance Base IVec2 Int-instance Base IVec3 Int-instance Base IVec4 Int-instance Base Float Float-instance Base Vec2 Float-instance Base Vec3 Float-instance Base Vec4 Float-instance Base Mat2 Float-instance Base Mat3 Float-instance Base Mat4 Float+instance Base GInt GInt+instance Base GIVec2 GInt+instance Base GIVec3 GInt+instance Base GIVec4 GInt+instance Base GFloat GFloat+instance Base GVec2 GFloat+instance Base GVec3 GFloat+instance Base GVec4 GFloat+instance Base GMat2 GFloat+instance Base GMat3 GFloat+instance Base GMat4 GFloat class (Base a aBase, Base b bBase) => Arithmetic aBase bBase a b result | a b -> result@@ -32,36 +32,36 @@ , a -> aBase bBase , result -> aBase bBase -instance Arithmetic Float Float Float Float Float-instance Arithmetic Float Float Vec2 Vec2 Vec2-instance Arithmetic Float Float Vec3 Vec3 Vec3-instance Arithmetic Float Float Vec4 Vec4 Vec4-instance Arithmetic Float Float Vec2 Float Vec2-instance Arithmetic Float Float Vec3 Float Vec3-instance Arithmetic Float Float Vec4 Float Vec4-instance Arithmetic Float Float Float Vec2 Vec2-instance Arithmetic Float Float Float Vec3 Vec3-instance Arithmetic Float Float Float Vec4 Vec4-instance Arithmetic Float Float Mat2 Mat2 Mat2-instance Arithmetic Float Float Mat3 Mat3 Mat3-instance Arithmetic Float Float Mat4 Mat4 Mat4-instance Arithmetic Float Float Mat2 Float Mat2-instance Arithmetic Float Float Mat3 Float Mat3-instance Arithmetic Float Float Mat4 Float Mat4-instance Arithmetic Float Float Float Mat2 Mat2-instance Arithmetic Float Float Float Mat3 Mat3-instance Arithmetic Float Float Float Mat4 Mat4+instance Arithmetic GFloat GFloat GFloat GFloat GFloat+instance Arithmetic GFloat GFloat GVec2 GVec2 GVec2+instance Arithmetic GFloat GFloat GVec3 GVec3 GVec3+instance Arithmetic GFloat GFloat GVec4 GVec4 GVec4+instance Arithmetic GFloat GFloat GVec2 GFloat GVec2+instance Arithmetic GFloat GFloat GVec3 GFloat GVec3+instance Arithmetic GFloat GFloat GVec4 GFloat GVec4+instance Arithmetic GFloat GFloat GFloat GVec2 GVec2+instance Arithmetic GFloat GFloat GFloat GVec3 GVec3+instance Arithmetic GFloat GFloat GFloat GVec4 GVec4+instance Arithmetic GFloat GFloat GMat2 GMat2 GMat2+instance Arithmetic GFloat GFloat GMat3 GMat3 GMat3+instance Arithmetic GFloat GFloat GMat4 GMat4 GMat4+instance Arithmetic GFloat GFloat GMat2 GFloat GMat2+instance Arithmetic GFloat GFloat GMat3 GFloat GMat3+instance Arithmetic GFloat GFloat GMat4 GFloat GMat4+instance Arithmetic GFloat GFloat GFloat GMat2 GMat2+instance Arithmetic GFloat GFloat GFloat GMat3 GMat3+instance Arithmetic GFloat GFloat GFloat GMat4 GMat4 -instance Arithmetic Int Int Int Int Int-instance Arithmetic Int Int IVec2 IVec2 IVec2-instance Arithmetic Int Int IVec3 IVec3 IVec3-instance Arithmetic Int Int IVec4 IVec4 IVec4-instance Arithmetic Int Int IVec2 Int IVec2-instance Arithmetic Int Int IVec3 Int IVec3-instance Arithmetic Int Int IVec4 Int IVec4-instance Arithmetic Int Int Int IVec2 IVec2-instance Arithmetic Int Int Int IVec3 IVec3-instance Arithmetic Int Int Int IVec4 IVec4+instance Arithmetic GInt GInt GInt GInt GInt+instance Arithmetic GInt GInt GIVec2 GIVec2 GIVec2+instance Arithmetic GInt GInt GIVec3 GIVec3 GIVec3+instance Arithmetic GInt GInt GIVec4 GIVec4 GIVec4+instance Arithmetic GInt GInt GIVec2 GInt GIVec2+instance Arithmetic GInt GInt GIVec3 GInt GIVec3+instance Arithmetic GInt GInt GIVec4 GInt GIVec4+instance Arithmetic GInt GInt GInt GIVec2 GIVec2+instance Arithmetic GInt GInt GInt GIVec3 GIVec3+instance Arithmetic GInt GInt GInt GIVec4 GIVec4 -- | Types that can be multiplied. class (Base a aBase, Base b bBase) =>@@ -69,32 +69,32 @@ , b -> aBase bBase , a -> aBase bBase , result -> aBase bBase-instance Mul Float Float Mat2 Vec2 Vec2-instance Mul Float Float Mat3 Vec3 Vec3-instance Mul Float Float Mat4 Vec4 Vec4-instance Mul Float Float Vec2 Mat2 Vec2-instance Mul Float Float Vec3 Mat3 Vec3-instance Mul Float Float Vec4 Mat4 Vec4+instance Mul GFloat GFloat GMat2 GVec2 GVec2+instance Mul GFloat GFloat GMat3 GVec3 GVec3+instance Mul GFloat GFloat GMat4 GVec4 GVec4+instance Mul GFloat GFloat GVec2 GMat2 GVec2+instance Mul GFloat GFloat GVec3 GMat3 GVec3+instance Mul GFloat GFloat GVec4 GMat4 GVec4 instance {-# OVERLAPPABLE #-} ( Arithmetic aBase bBase a b result , Base a aBase, Base b bBase) => Mul aBase bBase a b result -class (ShaderType a, Base a Float) => FloatVec a-instance FloatVec Vec2-instance FloatVec Vec3-instance FloatVec Vec4+class (ShaderType a, Base a GFloat) => GFloatVec a+instance GFloatVec GVec2+instance GFloatVec GVec3+instance GFloatVec GVec4 --- | Floats or vectors.+-- | GFloats or vectors. class ShaderType a => GenType a-instance {-# OVERLAPS #-} GenType Float-instance {-# OVERLAPPABLE #-} (FloatVec a, ShaderType a) => GenType a+instance {-# OVERLAPS #-} GenType GFloat+instance {-# OVERLAPPABLE #-} (GFloatVec a, ShaderType a) => GenType a -type family GenTypeFloatConstr a b where- GenTypeFloatConstr a Float = GenType a- GenTypeFloatConstr a a = GenType a+type family GenTypeGFloatConstr a b where+ GenTypeGFloatConstr a GFloat = GenType a+ GenTypeGFloatConstr a a = GenType a -type GenTypeFloat a b = (GenTypeFloatConstr a b, ShaderType a, ShaderType b)+type GenTypeGFloat a b = (GenTypeGFloatConstr a b, ShaderType a, ShaderType b) infixl 7 * (*) :: (Mul aBase bBase a b c, ShaderType a, ShaderType b, ShaderType c)@@ -121,109 +121,115 @@ (^) = fun2 "pow" infixr 3 &&-(&&) :: Bool -> Bool -> Bool+(&&) :: GBool -> GBool -> GBool (&&) = op2 "&&" infixr 2 ||-(||) :: Bool -> Bool -> Bool+(||) :: GBool -> GBool -> GBool (||) = op2 "||" infix 4 ==-(==) :: ShaderType a => a -> a -> Bool+(==) :: ShaderType a => a -> a -> GBool (==) = op2 "==" infix 4 /=-(/=) :: ShaderType a => a -> a -> Bool+(/=) :: ShaderType a => a -> a -> GBool (/=) = op2 "!=" infix 4 >=-(>=) :: ShaderType a => a -> a -> Bool+(>=) :: ShaderType a => a -> a -> GBool (>=) = op2 ">=" infix 4 <=-(<=) :: ShaderType a => a -> a -> Bool+(<=) :: ShaderType a => a -> a -> GBool (<=) = op2 "<=" infix 4 <-(<) :: ShaderType a => a -> a -> Bool+(<) :: ShaderType a => a -> a -> GBool (<) = op2 "<" infix 4 >-(>) :: ShaderType a => a -> a -> Bool+(>) :: ShaderType a => a -> a -> GBool (>) = op2 ">" class ShaderType a => VecOrd a-instance VecOrd Vec2-instance VecOrd Vec3-instance VecOrd Vec4-instance VecOrd IVec2-instance VecOrd IVec3-instance VecOrd IVec4+instance VecOrd GVec2+instance VecOrd GVec3+instance VecOrd GVec4+instance VecOrd GIVec2+instance VecOrd GIVec3+instance VecOrd GIVec4 class ShaderType a => VecEq a-instance VecEq Vec2-instance VecEq Vec3-instance VecEq Vec4-instance VecEq IVec2-instance VecEq IVec3-instance VecEq IVec4-instance VecEq BVec2-instance VecEq BVec3-instance VecEq BVec4+instance VecEq GVec2+instance VecEq GVec3+instance VecEq GVec4+instance VecEq GIVec2+instance VecEq GIVec3+instance VecEq GIVec4+instance VecEq GBVec2+instance VecEq GBVec3+instance VecEq GBVec4 -lessThan :: VecOrd a => a -> a -> Bool+lessThan :: VecOrd a => a -> a -> GBool lessThan = fun2 "lessThan" -lessThanEqual :: VecOrd a => a -> a -> Bool+lessThanEqual :: VecOrd a => a -> a -> GBool lessThanEqual = fun2 "lessThanEqual" -greaterThan :: VecOrd a => a -> a -> Bool+greaterThan :: VecOrd a => a -> a -> GBool greaterThan = fun2 "greaterThan" -greaterThanEqual :: VecOrd a => a -> a -> Bool+greaterThanEqual :: VecOrd a => a -> a -> GBool greaterThanEqual = fun2 "greaterThanEqual" -equal :: VecEq a => a -> a -> Bool+equal :: VecEq a => a -> a -> GBool equal = fun2 "equal" -notEqual :: VecEq a => a -> a -> Bool+notEqual :: VecEq a => a -> a -> GBool notEqual = fun2 "notEqual" -class ShaderType a => BoolVector a-instance BoolVector BVec2-instance BoolVector BVec3-instance BoolVector BVec4+class ShaderType a => GBoolVector a+instance GBoolVector GBVec2+instance GBoolVector GBVec3+instance GBoolVector GBVec4 -anyB :: BoolVector a => a -> Bool-anyB = fun1 "any"+anyBV :: GBoolVector a => a -> GBool+anyBV = fun1 "any" -allB :: BoolVector a => a -> Bool-allB = fun1 "all"+allBV :: GBoolVector a => a -> GBool+allBV = fun1 "all" -notB :: BoolVector a => a -> Bool-notB = fun1 "not"+notBV :: GBoolVector a => a -> GBool+notBV = fun1 "not" negate :: GenType a => a -> a negate = op1 "-" -not :: GenType a => a -> a+negateM :: GMatrix a => a -> a+negateM = op1 "-"++negateI :: GInt -> GInt+negateI = op1 "-"++not :: GBool -> GBool not = op1 "!" class (ShaderType a, Base a a) => Num a where- fromInteger :: Prelude.Integer -> a+ fromInteger :: Integer -> a -instance Num Float where+instance Num GFloat where fromInteger = fromRational . Prelude.fromInteger -instance Num Int where- fromInteger = Int . Literal- . (printf "%d" :: Prelude.Integer -> String)- . Prelude.fromInteger+instance Num GInt where+ fromInteger = GInt . Literal+ . (printf "%d" :: Integer -> String)+ . Prelude.fromInteger -fromRational :: Prelude.Rational -> Float-fromRational = Float . Literal- . (printf "%f" :: Prelude.Float -> String)- . Prelude.fromRational+fromRational :: Prelude.Rational -> GFloat+fromRational = GFloat . Literal+ . (printf "%f" :: Float -> String)+ . Prelude.fromRational radians :: GenType a => a -> a radians = fun1 "radians"@@ -273,9 +279,16 @@ abs :: GenType a => a -> a abs = fun1 "abs" +-- XXX: ???+absI :: GInt -> GInt+absI = fun1 "abs"+ sign :: GenType a => a -> a sign = fun1 "sign" +signI :: GInt -> GInt+signI = fun1 "sign"+ floor :: GenType a => a -> a floor = fun1 "floor" @@ -285,43 +298,43 @@ fract :: GenType a => a -> a fract = fun1 "fract" -mod :: GenTypeFloat a b => a -> b -> a+mod :: GenTypeGFloat a b => a -> b -> a mod = fun2 "mod" -min :: GenTypeFloat a b => a -> b -> a+min :: GenTypeGFloat a b => a -> b -> a min = fun2 "min" -max :: GenTypeFloat a b => a -> b -> a+max :: GenTypeGFloat a b => a -> b -> a max = fun2 "max" -clamp :: GenTypeFloat a b => a -> b -> b -> a+clamp :: GenTypeGFloat a b => a -> b -> b -> a clamp = fun3 "clamp" -mix :: GenTypeFloat a b => a -> a -> b -> a+mix :: GenTypeGFloat a b => a -> a -> b -> a mix = fun3 "mix" -step :: GenTypeFloat a b => b -> a -> a+step :: GenTypeGFloat a b => b -> a -> a step = fun2 "step" -smoothstep :: GenTypeFloat a b => b -> b -> a -> a+smoothstep :: GenTypeGFloat a b => b -> b -> a -> a smoothstep = fun3 "smoothstep" -length :: GenType a => a -> Float+length :: GenType a => a -> GFloat length = fun1 "length" -arrayLength :: (ShaderType t, KnownNat n) => Array n t -> Int+arrayLength :: (ShaderType t, KnownNat n) => GArray n t -> GInt arrayLength = fun1 "length" -(!) :: (ShaderType t, KnownNat n) => Array n t -> Int -> t+(!) :: (ShaderType t, KnownNat n) => GArray n t -> GInt -> t arr ! i = fromExpr $ ArrayIndex (toExpr arr) (toExpr i) -distance :: GenType a => a -> a -> Float+distance :: GenType a => a -> a -> GFloat distance = fun2 "distance" -dot :: GenType a => a -> a -> Float+dot :: GenType a => a -> a -> GFloat dot = fun2 "dot" -cross :: Vec3 -> Vec3 -> Vec3+cross :: GVec3 -> GVec3 -> GVec3 cross = fun2 "cross" normalize :: GenType a => a -> a@@ -333,16 +346,15 @@ reflect :: GenType a => a -> a -> a reflect = fun2 "reflect" -refract :: GenType a => a -> a -> Float -> a+refract :: GenType a => a -> a -> GFloat -> a refract = fun3 "refract" -class ShaderType a => Matrix a-instance Matrix Mat2-instance Matrix Mat3-instance Matrix Mat4+class ShaderType a => GMatrix a+instance GMatrix GMat2+instance GMatrix GMat3+instance GMatrix GMat4 --- TODO: unsafe-matrixCompMult :: (Matrix a, Matrix b, Matrix c) => a -> b -> c+matrixCompMult :: (GMatrix a, GMatrix b, GMatrix c) => a -> b -> c matrixCompMult = fun2 "matrixCompMult" -- | Avoid evaluating the expression of the argument more than one time.@@ -350,226 +362,225 @@ store :: ShaderType a => a -> a store x = fromExpr . Action $ Store (typeName x) (toExpr x) -true :: Bool-true = Bool $ Literal "true"+true :: GBool+true = GBool $ Literal "true" -false :: Bool-false = Bool $ Literal "false"+false :: GBool+false = GBool $ Literal "false" -- | Rebound if. You don't need to use this function, with -XRebindableSyntax.-ifThenElse :: ShaderType a => Bool -> a -> a -> a+ifThenElse :: ShaderType a => GBool -> a -> a -> a ifThenElse b t f = fromExpr . Action $ If (toExpr b) (typeName t) (toExpr t) (toExpr f) loop :: ShaderType a - => Int -- ^ Maximum number of iterations (should be as low as possible, must be an integer literal)+ => Int -- ^ Maximum number of iterations (should be as low as possible) -> a -- ^ Initial value- -> (Int -> a -> (a, Bool)) -- ^ Iteration -> Old value -> (Next, Stop)+ -> (GInt -> a -> (a, GBool)) -- ^ Iteration -> Old value -> (Next, Stop) -> a-loop (Int (Literal iters)) iv f =+loop iters iv f = fromExpr . Action $- For (Prelude.read iters :: Prelude.Int)+ For iters (typeName iv) (toExpr iv) (\ie ve -> let (next, stop) = f (fromExpr ie) (fromExpr ve) in (toExpr next, toExpr stop))-loop _ _ _ = error "loop: iteration number is not a literal." -texture2D :: Sampler2D -> Vec2 -> Vec4+texture2D :: GSampler2D -> GVec2 -> GVec4 texture2D = fun2 "texture2D" -texture2DBias :: Sampler2D -> Vec2 -> Float -> Vec4+texture2DBias :: GSampler2D -> GVec2 -> GFloat -> GVec4 texture2DBias = fun3 "texture2DBias" -texture2DProj :: Sampler2D -> Vec3 -> Vec4+texture2DProj :: GSampler2D -> GVec3 -> GVec4 texture2DProj = fun2 "texture2DProj" -texture2DProjBias :: Sampler2D -> Vec3 -> Float -> Vec4+texture2DProjBias :: GSampler2D -> GVec3 -> GFloat -> GVec4 texture2DProjBias = fun3 "texture2DProj" -texture2DProj4 :: Sampler2D -> Vec4 -> Vec4+texture2DProj4 :: GSampler2D -> GVec4 -> GVec4 texture2DProj4 = fun2 "texture2DProj" -texture2DProjBias4 :: Sampler2D -> Vec4 -> Float -> Vec4+texture2DProjBias4 :: GSampler2D -> GVec4 -> GFloat -> GVec4 texture2DProjBias4 = fun3 "texture2DProj" -texture2DLod :: Sampler2D -> Vec2 -> Float -> Vec4+texture2DLod :: GSampler2D -> GVec2 -> GFloat -> GVec4 texture2DLod = fun3 "texture2DLod" -texture2DProjLod :: Sampler2D -> Vec3 -> Float -> Vec4+texture2DProjLod :: GSampler2D -> GVec3 -> GFloat -> GVec4 texture2DProjLod = fun3 "texture2DProjLod" -texture2DProjLod4 :: Sampler2D -> Vec4 -> Float -> Vec4+texture2DProjLod4 :: GSampler2D -> GVec4 -> GFloat -> GVec4 texture2DProjLod4 = fun3 "texture3DProjLod" -textureCube :: SamplerCube -> Vec3 -> Vec4+textureCube :: GSamplerCube -> GVec3 -> GVec4 textureCube = fun2 "textureCube" -textureCubeBias :: SamplerCube -> Vec3 -> Float -> Vec4+textureCubeBias :: GSamplerCube -> GVec3 -> GFloat -> GVec4 textureCubeBias = fun3 "textureCube" -textureCubeLod :: SamplerCube -> Vec3 -> Float -> Vec4+textureCubeLod :: GSamplerCube -> GVec3 -> GFloat -> GVec4 textureCubeLod = fun3 "textureCubeLod" -- | The position of the vertex (only works in the vertex shader).-position :: Vec4+position :: GVec4 position = fromExpr $ Read "gl_Position" -- | The data of the fragment (only works in the fragment shader).-fragData :: Array 16 Vec4+fragData :: GArray 16 GVec4 fragData = fromExpr $ Read "gl_FragData" -- | The coordinates of the fragment (only works in the fragment shader).-fragCoord :: Vec4+fragCoord :: GVec4 fragCoord = fromExpr $ Read "gl_FragCoord" -- | If the fragment belongs to a front-facing primitive (only works in the -- fragment shader).-fragFrontFacing :: Bool+fragFrontFacing :: GBool fragFrontFacing = fromExpr $ Read "gl_FrontFacing" -class ShaderType t => ToInt t-instance ToInt Float-instance ToInt Bool-instance ToInt Int+class ShaderType t => ToGInt t+instance ToGInt GFloat+instance ToGInt GBool+instance ToGInt GInt -int :: ToInt t => t -> Int+int :: ToGInt t => t -> GInt int = fun1 "int" -class ShaderType t => ToBool t-instance ToBool Float-instance ToBool Bool-instance ToBool Int+class ShaderType t => ToGBool t+instance ToGBool GFloat+instance ToGBool GBool+instance ToGBool GInt -bool :: ToBool t => t -> Bool+bool :: ToGBool t => t -> GBool bool = fun1 "bool" -class ShaderType t => ToFloat t-instance ToFloat Float-instance ToFloat Bool-instance ToFloat Int+class ShaderType t => ToGFloat t+instance ToGFloat GFloat+instance ToGFloat GBool+instance ToGFloat GInt -float :: ToFloat t => t -> Float+float :: ToGFloat t => t -> GFloat float = fun1 "float" -class ToVec2 t where- vec2 :: t -> Vec2+class ToGVec2 t where+ vec2 :: t -> GVec2 -instance {-# OVERLAPPING #-} ToVec2 Float where+instance {-# OVERLAPPING #-} ToGVec2 GFloat where vec2 = fun1 "vec2" instance {-# OVERLAPPABLE #-}- (Components Vec2 <= n, ToCompList t n) => ToVec2 t where+ (Components GVec2 <= n, ToCompList t n) => ToGVec2 t where vec2 = funCompList "vec2" -class ToVec3 t where- vec3 :: t -> Vec3+class ToGVec3 t where+ vec3 :: t -> GVec3 -instance {-# OVERLAPPING #-} ToVec3 Float where+instance {-# OVERLAPPING #-} ToGVec3 GFloat where vec3 = fun1 "vec3" instance {-# OVERLAPPABLE #-}- (Components Vec3 <= n, ToCompList t n) => ToVec3 t where+ (Components GVec3 <= n, ToCompList t n) => ToGVec3 t where vec3 = funCompList "vec3" -class ToVec4 t where- vec4 :: t -> Vec4+class ToGVec4 t where+ vec4 :: t -> GVec4 -instance {-# OVERLAPPING #-} ToVec4 Float where+instance {-# OVERLAPPING #-} ToGVec4 GFloat where vec4 = fun1 "vec4" instance {-# OVERLAPPABLE #-}- (Components Vec4 <= n, ToCompList t n) => ToVec4 t where+ (Components GVec4 <= n, ToCompList t n) => ToGVec4 t where vec4 = funCompList "vec4" -class ToIVec2 t where- ivec2 :: t -> IVec2+class ToGIVec2 t where+ ivec2 :: t -> GIVec2 -instance {-# OVERLAPPING #-} ToIVec2 Float where+instance {-# OVERLAPPING #-} ToGIVec2 GFloat where ivec2 = fun1 "ivec2" instance {-# OVERLAPPABLE #-}- (Components IVec2 <= n, ToCompList t n) => ToIVec2 t where+ (Components GIVec2 <= n, ToCompList t n) => ToGIVec2 t where ivec2 = funCompList "ivec2" -class ToIVec3 t where- ivec3 :: t -> IVec3+class ToGIVec3 t where+ ivec3 :: t -> GIVec3 -instance {-# OVERLAPPING #-} ToIVec3 Float where+instance {-# OVERLAPPING #-} ToGIVec3 GFloat where ivec3 = fun1 "ivec3" instance {-# OVERLAPPABLE #-}- (Components IVec3 <= n, ToCompList t n) => ToIVec3 t where+ (Components GIVec3 <= n, ToCompList t n) => ToGIVec3 t where ivec3 = funCompList "ivec3" -class ToIVec4 t where- ivec4 :: t -> IVec4+class ToGIVec4 t where+ ivec4 :: t -> GIVec4 -instance {-# OVERLAPPING #-} ToIVec4 Float where+instance {-# OVERLAPPING #-} ToGIVec4 GFloat where ivec4 = fun1 "ivec4" instance {-# OVERLAPPABLE #-}- (Components IVec4 <= n, ToCompList t n) => ToIVec4 t where+ (Components GIVec4 <= n, ToCompList t n) => ToGIVec4 t where ivec4 = funCompList "ivec4" -class ToBVec2 t where- bvec2 :: t -> BVec2+class ToGBVec2 t where+ bvec2 :: t -> GBVec2 -instance {-# OVERLAPPING #-} ToBVec2 Float where+instance {-# OVERLAPPING #-} ToGBVec2 GFloat where bvec2 = fun1 "bvec2" instance {-# OVERLAPPABLE #-}- (Components BVec2 <= n, ToCompList t n) => ToBVec2 t where+ (Components GBVec2 <= n, ToCompList t n) => ToGBVec2 t where bvec2 = funCompList "bvec2" -class ToBVec3 t where- bvec3 :: t -> BVec3+class ToGBVec3 t where+ bvec3 :: t -> GBVec3 -instance {-# OVERLAPPING #-} ToBVec3 Float where+instance {-# OVERLAPPING #-} ToGBVec3 GFloat where bvec3 = fun1 "bvec3" instance {-# OVERLAPPABLE #-}- (Components BVec3 <= n, ToCompList t n) => ToBVec3 t where+ (Components GBVec3 <= n, ToCompList t n) => ToGBVec3 t where bvec3 = funCompList "bvec3" -class ToBVec4 t where- bvec4 :: t -> BVec4+class ToGBVec4 t where+ bvec4 :: t -> GBVec4 -instance {-# OVERLAPPING #-} ToBVec4 Float where+instance {-# OVERLAPPING #-} ToGBVec4 GFloat where bvec4 = fun1 "bvec4" instance {-# OVERLAPPABLE #-}- (Components BVec4 <= n, ToCompList t n) => ToBVec4 t where+ (Components GBVec4 <= n, ToCompList t n) => ToGBVec4 t where bvec4 = funCompList "bvec4" -class ToMat2 t where- mat2 :: t -> Mat2+class ToGMat2 t where+ mat2 :: t -> GMat2 -instance {-# OVERLAPPING #-} ToMat2 Float where+instance {-# OVERLAPPING #-} ToGMat2 GFloat where mat2 = fun1 "mat2" instance {-# OVERLAPPABLE #-}- (Components Mat2 <= n, ToCompList t n) => ToMat2 t where+ (Components GMat2 <= n, ToCompList t n) => ToGMat2 t where mat2 = funCompList "mat2" -class ToMat3 t where- mat3 :: t -> Mat3+class ToGMat3 t where+ mat3 :: t -> GMat3 -instance {-# OVERLAPPING #-} ToMat3 Float where+instance {-# OVERLAPPING #-} ToGMat3 GFloat where mat3 = fun1 "mat3" instance {-# OVERLAPPABLE #-}- (Components Mat3 <= n, ToCompList t n) => ToMat3 t where+ (Components GMat3 <= n, ToCompList t n) => ToGMat3 t where mat3 = funCompList "mat3" -class ToMat4 t where- mat4 :: t -> Mat4+class ToGMat4 t where+ mat4 :: t -> GMat4 -instance {-# OVERLAPPING #-} ToMat4 Float where+instance {-# OVERLAPPING #-} ToGMat4 GFloat where mat4 = fun1 "mat4" instance {-# OVERLAPPABLE #-}- (Components Mat4 <= n, ToCompList t n) => ToMat4 t where+ (Components GMat4 <= n, ToCompList t n) => ToGMat4 t where mat4 = funCompList "mat4" -- | Useful type for constructing vectors and matrices from scalars, vectors and@@ -594,33 +605,33 @@ -- Examples: -- -- > vec2 0--- > mat2 $ Vec2 2 4 # Vec2 1 3+-- > mat2 $ GVec2 2 4 # GVec2 1 3 -- > vec4 $ mat2 (0 # 1 # vec2 2) # 9 -- 9 is discarded--- > mat4 $ 5 # vec2 5 # Vec3 1 2 3 # Mat2 (vec2 0) (Vec2 1 2) # mat3 0+-- > mat4 $ 5 # vec2 5 # GVec3 1 2 3 # GMat2 (vec2 0) (GVec2 1 2) # mat3 0 -- > vec4 $ 1 # vec2 0 -- Not enough components, fails with "Couldn't match type -- > -- ‘'Prelude.False’ with 'Prelude.True’" (because--- > -- Components Vec4 <=? 3 ~ False).+-- > -- Components GVec4 <=? 3 ~ False). (#) :: (ToCompList x xn, ToCompList y yn) => x -> y -> CompList (xn + yn) x # y = CLAppend (toCompList x) (toCompList y) infixr 5 # type family Components (t :: *) :: Nat where- Components Int = 1- Components Float = 1- Components Bool = 1- Components Vec2 = 2- Components IVec2 = 2- Components BVec2 = 2- Components Vec3 = 3- Components IVec3 = 3- Components BVec3 = 3- Components Vec4 = 4- Components IVec4 = 4- Components BVec4 = 4- Components Mat2 = 4- Components Mat3 = 9- Components Mat4 = 16+ Components GInt = 1+ Components GFloat = 1+ Components GBool = 1+ Components GVec2 = 2+ Components GIVec2 = 2+ Components GBVec2 = 2+ Components GVec3 = 3+ Components GIVec3 = 3+ Components GBVec3 = 3+ Components GVec4 = 4+ Components GIVec4 = 4+ Components GBVec4 = 4+ Components GMat2 = 4+ Components GMat3 = 9+ Components GMat4 = 16 Components x = 0 op1 :: (ShaderType a, ShaderType b) => String -> a -> b
Graphics/Rendering/Ombra/Shader/Language/Types.hs view
@@ -6,82 +6,79 @@ import Data.Typeable import GHC.TypeLits import Data.Hashable-import Prelude (String, ($), error, Eq(..), (++), (*), fromInteger, (&&))+import Prelude (String, ($), error, Eq(..), (++), (*), fromInteger, (&&), Int) import qualified Prelude --- | CPU integer, used in the shader compiler.-type MInt = Prelude.Int- -- | An expression. data Expr = Empty | Read String | Op1 String Expr | Op2 String Expr Expr | Apply String [Expr] | X Expr | Y Expr | Z Expr | W Expr- | Literal String | Action Action | Dummy MInt | ArrayIndex Expr Expr- | ContextVar MInt ContextVarType+ | Literal String | Action Action | Dummy Int | ArrayIndex Expr Expr+ | ContextVar Int ContextVarType deriving Eq -- | Expressions that are transformed to statements. data Action = Store String Expr | If Expr String Expr Expr- | For MInt String Expr (Expr -> Expr -> (Expr, Expr))+ | For Int String Expr (Expr -> Expr -> (Expr, Expr)) data ContextVarType = LoopIteration | LoopValue deriving Eq -- | A GPU boolean.-newtype Bool = Bool Expr +newtype GBool = GBool Expr -- | A GPU float.-newtype Float = Float Expr +newtype GFloat = GFloat Expr -- | A GPU integer.-newtype Int = Int Expr +newtype GInt = GInt Expr -- | A GPU 2D texture handle.-newtype Sampler2D = Sampler2D Expr +newtype GSampler2D = GSampler2D Expr -- | A GPU cube texture handler.-newtype SamplerCube = SamplerCube Expr +newtype GSamplerCube = GSamplerCube Expr -- | The type of a generic expression. newtype Unknown = Unknown Expr + -- | A GPU 2D float vector.--- NB: This is a different type from Data.Vect.Float.'Data.Vect.Float.Vec2'.-data Vec2 = Vec2 Float Float +data GVec2 = GVec2 GFloat GFloat -- | A GPU 3D float vector.-data Vec3 = Vec3 Float Float Float +data GVec3 = GVec3 GFloat GFloat GFloat -- | A GPU 4D float vector.-data Vec4 = Vec4 Float Float Float Float +data GVec4 = GVec4 GFloat GFloat GFloat GFloat -- | A GPU 2D integer vector.-data IVec2 = IVec2 Int Int +data GIVec2 = GIVec2 GInt GInt -- | A GPU 3D integer vector.-data IVec3 = IVec3 Int Int Int +data GIVec3 = GIVec3 GInt GInt GInt -- | A GPU 4D integer vector.-data IVec4 = IVec4 Int Int Int Int +data GIVec4 = GIVec4 GInt GInt GInt GInt -- | A GPU 2D boolean vector.-data BVec2 = BVec2 Bool Bool +data GBVec2 = GBVec2 GBool GBool -- | A GPU 3D boolean vector.-data BVec3 = BVec3 Bool Bool Bool +data GBVec3 = GBVec3 GBool GBool GBool -- | A GPU 4D boolean vector.-data BVec4 = BVec4 Bool Bool Bool Bool +data GBVec4 = GBVec4 GBool GBool GBool GBool -- | A GPU 2x2 float matrix.-data Mat2 = Mat2 Vec2 Vec2 +data GMat2 = GMat2 GVec2 GVec2 -- | A GPU 3x3 float matrix.-data Mat3 = Mat3 Vec3 Vec3 Vec3 +data GMat3 = GMat3 GVec3 GVec3 GVec3 -- | A GPU 4x4 float matrix.-data Mat4 = Mat4 Vec4 Vec4 Vec4 Vec4 +data GMat4 = GMat4 GVec4 GVec4 GVec4 GVec4 -- | A GPU array.-data Array (n :: Nat) t = Array Expr +data GArray (n :: Nat) t = GArray Expr -- | A type in the GPU. class ShaderType t where@@ -93,7 +90,7 @@ typeName :: t -> String - size :: t -> MInt+ size :: t -> Int instance ShaderType Unknown where zero = error "zero: Unknown type."@@ -102,288 +99,299 @@ typeName = error "typeName: Unknown type." size = error "size: Unknown type." -instance (ShaderType t, KnownNat n) => ShaderType (Array n t) where+instance (ShaderType t, KnownNat n) => ShaderType (GArray n t) where zero = error "zero: Unsupported constant arrays."- toExpr (Array e) = e- fromExpr = Array- typeName (Array _ :: Array n t) =+ toExpr (GArray e) = e+ fromExpr = GArray+ typeName (GArray _ :: GArray n t) = typeName (zero :: t) ++ "[" ++ Prelude.show (natVal (Proxy :: Proxy n)) ++ "]"- size (Array _ :: Array n t) =+ size (GArray _ :: GArray n t) = size (zero :: t) * fromInteger (natVal (Proxy :: Proxy n)) -instance ShaderType Bool where- zero = Bool $ Literal "false"+instance ShaderType GBool where+ zero = GBool $ Literal "false" - toExpr (Bool e) = e+ toExpr (GBool e) = e - fromExpr = Bool+ fromExpr = GBool typeName _ = "bool" size _ = 1 -instance ShaderType Int where- zero = Int $ Literal "0"+instance ShaderType GInt where+ zero = GInt $ Literal "0" - toExpr (Int e) = e+ toExpr (GInt e) = e - fromExpr = Int+ fromExpr = GInt typeName _ = "int" size _ = 1 -instance ShaderType Float where- zero = Float $ Literal "0.0"+instance ShaderType GFloat where+ zero = GFloat $ Literal "0.0" - toExpr (Float e) = e+ toExpr (GFloat e) = e - fromExpr = Float+ fromExpr = GFloat typeName _ = "float" size _ = 1 -instance ShaderType Sampler2D where- zero = Sampler2D $ Literal "0"+instance ShaderType GSampler2D where+ zero = GSampler2D $ Literal "0" - toExpr (Sampler2D e) = e+ toExpr (GSampler2D e) = e - fromExpr = Sampler2D+ fromExpr = GSampler2D typeName _ = "sampler2D" size _ = 1 -instance ShaderType SamplerCube where- zero = SamplerCube $ Literal "0"+instance ShaderType GSamplerCube where+ zero = GSamplerCube $ Literal "0" - toExpr (SamplerCube e) = e+ toExpr (GSamplerCube e) = e - fromExpr = SamplerCube+ fromExpr = GSamplerCube typeName _ = "samplerCube" size _ = 1 -instance ShaderType Vec2 where- zero = Vec2 zero zero+instance ShaderType GVec2 where+ zero = GVec2 zero zero - toExpr (Vec2 (Float (X v)) (Float (Y v'))) | v == v' = Apply "vec2" [v]- toExpr (Vec2 (Float x) (Float y)) = Apply "vec2" [x, y]+ toExpr (GVec2 (GFloat (X v)) (GFloat (Y v'))) | v == v' =+ Apply "vec2" [v] - fromExpr v = Vec2 (Float (X v)) (Float (Y v))+ toExpr (GVec2 (GFloat x) (GFloat y)) = Apply "vec2" [x, y] + fromExpr v = GVec2 (GFloat (X v)) (GFloat (Y v))+ typeName _ = "vec2" size _ = 1 -instance ShaderType Vec3 where- zero = Vec3 zero zero zero+instance ShaderType GVec3 where+ zero = GVec3 zero zero zero - toExpr (Vec3 (Float (X v)) (Float (Y v')) (Float (Z v'')))+ toExpr (GVec3 (GFloat (X v)) (GFloat (Y v')) (GFloat (Z v''))) | v == v' && v' == v'' = Apply "vec3" [v]- toExpr (Vec3 (Float x) (Float y) (Float z)) = Apply "vec3" [x, y, z]+ toExpr (GVec3 (GFloat x) (GFloat y) (GFloat z)) =+ Apply "vec3" [x, y, z] - fromExpr v = Vec3 (Float (X v)) (Float (Y v)) (Float (Z v))+ fromExpr v = GVec3 (GFloat (X v)) (GFloat (Y v)) (GFloat (Z v)) typeName _ = "vec3" size _ = 1 -instance ShaderType Vec4 where- zero = Vec4 zero zero zero zero+instance ShaderType GVec4 where+ zero = GVec4 zero zero zero zero - toExpr (Vec4 (Float (X v)) (Float (Y v1)) (Float (Z v2)) (Float (W v3)))+ toExpr (GVec4 (GFloat (X v))+ (GFloat (Y v1))+ (GFloat (Z v2))+ (GFloat (W v3))) | v == v1 && v1 == v2 && v2 == v3 = Apply "vec4" [v]- toExpr (Vec4 (Float x) (Float y) (Float z) (Float w)) =+ toExpr (GVec4 (GFloat x) (GFloat y) (GFloat z) (GFloat w)) = Apply "vec4" [x, y, z, w] - fromExpr v = Vec4 (Float (X v)) (Float (Y v)) (Float (Z v)) (Float (W v))+ fromExpr v = GVec4 (GFloat (X v)) (GFloat (Y v)) (GFloat (Z v)) (GFloat (W v)) typeName _ = "vec4" size _ = 1 -instance ShaderType IVec2 where- zero = IVec2 zero zero+instance ShaderType GIVec2 where+ zero = GIVec2 zero zero - toExpr (IVec2 (Int (X v)) (Int (Y v'))) | v == v' = Apply "ivec2" [v]- toExpr (IVec2 (Int x) (Int y)) = Apply "ivec2" [x, y]+ toExpr (GIVec2 (GInt (X v)) (GInt (Y v'))) | v == v' = Apply "ivec2" [v]+ toExpr (GIVec2 (GInt x) (GInt y)) = Apply "ivec2" [x, y] - fromExpr v = IVec2 (Int (X v)) (Int (Y v))+ fromExpr v = GIVec2 (GInt (X v)) (GInt (Y v)) typeName _ = "ivec2" size _ = 1 -instance ShaderType IVec3 where- zero = IVec3 zero zero zero+instance ShaderType GIVec3 where+ zero = GIVec3 zero zero zero - toExpr (IVec3 (Int (X v)) (Int (Y v')) (Int (Z v'')))+ toExpr (GIVec3 (GInt (X v)) (GInt (Y v')) (GInt (Z v''))) | v == v' && v' == v'' = Apply "ivec3" [v]- toExpr (IVec3 (Int x) (Int y) (Int z)) = Apply "ivec3" [x, y, z]+ toExpr (GIVec3 (GInt x) (GInt y) (GInt z)) = Apply "ivec3" [x, y, z] - fromExpr v = IVec3 (Int (X v)) (Int (Y v)) (Int (Z v))+ fromExpr v = GIVec3 (GInt (X v)) (GInt (Y v)) (GInt (Z v)) typeName _ = "ivec3" size _ = 1 -instance ShaderType IVec4 where- zero = IVec4 zero zero zero zero+instance ShaderType GIVec4 where+ zero = GIVec4 zero zero zero zero - toExpr (IVec4 (Int (X v)) (Int (Y v1)) (Int (Z v2)) (Int (W v3)))+ toExpr (GIVec4 (GInt (X v)) (GInt (Y v1)) (GInt (Z v2)) (GInt (W v3))) | v == v1 && v1 == v2 && v2 == v3 = Apply "ivec4" [v]- toExpr (IVec4 (Int x) (Int y) (Int z) (Int w)) =+ toExpr (GIVec4 (GInt x) (GInt y) (GInt z) (GInt w)) = Apply "ivec4" [x, y, z, w] - fromExpr v = IVec4 (Int (X v)) (Int (Y v)) (Int (Z v)) (Int (W v))+ fromExpr v = GIVec4 (GInt (X v)) (GInt (Y v)) (GInt (Z v)) (GInt (W v)) typeName _ = "ivec4" size _ = 1 -instance ShaderType BVec2 where- zero = BVec2 zero zero+instance ShaderType GBVec2 where+ zero = GBVec2 zero zero - toExpr (BVec2 (Bool (X v)) (Bool (Y v'))) | v == v' = Apply "bvec2" [v]- toExpr (BVec2 (Bool x) (Bool y)) = Apply "bvec2" [x, y]+ toExpr (GBVec2 (GBool (X v)) (GBool (Y v'))) | v == v' =+ Apply "bvec2" [v] - fromExpr v = BVec2 (Bool (X v)) (Bool (Y v))+ toExpr (GBVec2 (GBool x) (GBool y)) = Apply "bvec2" [x, y] + fromExpr v = GBVec2 (GBool (X v)) (GBool (Y v))+ typeName _ = "bvec2" size _ = 1 -instance ShaderType BVec3 where- zero = BVec3 zero zero zero+instance ShaderType GBVec3 where+ zero = GBVec3 zero zero zero - toExpr (BVec3 (Bool (X v)) (Bool (Y v')) (Bool (Z v'')))+ toExpr (GBVec3 (GBool (X v)) (GBool (Y v')) (GBool (Z v''))) | v == v' && v' == v'' = Apply "bvec3" [v]- toExpr (BVec3 (Bool x) (Bool y) (Bool z)) = Apply "bvec3" [x, y, z]+ toExpr (GBVec3 (GBool x) (GBool y) (GBool z)) = Apply "bvec3" [x, y, z] - fromExpr v = BVec3 (Bool (X v)) (Bool (Y v)) (Bool (Z v))+ fromExpr v = GBVec3 (GBool (X v)) (GBool (Y v)) (GBool (Z v)) typeName _ = "bvec3" size _ = 1 -instance ShaderType BVec4 where- zero = BVec4 zero zero zero zero+instance ShaderType GBVec4 where+ zero = GBVec4 zero zero zero zero - toExpr (BVec4 (Bool (X v)) (Bool (Y v1)) (Bool (Z v2)) (Bool (W v3)))+ toExpr (GBVec4 (GBool (X v))+ (GBool (Y v1))+ (GBool (Z v2))+ (GBool (W v3))) | v == v1 && v1 == v2 && v2 == v3 = Apply "bvec4" [v]- toExpr (BVec4 (Bool x) (Bool y) (Bool z) (Bool w)) =+ toExpr (GBVec4 (GBool x) (GBool y) (GBool z) (GBool w)) = Apply "bvec4" [x, y, z, w] - fromExpr v = BVec4 (Bool (X v)) (Bool (Y v))- (Bool (Z v)) (Bool (W v))+ fromExpr v = GBVec4 (GBool (X v)) (GBool (Y v))+ (GBool (Z v)) (GBool (W v)) typeName _ = "bvec4" size _ = 1 -instance ShaderType Mat2 where- zero = Mat2 zero zero+instance ShaderType GMat2 where+ zero = GMat2 zero zero - toExpr (Mat2 (Vec2 (Float (X (X m))) (Float (X (Y m1))))- (Vec2 (Float (Y (X m2))) (Float (Y (Y m3)))))+ toExpr (GMat2 (GVec2 (GFloat (X (X m))) (GFloat (X (Y m1))))+ (GVec2 (GFloat (Y (X m2))) (GFloat (Y (Y m3))))) | m == m1 && m1 == m2 && m2 == m3 = Apply "mat2" [m]- toExpr (Mat2 (Vec2 (Float xx) (Float xy))- (Vec2 (Float yx) (Float yy)))+ toExpr (GMat2 (GVec2 (GFloat xx) (GFloat xy))+ (GVec2 (GFloat yx) (GFloat yy))) = Apply "mat2" [xx, yx, xy, yy] - fromExpr m = Mat2 (Vec2 (Float (X (X m))) (Float (Y (X m))))- (Vec2 (Float (Y (X m))) (Float (Y (Y m))))+ fromExpr m = GMat2 (GVec2 (GFloat (X (X m))) (GFloat (Y (X m))))+ (GVec2 (GFloat (Y (X m))) (GFloat (Y (Y m)))) typeName _ = "mat2" size _ = 2 -instance ShaderType Mat3 where- zero = Mat3 zero zero zero+instance ShaderType GMat3 where+ zero = GMat3 zero zero zero - toExpr (Mat3 (Vec3 (Float (X (X m)))- (Float (X (Y m1)))- (Float (X (Z m2))))- (Vec3 (Float (Y (X m3)))- (Float (Y (Y m4)))- (Float (Y (Z m5))))- (Vec3 (Float (Z (X m6)))- (Float (Z (Y m7)))- (Float (Z (Z m8)))))+ toExpr (GMat3 (GVec3 (GFloat (X (X m)))+ (GFloat (X (Y m1)))+ (GFloat (X (Z m2))))+ (GVec3 (GFloat (Y (X m3)))+ (GFloat (Y (Y m4)))+ (GFloat (Y (Z m5))))+ (GVec3 (GFloat (Z (X m6)))+ (GFloat (Z (Y m7)))+ (GFloat (Z (Z m8))))) | m == m1 && m1 == m2 && m2 == m3 && m3 == m4 && m4 == m5 && m5 == m6 && m6 == m7 && m7 == m8 = Apply "mat3" [m]- toExpr (Mat3 (Vec3 (Float xx) (Float xy) (Float xz))- (Vec3 (Float yx) (Float yy) (Float yz))- (Vec3 (Float zx) (Float zy) (Float zz)))+ toExpr (GMat3 (GVec3 (GFloat xx) (GFloat xy) (GFloat xz))+ (GVec3 (GFloat yx) (GFloat yy) (GFloat yz))+ (GVec3 (GFloat zx) (GFloat zy) (GFloat zz))) = Apply "mat3" [xx, yx, zx, xy, yy, zy, xz, yz, zz] - fromExpr m = Mat3 (Vec3 (Float (X (X m)))- (Float (X (Y m)))- (Float (X (Z m))))- (Vec3 (Float (Y (X m)))- (Float (Y (Y m)))- (Float (Y (Z m))))- (Vec3 (Float (Z (X m)))- (Float (Z (Y m)))- (Float (Z (Z m))))+ fromExpr m = GMat3 (GVec3 (GFloat (X (X m)))+ (GFloat (X (Y m)))+ (GFloat (X (Z m))))+ (GVec3 (GFloat (Y (X m)))+ (GFloat (Y (Y m)))+ (GFloat (Y (Z m))))+ (GVec3 (GFloat (Z (X m)))+ (GFloat (Z (Y m)))+ (GFloat (Z (Z m)))) typeName _ = "mat3" size _ = 3 -instance ShaderType Mat4 where- zero = Mat4 zero zero zero zero+instance ShaderType GMat4 where+ zero = GMat4 zero zero zero zero - toExpr (Mat4 (Vec4 (Float (X (X m)))- (Float (X (Y m1)))- (Float (X (Z m2)))- (Float (X (W m3))))- (Vec4 (Float (Y (X m4)))- (Float (Y (Y m5)))- (Float (Y (Z m6)))- (Float (Y (W m7))))- (Vec4 (Float (Z (X m8)))- (Float (Z (Y m9)))- (Float (Z (Z m10)))- (Float (Z (W m11))))- (Vec4 (Float (W (X m12)))- (Float (W (Y m13)))- (Float (W (Z m14)))- (Float (W (W m15)))))+ toExpr (GMat4 (GVec4 (GFloat (X (X m)))+ (GFloat (X (Y m1)))+ (GFloat (X (Z m2)))+ (GFloat (X (W m3))))+ (GVec4 (GFloat (Y (X m4)))+ (GFloat (Y (Y m5)))+ (GFloat (Y (Z m6)))+ (GFloat (Y (W m7))))+ (GVec4 (GFloat (Z (X m8)))+ (GFloat (Z (Y m9)))+ (GFloat (Z (Z m10)))+ (GFloat (Z (W m11))))+ (GVec4 (GFloat (W (X m12)))+ (GFloat (W (Y m13)))+ (GFloat (W (Z m14)))+ (GFloat (W (W m15))))) | m == m1 && m1 == m2 && m2 == m3 && m3 == m4 && m4 == m5 && m5 == m6 && m6 == m7 && m7 == m8 && m8 == m9 && m9 == m10 && m10 == m11 && m11 == m12 && m12 == m13 && m13 == m14 && m14 == m15 = Apply "mat4" [m]- toExpr (Mat4 (Vec4 (Float xx) (Float xy) (Float xz) (Float xw))- (Vec4 (Float yx) (Float yy) (Float yz) (Float yw))- (Vec4 (Float zx) (Float zy) (Float zz) (Float zw))- (Vec4 (Float wx) (Float wy) (Float wz) (Float ww)))+ toExpr (GMat4 (GVec4 (GFloat xx) (GFloat xy) (GFloat xz) (GFloat xw))+ (GVec4 (GFloat yx) (GFloat yy) (GFloat yz) (GFloat yw))+ (GVec4 (GFloat zx) (GFloat zy) (GFloat zz) (GFloat zw))+ (GVec4 (GFloat wx) (GFloat wy) (GFloat wz) (GFloat ww))) = Apply "mat4" [ xx, yx, zx, wx , xy, yy, zy, wy , xz, yz, zz, wz , xw, yw, zw, ww ] - fromExpr m = Mat4 (Vec4 (Float (X (X m)))- (Float (X (Y m)))- (Float (X (Z m)))- (Float (X (W m))))- (Vec4 (Float (Y (X m)))- (Float (Y (Y m)))- (Float (Y (Z m)))- (Float (Y (W m))))- (Vec4 (Float (Z (X m)))- (Float (Z (Y m)))- (Float (Z (Z m)))- (Float (Z (W m))))- (Vec4 (Float (W (X m)))- (Float (W (Y m)))- (Float (W (Z m)))- (Float (W (W m))))+ fromExpr m = GMat4 (GVec4 (GFloat (X (X m)))+ (GFloat (X (Y m)))+ (GFloat (X (Z m)))+ (GFloat (X (W m))))+ (GVec4 (GFloat (Y (X m)))+ (GFloat (Y (Y m)))+ (GFloat (Y (Z m)))+ (GFloat (Y (W m))))+ (GVec4 (GFloat (Z (X m)))+ (GFloat (Z (Y m)))+ (GFloat (Z (Z m)))+ (GFloat (Z (W m))))+ (GVec4 (GFloat (W (X m)))+ (GFloat (W (Y m)))+ (GFloat (W (Z m)))+ (GFloat (W (W m)))) typeName _ = "mat4" @@ -391,7 +399,7 @@ instance Hashable Expr where hashWithSalt s e = case e of- Empty -> hash2 s 0 (0 :: MInt)+ Empty -> hash2 s 0 (0 :: Int) Read str -> hash2 s 1 str Op1 str exp -> hash2 s 2 (str, exp) Op2 str exp exp' -> hash2 3 s (str, exp, exp')@@ -419,5 +427,5 @@ instance Prelude.Eq Action where a == a' = hash a == hash a' -hash2 :: Hashable a => MInt -> MInt -> a -> MInt+hash2 :: Hashable a => Int -> Int -> a -> Int hash2 s i x = s `hashWithSalt` i `hashWithSalt` x
Graphics/Rendering/Ombra/Shader/Stages.hs view
@@ -23,35 +23,35 @@ type FragmentShader g i = Shader g i (FragmentShaderOutput ': '[]) -- | The position of the vertex.-data VertexShaderOutput = Vertex Vec4 deriving Generic+data VertexShaderOutput = Vertex GVec4 deriving Generic -- | The RGBA color of the fragment (1.0 = #FF), or the data of the draw -- buffers. data FragmentShaderOutput = Fragment0- | Fragment Vec4- | Fragment2 Vec4 Vec4- | Fragment3 Vec4 Vec4 Vec4- | Fragment4 Vec4 Vec4 Vec4 Vec4- | Fragment5 Vec4 Vec4 Vec4 Vec4 Vec4- | Fragment6 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4- | Fragment7 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4- | Fragment8 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4- | Fragment9 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4- Vec4- | Fragment10 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4- Vec4 Vec4- | Fragment11 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4- Vec4 Vec4 Vec4- | Fragment12 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4- Vec4 Vec4 Vec4 Vec4- | Fragment13 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4- Vec4 Vec4 Vec4 Vec4 Vec4- | Fragment14 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4- Vec4 Vec4 Vec4 Vec4 Vec4 Vec4- | Fragment15 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4- Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4- | Fragment16 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4- Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4+ | Fragment GVec4+ | Fragment2 GVec4 GVec4+ | Fragment3 GVec4 GVec4 GVec4+ | Fragment4 GVec4 GVec4 GVec4 GVec4+ | Fragment5 GVec4 GVec4 GVec4 GVec4 GVec4+ | Fragment6 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4+ | Fragment7 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4+ | Fragment8 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4+ | Fragment9 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4+ GVec4+ | Fragment10 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4+ GVec4 GVec4+ | Fragment11 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4+ GVec4 GVec4 GVec4+ | Fragment12 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4+ GVec4 GVec4 GVec4 GVec4+ | Fragment13 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4+ GVec4 GVec4 GVec4 GVec4 GVec4+ | Fragment14 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4+ GVec4 GVec4 GVec4 GVec4 GVec4 GVec4+ | Fragment15 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4+ GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4+ | Fragment16 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4+ GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 GVec4 instance {-# OVERLAPPING #-} ShaderVar FragmentShaderOutput where varPreName _ = "FragmentShaderOutput"
Graphics/Rendering/Ombra/Shapes.hs view
@@ -1,8 +1,8 @@ module Graphics.Rendering.Ombra.Shapes where -import Data.Vect.Float import Graphics.Rendering.Ombra.Geometry import Graphics.Rendering.Ombra.Internal.GL (GLES)+import Graphics.Rendering.Ombra.Vector rectGeometry :: GLES => Geometry Geometry2D rectGeometry = mkGeometry2DInd [ (Vec2 (-0.5) (-0.5), Vec2 0 0)
Graphics/Rendering/Ombra/Texture.hs view
@@ -9,33 +9,47 @@ ) where import Data.Hashable-import Data.Vect.Float import Graphics.Rendering.Ombra.Backend (GLES) import Graphics.Rendering.Ombra.Color import Graphics.Rendering.Ombra.Internal.GL hiding (Texture) import Graphics.Rendering.Ombra.Texture.Internal+import Graphics.Rendering.Ombra.Vector -- | Creates a 'Texture' from a list of pixels. mkTexture :: GLES- => Int -- ^ Width.- -> Int -- ^ Height.- -> [Color] -- ^ List of pixels+ => Int -- ^ Width. Must be a power of two.+ -> Int -- ^ Height. Must be a power of two.+ -> Bool -- ^ Generate mipmaps automatically.+ -> [[Color]] -- ^ List of pixels, one for each level of detail.+ -- The first element is the base image level, the second+ -- image is half the size of the base, and so on.+ -- Use just one level of detail if you don't want+ -- mipmaps, or you used True in the previous argument. -> Texture-mkTexture w h ps = TextureImage . TexturePixels ps Linear Linear+mkTexture w h g pss = TextureImage . TexturePixels g pss minfilter Linear (fromIntegral w) (fromIntegral h)- $ hash (w, h, take (w * h) ps)+ -- TODO: hash based on the mipmaps too+ $ hash (w, h, length pss, g, take (w * h) (head pss))+ where minfilter | g = (Linear, Just Nearest)+ | (_:_:_) <- pss = (Linear, Just Nearest)+ | otherwise = (Linear, Nothing) mkTextureRaw :: GLES- => Int -- ^ Width.- -> Int -- ^ Height.- -> UInt8Array -- ^ Array of pixel components.- -> Int -- ^ Texture hash+ => Int -- ^ Width.+ -> Int -- ^ Height.+ -> Bool -- ^ Generate mipmaps.+ -> [UInt8Array] -- ^ Array of pixel components, one for each+ -- level of detail.+ -> Int -- ^ Texture hash -> Texture-mkTextureRaw w h arr pxhash = TextureImage $ TextureRaw arr Linear Linear- (fromIntegral w)- (fromIntegral h)- $ hash (w, h, pxhash)+mkTextureRaw w h g arr pxhash = TextureImage $ TextureRaw g arr minfilter Linear+ (fromIntegral w)+ (fromIntegral h)+ $ hash (w, h, pxhash)+ where minfilter | g = (Linear, Just Nearest)+ | (_:_:_) <- arr = (Linear, Just Nearest)+ | otherwise = (Linear, Nothing) -- | Creates a float 'Texture' from a list of vectors. mkTextureFloat :: GLES@@ -43,7 +57,7 @@ -> Int -- ^ Height. -> [Vec4] -- ^ List of vectors. -> Texture-mkTextureFloat w h vs = TextureImage . TextureFloat ps Linear Linear+mkTextureFloat w h vs = TextureImage . TextureFloat ps (Linear, Nothing) Linear (fromIntegral w) (fromIntegral h) $ hash (w, h, take (w * h * 4) ps)@@ -51,15 +65,19 @@ -- | Change the Texture minifying and magnifying functions. This doesn't work on -- sublayer textures.-setFilter :: Filter -> Filter -> Texture -> Texture-setFilter min mag (TextureImage (TexturePixels c _ _ w h s)) =- TextureImage (TexturePixels c min mag w h s)-setFilter min mag (TextureImage (TextureRaw c _ _ w h s)) =- TextureImage (TextureRaw c min mag w h s)+setFilter :: (Filter, Maybe Filter) -- ^ Minification filter and mipmap+ -- filter.+ -> Filter -- ^ Magnification filter.+ -> Texture+ -> Texture+setFilter min mag (TextureImage (TexturePixels g c _ _ w h s)) =+ TextureImage (TexturePixels g c min mag w h s)+setFilter min mag (TextureImage (TextureRaw g c _ _ w h s)) =+ TextureImage (TextureRaw g c min mag w h s) setFilter min mag (TextureImage (TextureFloat c _ _ w h s)) = TextureImage (TextureFloat c min mag w h s) setFilter _ _ t = t -- | Generate a 1x1 texture. colorTex :: GLES => Color -> Texture-colorTex c = mkTexture 1 1 [ c ]+colorTex c = mkTexture 1 1 False [[c]]
Graphics/Rendering/Ombra/Texture/Internal.hs view
@@ -2,6 +2,7 @@ module Graphics.Rendering.Ombra.Texture.Internal where +import Control.Monad (when) import Data.Hashable import Graphics.Rendering.Ombra.Backend (GLES) import qualified Graphics.Rendering.Ombra.Backend as GL@@ -15,9 +16,12 @@ | TextureLoaded LoadedTexture deriving Eq -data TextureImage = TexturePixels [Color] Filter Filter GLSize GLSize Int- | TextureRaw UInt8Array Filter Filter GLSize GLSize Int- | TextureFloat [Float] Filter Filter GLSize GLSize Int+data TextureImage = TexturePixels Bool [[Color]] (Filter, Maybe Filter) Filter+ GLSize GLSize Int+ | TextureRaw Bool [UInt8Array] (Filter, Maybe Filter) Filter+ GLSize GLSize Int+ | TextureFloat [Float] (Filter, Maybe Filter) Filter+ GLSize GLSize Int data Filter = Linear -- ^ Average of the four nearest pixels. | Nearest -- ^ Nearest pixel.@@ -29,8 +33,8 @@ hashWithSalt salt tex = hashWithSalt salt $ textureHash tex instance Eq TextureImage where- (TexturePixels _ _ _ _ _ h) == (TexturePixels _ _ _ _ _ h') = h == h'- (TextureRaw _ _ _ _ _ h) == (TextureRaw _ _ _ _ _ h') = h == h'+ (TexturePixels _ _ _ _ _ _ h) == (TexturePixels _ _ _ _ _ _ h') = h == h'+ (TextureRaw _ _ _ _ _ _ h) == (TextureRaw _ _ _ _ _ _ h') = h == h' (TextureFloat _ _ _ _ _ h) == (TextureFloat _ _ _ _ _ h') = h == h' _ == _ = False @@ -38,8 +42,8 @@ LoadedTexture _ _ t == LoadedTexture _ _ t' = t == t' textureHash :: TextureImage -> Int-textureHash (TexturePixels _ _ _ _ _ h) = h-textureHash (TextureRaw _ _ _ _ _ h) = h+textureHash (TexturePixels _ _ _ _ _ _ h) = h+textureHash (TextureRaw _ _ _ _ _ _ h) = h textureHash (TextureFloat _ _ _ _ _ h) = h instance GLES => Resource TextureImage LoadedTexture GL where@@ -47,18 +51,22 @@ unloadResource _ (LoadedTexture _ _ t) = deleteTexture t loadTextureImage :: GLES => TextureImage -> GL LoadedTexture-loadTextureImage (TexturePixels ps min mag w h hash) =- do arr <- liftIO . encodeUInt8s . take (fromIntegral $ w * h * 4) $- ps >>= \(Color r g b a) -> [r, g, b, a]- loadTextureImage $ TextureRaw arr min mag w h hash-loadTextureImage (TextureRaw arr min mag w h _) =+loadTextureImage (TexturePixels g pss min mag w h hash) =+ do arr <- mapM (\ps -> liftIO . encodeUInt8s .+ take (fromIntegral $ w * h * 4) $+ ps >>= \(Color r g b a) -> [r, g, b, a]) pss+ loadTextureImage $ TextureRaw g arr min mag w h hash+loadTextureImage (TextureRaw g arrs min mag w h _) = do t <- emptyTexture min mag- texImage2DUInt gl_TEXTURE_2D 0- (fromIntegral gl_RGBA)- w h 0- gl_RGBA- gl_UNSIGNED_BYTE- arr+ mapM_ (\(arr, l) -> texImage2DUInt gl_TEXTURE_2D l+ (fromIntegral gl_RGBA)+ w h 0+ gl_RGBA+ gl_UNSIGNED_BYTE+ arr+ )+ (zip arrs [0 ..])+ when g $ generateMipmap gl_TEXTURE_2D return $ LoadedTexture (fromIntegral w) (fromIntegral h) t@@ -75,16 +83,22 @@ (fromIntegral h) t -emptyTexture :: GLES => Filter -> Filter -> GL GL.Texture+emptyTexture :: GLES => (Filter, Maybe Filter) -> Filter -> GL GL.Texture emptyTexture minf magf = do t <- createTexture bindTexture gl_TEXTURE_2D t- param gl_TEXTURE_MIN_FILTER $ f minf+ param gl_TEXTURE_MIN_FILTER $ mf minf param gl_TEXTURE_MAG_FILTER $ f magf param gl_TEXTURE_WRAP_S gl_REPEAT param gl_TEXTURE_WRAP_T gl_REPEAT return t where f Linear = gl_LINEAR f Nearest = gl_NEAREST+ mf (Linear, Nothing) = gl_LINEAR+ mf (Linear, Just Nearest) = gl_LINEAR_MIPMAP_NEAREST+ mf (Linear, Just Linear) = gl_LINEAR_MIPMAP_LINEAR+ mf (Nearest, Nothing) = gl_NEAREST+ mf (Nearest, Just Nearest) = gl_NEAREST_MIPMAP_NEAREST+ mf (Nearest, Just Linear) = gl_NEAREST_MIPMAP_LINEAR param :: GLES => GLEnum -> GLEnum -> GL () param p v = texParameteri gl_TEXTURE_2D p $ fromIntegral v
Graphics/Rendering/Ombra/Transformation.hs view
@@ -14,7 +14,7 @@ scaleMat3 ) where -import Data.Vect.Float+import Graphics.Rendering.Ombra.Vector -- | 4x4 translation matrix. transMat4 :: Vec3 -> Mat4@@ -48,10 +48,23 @@ rotMat4 :: Vec3 -- ^ Axis. -> Float -- ^ Angle -> Mat4-rotMat4 v a = let (Mat3 x y z) = rotMatrix3 v a- in Mat4 (extendZero x)- (extendZero y)- (extendZero z)+-- TODO: test+rotMat4 v a = let Vec3 x y z = normalized v+ c = cos a+ nc = 1 - c+ s = sin a+ in Mat4 (Vec4 (c + x * x * nc)+ (x * y * nc - z * s)+ (y * s + x * z * nc)+ 0)+ (Vec4 (z * s + x * y * nc)+ (c + y * y * nc)+ (- x * s + y * z * nc)+ 0)+ (Vec4 (- y * s + x * z * nc)+ (x * s + y * z * nc)+ (c + z * z * nc)+ 0) (Vec4 0 0 0 1) -- | 4x4 scale matrix.@@ -97,7 +110,7 @@ Mat4 (Vec4 xx yx zx 0) (Vec4 xy yy zy 0) (Vec4 xz yz zz 0)- (Vec4 (- dotprod xv eye) (- dotprod yv eye) (- dotprod zv eye) 1)+ (Vec4 (- xv <.> eye) (- yv <.> eye) (- zv <.> eye) 1) where cosPitch = cos pitch sinPitch = sin pitch cosYaw = cos yaw@@ -117,10 +130,10 @@ Mat4 (Vec4 xx yx zx 0) (Vec4 xy yy zy 0) (Vec4 xz yz zz 0)- (Vec4 (- dotprod xv eye) (- dotprod yv eye) (- dotprod zv eye) 1)- where zv@(Vec3 zx zy zz) = normalize $ eye &- target- xv@(Vec3 xx xy xz) = normalize $ crossprod up zv- yv@(Vec3 yx yy yz) = crossprod zv xv+ (Vec4 (- xv <.> eye) (- yv <.> eye) (- zv <.> eye) 1)+ where zv@(Vec3 zx zy zz) = normalized $ eye ^-^ target+ xv@(Vec3 xx xy xz) = normalized $ cross3 up zv+ yv@(Vec3 yx yy yz) = cross3 zv xv -- | 3x3 translation matrix. transMat3 :: Vec2 -> Mat3
+ Graphics/Rendering/Ombra/Vector.hs view
@@ -0,0 +1,381 @@+{-# LANGUAGE DeriveGeneric, TypeFamilies, TypeFamilyDependencies #-}++module Graphics.Rendering.Ombra.Vector (+ module Data.VectorSpace,+ module Data.Cross,+ Vec2(..),+ Vec3(..),+ Vec4(..),+ Mat2(..),+ Mat3(..),+ Mat4(..),+ IVec2(..),+ IVec3(..),+ IVec4(..),+ Matrix(..),+ Ext(..)+) where++import Data.Cross+import Data.VectorSpace+import Data.Hashable+import Data.Int+import Foreign.Storable+import Foreign.Ptr (castPtr)+import GHC.Generics++data Vec2 = Vec2 {-# UNPACK #-} !Float+ {-# UNPACK #-} !Float+ deriving (Generic, Show, Eq)+data Vec3 = Vec3 {-# UNPACK #-} !Float+ {-# UNPACK #-} !Float+ {-# UNPACK #-} !Float+ deriving (Generic, Show, Eq)+data Vec4 = Vec4 {-# UNPACK #-} !Float+ {-# UNPACK #-} !Float+ {-# UNPACK #-} !Float+ {-# UNPACK #-} !Float+ deriving (Generic, Show, Eq)++data Mat2 = Mat2 !Vec2 !Vec2 deriving (Generic, Show, Eq)+data Mat3 = Mat3 !Vec3 !Vec3 !Vec3 deriving (Generic, Show, Eq)+data Mat4 = Mat4 !Vec4 !Vec4 !Vec4 !Vec4 deriving (Generic, Show, Eq)++data IVec2 = IVec2 {-# UNPACK #-} !Int32+ {-# UNPACK #-} !Int32+ deriving (Generic, Show, Eq)+data IVec3 = IVec3 {-# UNPACK #-} !Int32+ {-# UNPACK #-} !Int32+ {-# UNPACK #-} !Int32+ deriving (Generic, Show, Eq)+data IVec4 = IVec4 {-# UNPACK #-} !Int32+ {-# UNPACK #-} !Int32+ {-# UNPACK #-} !Int32+ {-# UNPACK #-} !Int32+ deriving (Generic, Show, Eq)++infixr 5 ^|+infixr 5 ^|^+class VectorSpace v => Ext v where+ type Extended v = w | w -> v+ -- | Extend the vector with a specified scalar.+ (^|) :: v -> Scalar v -> Extended v+ -- | Extend the first vector using the components of the second vector.+ --+ -- For instance:+ -- @+ -- Mat2 (Vec2 x y) (Vec2 z w) ^|^ idmtx =+ -- Mat3 (Vec3 x y 0) (Vec3 z w 0) (Vec3 0 0 1)+ -- @+ (^|^) :: v -> Extended v -> Extended v+ -- | Extract a smaller vector.+ extract :: Extended v -> v++infixl 7 .*.+infixl 7 .*+infixr 7 *.++class Matrix a where+ type family Row a = b | b -> a+ idmtx :: a+ transpose :: a -> a+ (.*.) :: a -> a -> a+ (.*) :: a -> Row a -> Row a+ (*.) :: Row a -> a -> Row a+ v *. m = transpose m .* v++-- TODO: ? Num/Fractional/Floating instances?++instance AdditiveGroup Vec2 where+ zeroV = Vec2 0 0+ (^+^) (Vec2 x1 y1) (Vec2 x2 y2) = Vec2 (x1 + x2) (y1 + y2)+ (^-^) (Vec2 x1 y1) (Vec2 x2 y2) = Vec2 (x1 - x2) (y1 - y2)+ negateV (Vec2 x y) = Vec2 (-x) (-y)++instance VectorSpace Vec2 where+ type Scalar Vec2 = Float+ (*^) s (Vec2 x y) = Vec2 (s * x) (s * y)++instance InnerSpace Vec2 where+ (<.>) (Vec2 x1 y1) (Vec2 x2 y2) = x1 * x2 + y1 * y2++instance Ext Vec2 where+ type Extended Vec2 = Vec3+ Vec2 x y ^| z = Vec3 x y z+ Vec2 x y ^|^ Vec3 _ _ z = Vec3 x y z+ extract (Vec3 x y z) = Vec2 x y++instance Storable Vec2 where+ sizeOf _ = 8+ alignment _ = 4+ peek ptr = Vec2 <$> peekElemOff (castPtr ptr) 0+ <*> peekElemOff (castPtr ptr) 1+ poke ptr (Vec2 x y) = do pokeElemOff (castPtr ptr) 0 x+ pokeElemOff (castPtr ptr) 1 y+++instance AdditiveGroup Vec3 where+ zeroV = Vec3 0 0 0+ (^+^) (Vec3 x1 y1 z1) (Vec3 x2 y2 z2) =+ Vec3 (x1 + x2) (y1 + y2) (z1 + z2)+ (^-^) (Vec3 x1 y1 z1) (Vec3 x2 y2 z2) =+ Vec3 (x1 - x2) (y1 - y2) (z1 - z2)+ negateV (Vec3 x y z) = Vec3 (-x) (-y) (-z)++instance VectorSpace Vec3 where+ type Scalar Vec3 = Float+ (*^) s (Vec3 x y z) = Vec3 (s * x) (s * y) (s * z)++instance InnerSpace Vec3 where+ (<.>) (Vec3 x1 y1 z1) (Vec3 x2 y2 z2) = x1 * x2 + y1 * y2 + z1 * z2++instance HasCross3 Vec3 where+ cross3 (Vec3 x1 y1 z1) (Vec3 x2 y2 z2) =+ Vec3 (y1 * z2 - y2 * z1) (z1 * x2 - z2 * x1) (x1 * y2 - x2 * y1)++instance Ext Vec3 where+ type Extended Vec3 = Vec4+ Vec3 x y z ^| w = Vec4 x y z w+ Vec3 x y z ^|^ Vec4 _ _ _ w = Vec4 x y z w+ extract (Vec4 x y z w) = Vec3 x y z++instance Storable Vec3 where+ sizeOf _ = 12+ alignment _ = 4+ peek ptr = Vec3 <$> peekElemOff (castPtr ptr) 0+ <*> peekElemOff (castPtr ptr) 1+ <*> peekElemOff (castPtr ptr) 2+ poke ptr (Vec3 x y z) = do pokeElemOff (castPtr ptr) 0 x+ pokeElemOff (castPtr ptr) 1 y+ pokeElemOff (castPtr ptr) 2 z+++instance AdditiveGroup Vec4 where+ zeroV = Vec4 0 0 0 0+ (^+^) (Vec4 x1 y1 z1 w1) (Vec4 x2 y2 z2 w2) =+ Vec4 (x1 + x2) (y1 + y2) (z1 + z2) (w1 + w2)+ (^-^) (Vec4 x1 y1 z1 w1) (Vec4 x2 y2 z2 w2) =+ Vec4 (x1 - x2) (y1 - y2) (z1 - z2) (w1 - w2)+ negateV (Vec4 x y z w) = Vec4 (-x) (-y) (-z) (-w)++instance VectorSpace Vec4 where+ type Scalar Vec4 = Float+ (*^) s (Vec4 x y z w) = Vec4 (s * x) (s * y) (s * z) (s * w)++instance InnerSpace Vec4 where+ (<.>) (Vec4 x1 y1 z1 w1) (Vec4 x2 y2 z2 w2) =+ x1 * x2 + y1 * y2 + z1 * z2 + w1 * w2++instance Storable Vec4 where+ sizeOf _ = 16+ alignment _ = 4+ peek ptr = Vec4 <$> peekElemOff (castPtr ptr) 0+ <*> peekElemOff (castPtr ptr) 1+ <*> peekElemOff (castPtr ptr) 2+ <*> peekElemOff (castPtr ptr) 3+ poke ptr (Vec4 x y z w) = do pokeElemOff (castPtr ptr) 0 x+ pokeElemOff (castPtr ptr) 1 y+ pokeElemOff (castPtr ptr) 2 z+ pokeElemOff (castPtr ptr) 3 w++instance AdditiveGroup Mat2 where+ zeroV = Mat2 zeroV zeroV+ (^+^) (Mat2 x1 y1) (Mat2 x2 y2) = Mat2 (x1 ^+^ x2) (y1 ^+^ y2)+ (^-^) (Mat2 x1 y1) (Mat2 x2 y2) = Mat2 (x1 ^-^ x2) (y1 ^-^ y2)+ negateV (Mat2 x y) = Mat2 (negateV x) (negateV y)++instance VectorSpace Mat2 where+ type Scalar Mat2 = Float+ (*^) s (Mat2 x y) = Mat2 (s *^ x) (s *^ y)++instance Ext Mat2 where+ type Extended Mat2 = Mat3+ Mat2 x y ^| a = Mat3 (x ^| a) (y ^| a) (Vec3 a a a)+ Mat2 x y ^|^ Mat3 x' y' z' = Mat3 (x ^|^ x') (y ^|^ y') z'+ extract (Mat3 x y z) = Mat2 (extract x) (extract y)++instance Matrix Mat2 where+ type Row Mat2 = Vec2+ idmtx = Mat2 (Vec2 1 0) (Vec2 0 1)+ transpose (Mat2 (Vec2 a b) (Vec2 c d)) = Mat2 (Vec2 a c) (Vec2 b d)+ (.*.) (Mat2 (Vec2 a11 a12) (Vec2 a21 a22))+ (Mat2 (Vec2 b11 b12) (Vec2 b21 b22)) =+ Mat2 (Vec2 (a11 * b11 + a12 * b21) (a11 * b12 + a12 * b22))+ (Vec2 (a21 * b11 + a22 * b21) (a21 * b12 + a22 * b22))++ (.*) (Mat2 (Vec2 a b) (Vec2 c d)) (Vec2 x y) =+ Vec2 (a * x + b * y) (c * x + d * y)+++instance AdditiveGroup Mat3 where+ zeroV = Mat3 zeroV zeroV zeroV+ (^+^) (Mat3 x1 y1 z1) (Mat3 x2 y2 z2) =+ Mat3 (x1 ^+^ x2) (y1 ^+^ y2) (z1 ^+^ z2)+ (^-^) (Mat3 x1 y1 z1) (Mat3 x2 y2 z2) =+ Mat3 (x1 ^-^ x2) (y1 ^-^ y2) (z1 ^-^ z2)+ negateV (Mat3 x y z) = Mat3 (negateV x) (negateV y) (negateV z)++instance VectorSpace Mat3 where+ type Scalar Mat3 = Float+ (*^) s (Mat3 x y z) = Mat3 (s *^ x) (s *^ y) (s *^ z)++instance Ext Mat3 where+ type Extended Mat3 = Mat4+ Mat3 x y z ^| a = Mat4 (x ^| a) (y ^| a) (z ^| a) (Vec4 a a a a)+ Mat3 x y z ^|^ Mat4 x' y' z' w' = Mat4 (x ^|^ x') (y ^|^ y')+ (z ^|^ z') w'+ extract (Mat4 x y z w) = Mat3 (extract x) (extract y) (extract z)++instance Matrix Mat3 where+ type Row Mat3 = Vec3+ idmtx = Mat3 (Vec3 1 0 0) (Vec3 0 1 0) (Vec3 0 0 1)+ transpose (Mat3 (Vec3 a b c)+ (Vec3 d e f)+ (Vec3 g h i)) = Mat3 (Vec3 a d g)+ (Vec3 b e h)+ (Vec3 c f i)+ (.*.) (Mat3 (Vec3 a11 a12 a13)+ (Vec3 a21 a22 a23)+ (Vec3 a31 a32 a33))+ (Mat3 (Vec3 b11 b12 b13)+ (Vec3 b21 b22 b23)+ (Vec3 b31 b32 b33)) =+ Mat3 (Vec3 (a11 * b11 + a12 * b21 + a13 * b31)+ (a11 * b12 + a12 * b22 + a13 * b32)+ (a11 * b13 + a12 * b23 + a13 * b33))++ (Vec3 (a21 * b11 + a22 * b21 + a23 * b31)+ (a21 * b12 + a22 * b22 + a23 * b32)+ (a21 * b13 + a22 * b23 + a23 * b33))++ (Vec3 (a31 * b11 + a32 * b21 + a33 * b31)+ (a31 * b12 + a32 * b22 + a33 * b32)+ (a31 * b13 + a32 * b23 + a33 * b33))++ (.*) (Mat3 (Vec3 a b c)+ (Vec3 d e f)+ (Vec3 g h i))+ (Vec3 x y z) = Vec3 (a * x + b * y + c * z)+ (d * x + e * y + f * z)+ (g * x + h * y + i * z)+++instance AdditiveGroup Mat4 where+ zeroV = Mat4 zeroV zeroV zeroV zeroV+ (^+^) (Mat4 x1 y1 z1 w1) (Mat4 x2 y2 z2 w2) =+ Mat4 (x1 ^+^ x2) (y1 ^+^ y2) (z1 ^+^ z2) (w1 ^+^ w2)+ (^-^) (Mat4 x1 y1 z1 w1) (Mat4 x2 y2 z2 w2) =+ Mat4 (x1 ^-^ x2) (y1 ^-^ y2) (z1 ^-^ z2) (w1 ^-^ w2)+ negateV (Mat4 x y z w) = Mat4 (negateV x) (negateV y)+ (negateV z) (negateV w)++instance VectorSpace Mat4 where+ type Scalar Mat4 = Float+ (*^) s (Mat4 x y z w) = Mat4 (s *^ x) (s *^ y) (s *^ z) (s *^ w)++instance Matrix Mat4 where+ type Row Mat4 = Vec4+ idmtx = Mat4 (Vec4 1 0 0 0) (Vec4 0 1 0 0) (Vec4 0 0 1 0) (Vec4 0 0 0 1)+ transpose (Mat4 (Vec4 a b c d)+ (Vec4 e f g h)+ (Vec4 i j k l)+ (Vec4 m n o p)) = Mat4 (Vec4 a e i m)+ (Vec4 b f j n)+ (Vec4 c g k o)+ (Vec4 d h l p)+ (.*.) (Mat4 (Vec4 _1 _2 _3 _4)+ (Vec4 _5 _6 _7 _8)+ (Vec4 _9 _a _b _c)+ (Vec4 _d _e _f _g))+ (Mat4 (Vec4 a b c d)+ (Vec4 e f g h)+ (Vec4 i j k l)+ (Vec4 m n o p)) =+ Mat4 (Vec4 (_1 * a + _2 * e + _3 * i + _4 * m)+ (_1 * b + _2 * f + _3 * j + _4 * n)+ (_1 * c + _2 * g + _3 * k + _4 * o)+ (_1 * d + _2 * h + _3 * l + _4 * p))+ + (Vec4 (_5 * a + _6 * e + _7 * i + _8 * m)+ (_5 * b + _6 * f + _7 * j + _8 * n)+ (_5 * c + _6 * g + _7 * k + _8 * o)+ (_5 * d + _6 * h + _7 * l + _8 * p))+ + (Vec4 (_9 * a + _a * e + _b * i + _c * m)+ (_9 * b + _a * f + _b * j + _c * n)+ (_9 * c + _a * g + _b * k + _c * o)+ (_9 * d + _a * h + _b * l + _c * p))+ + (Vec4 (_d * a + _e * e + _f * i + _g * m)+ (_d * b + _e * f + _f * j + _g * n)+ (_d * c + _e * g + _f * k + _g * o)+ (_d * d + _e * h + _f * l + _g * p))++ (.*) (Mat4 (Vec4 a b c d)+ (Vec4 e f g h)+ (Vec4 i j k l)+ (Vec4 m n o p))+ (Vec4 x y z w) = Vec4 (a * x + b * y + c * z + d * w)+ (e * x + f * y + g * z + h * w)+ (i * x + j * y + k * z + l * w)+ (m * x + n * y + o * z + p * w)+++instance Storable IVec2 where+ sizeOf _ = 8+ alignment _ = 4+ peek ptr = IVec2 <$> peekElemOff (castPtr ptr) 0+ <*> peekElemOff (castPtr ptr) 1+ poke ptr (IVec2 x y) = do pokeElemOff (castPtr ptr) 0 x+ pokeElemOff (castPtr ptr) 1 y++instance Storable IVec3 where+ sizeOf _ = 12+ alignment _ = 4+ peek ptr = IVec3 <$> peekElemOff (castPtr ptr) 0+ <*> peekElemOff (castPtr ptr) 1+ <*> peekElemOff (castPtr ptr) 2+ poke ptr (IVec3 x y z) = do pokeElemOff (castPtr ptr) 0 x+ pokeElemOff (castPtr ptr) 1 y+ pokeElemOff (castPtr ptr) 2 z++instance Storable IVec4 where+ sizeOf _ = 16+ alignment _ = 4+ peek ptr = IVec4 <$> peekElemOff (castPtr ptr) 0+ <*> peekElemOff (castPtr ptr) 1+ <*> peekElemOff (castPtr ptr) 2+ <*> peekElemOff (castPtr ptr) 3+ poke ptr (IVec4 x y z w) = do pokeElemOff (castPtr ptr) 0 x+ pokeElemOff (castPtr ptr) 1 y+ pokeElemOff (castPtr ptr) 2 z+ pokeElemOff (castPtr ptr) 3 w++-- TODO: ??++instance Hashable Vec2 where+ hashWithSalt s (Vec2 x y) = hashWithSalt s (x, y)++instance Hashable Vec3 where+ hashWithSalt s (Vec3 x y z) = hashWithSalt s (x, y, z)++instance Hashable Vec4 where+ hashWithSalt s (Vec4 x y z w) = hashWithSalt s (x, y, z, w)++instance Hashable Mat2 where+ hashWithSalt s (Mat2 x y) = hashWithSalt s (x, y)++instance Hashable Mat3 where+ hashWithSalt s (Mat3 x y z) = hashWithSalt s (x, y, z)++instance Hashable Mat4 where+ hashWithSalt s (Mat4 x y z w) = hashWithSalt s (x, y, z, w)++instance Hashable IVec2 where+ hashWithSalt s (IVec2 x y) = hashWithSalt s (x, y)++instance Hashable IVec3 where+ hashWithSalt s (IVec3 x y z) = hashWithSalt s (x, y, z)++instance Hashable IVec4 where+ hashWithSalt s (IVec4 x y z w) = hashWithSalt s (x, y, z, w)
ombra.cabal view
@@ -1,5 +1,5 @@ name: ombra-version: 0.2.2.0+version: 0.3.0.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@@ -9,7 +9,7 @@ author: Luca "ziocroc" Prezzavento maintainer: ziocroc@gmail.com stability: Experimental-copyright: Copyright © 2014-2016 Luca Prezzavento+copyright: Copyright © 2014-2017 Luca Prezzavento category: Graphics build-type: Simple extra-source-files: README.md@@ -27,19 +27,75 @@ default: False library- exposed-modules: Graphics.Rendering.Ombra, Graphics.Rendering.Ombra.Blend, Graphics.Rendering.Ombra.Layer, Graphics.Rendering.Ombra.Object, Graphics.Rendering.Ombra.Texture, Graphics.Rendering.Ombra.Stencil, Graphics.Rendering.Ombra.Shader, Graphics.Rendering.Ombra.Transformation, Graphics.Rendering.Ombra.Draw, Graphics.Rendering.Ombra.D2, Graphics.Rendering.Ombra.Geometry, Graphics.Rendering.Ombra.D3, Graphics.Rendering.Ombra.Color, Graphics.Rendering.Ombra.Backend, Graphics.Rendering.Ombra.Shapes, Graphics.Rendering.Ombra.Internal.GL, Graphics.Rendering.Ombra.Shader.Default3D, Graphics.Rendering.Ombra.Shader.Default2D- other-modules: Graphics.Rendering.Ombra.Internal.Resource, Graphics.Rendering.Ombra.Internal.TList, Graphics.Rendering.Ombra.Shader.ShaderVar, Graphics.Rendering.Ombra.Shader.GLSL, Graphics.Rendering.Ombra.Shader.Stages, Graphics.Rendering.Ombra.Shader.Program, Graphics.Rendering.Ombra.Shader.CPU, Graphics.Rendering.Ombra.Shader.Language.Types, Graphics.Rendering.Ombra.Shader.Language.Functions, Graphics.Rendering.Ombra.Draw.Internal, Graphics.Rendering.Ombra.Layer.Internal, Graphics.Rendering.Ombra.Object.Internal, Graphics.Rendering.Ombra.Geometry.Internal, Graphics.Rendering.Ombra.Texture.Internal, Graphics.Rendering.Ombra.Blend.Internal, Graphics.Rendering.Ombra.Stencil.Internal+ exposed-modules: Graphics.Rendering.Ombra,+ Graphics.Rendering.Ombra.Blend,+ Graphics.Rendering.Ombra.Layer,+ Graphics.Rendering.Ombra.Object,+ Graphics.Rendering.Ombra.Texture,+ Graphics.Rendering.Ombra.Stencil,+ Graphics.Rendering.Ombra.Shader,+ Graphics.Rendering.Ombra.Transformation,+ Graphics.Rendering.Ombra.Draw,+ Graphics.Rendering.Ombra.D2,+ Graphics.Rendering.Ombra.Geometry,+ Graphics.Rendering.Ombra.D3,+ Graphics.Rendering.Ombra.Color,+ Graphics.Rendering.Ombra.Backend,+ Graphics.Rendering.Ombra.Shapes,+ Graphics.Rendering.Ombra.Vector,+ Graphics.Rendering.Ombra.Internal.GL,+ Graphics.Rendering.Ombra.Shader.Default3D,+ Graphics.Rendering.Ombra.Shader.Default2D + other-modules: Graphics.Rendering.Ombra.Internal.Resource,+ Graphics.Rendering.Ombra.Internal.TList,+ Graphics.Rendering.Ombra.Shader.ShaderVar,+ Graphics.Rendering.Ombra.Shader.GLSL,+ Graphics.Rendering.Ombra.Shader.Stages,+ Graphics.Rendering.Ombra.Shader.Program,+ Graphics.Rendering.Ombra.Shader.CPU,+ Graphics.Rendering.Ombra.Shader.Language,+ Graphics.Rendering.Ombra.Shader.Language.Types,+ Graphics.Rendering.Ombra.Shader.Language.Functions,+ Graphics.Rendering.Ombra.Draw.Internal,+ Graphics.Rendering.Ombra.Layer.Internal,+ Graphics.Rendering.Ombra.Object.Internal,+ Graphics.Rendering.Ombra.Geometry.Internal,+ Graphics.Rendering.Ombra.Texture.Internal,+ Graphics.Rendering.Ombra.Blend.Internal,+ Graphics.Rendering.Ombra.Stencil.Internal+ if flag(webgl) exposed-modules: Graphics.Rendering.Ombra.Backend.WebGL- other-modules: Graphics.Rendering.Ombra.Backend.WebGL.Raw, Graphics.Rendering.Ombra.Backend.WebGL.Types, Graphics.Rendering.Ombra.Backend.WebGL.Const+ other-modules: Graphics.Rendering.Ombra.Backend.WebGL.Raw,+ Graphics.Rendering.Ombra.Backend.WebGL.Types,+ Graphics.Rendering.Ombra.Backend.WebGL.Const if flag(opengl) && !flag(webgl) exposed-modules: Graphics.Rendering.Ombra.Backend.OpenGL - other-extensions: TypeOperators, DataKinds, ConstraintKinds, MultiParamTypeClasses, TypeFamilies, FlexibleContexts, FlexibleInstances, RankNTypes, GADTs, TypeSynonymInstances, KindSignatures, UndecidableInstances, ExistentialQuantification, GeneralizedNewtypeDeriving, NullaryTypeClasses, PolyKinds, ScopedTypeVariables, FunctionalDependencies, DeriveDataTypeable, ImpredicativeTypes, RebindableSyntax+ other-extensions: TypeOperators,+ DataKinds,+ ConstraintKinds,+ MultiParamTypeClasses,+ TypeFamilies,+ FlexibleContexts,+ FlexibleInstances,+ RankNTypes,+ GADTs,+ TypeSynonymInstances,+ KindSignatures,+ UndecidableInstances,+ ExistentialQuantification,+ GeneralizedNewtypeDeriving,+ NullaryTypeClasses,+ PolyKinds,+ ScopedTypeVariables,+ FunctionalDependencies,+ DeriveDataTypeable,+ RebindableSyntax - build-depends: base <5.0, vect <0.5, hashable <1.3, unordered-containers <0.3, transformers <0.6, hashtables <1.4+ build-depends: base <5.0, Boolean <0.3, vector-space <0.11, hashable <1.3, unordered-containers <0.3, transformers <0.6, hashtables <1.4 if flag(opengl) && !flag(webgl) build-depends: gl <0.8