diff options
author | Josh Rahm <joshuarahm@gmail.com> | 2022-12-03 17:37:59 -0700 |
---|---|---|
committer | Josh Rahm <joshuarahm@gmail.com> | 2022-12-03 17:37:59 -0700 |
commit | ba59711a51b4fee34009b1fe6afdce9ef8e60ae0 (patch) | |
tree | 7274bd2c9007abe08c8db7cea9e55babfd041125 /Graphics/Glyph/ExtendedGL/Base.hs | |
parent | 601f77922490888c3ae9986674e332a5192008ec (diff) | |
download | terralloc-master.tar.gz terralloc-master.tar.bz2 terralloc-master.zip |
Diffstat (limited to 'Graphics/Glyph/ExtendedGL/Base.hs')
-rw-r--r-- | Graphics/Glyph/ExtendedGL/Base.hs | 124 |
1 files changed, 65 insertions, 59 deletions
diff --git a/Graphics/Glyph/ExtendedGL/Base.hs b/Graphics/Glyph/ExtendedGL/Base.hs index 88566f4..9b50ddb 100644 --- a/Graphics/Glyph/ExtendedGL/Base.hs +++ b/Graphics/Glyph/ExtendedGL/Base.hs @@ -1,111 +1,117 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} -module Graphics.Glyph.ExtendedGL.Base where +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} -import qualified Graphics.Rendering.OpenGL as GL -import Graphics.GL.Core43 -import Graphics.GL.Compatibility30 +module Graphics.Glyph.ExtendedGL.Base where +import Control.Monad +import Data.Proxy +import Data.StateVar +import Foreign.C.Types import Foreign.Marshal.Alloc import Foreign.Ptr import Foreign.Storable -import Foreign.C.Types - +import Graphics.GL.Compatibility30 +import Graphics.GL.Core43 +import qualified Graphics.Rendering.OpenGL as GL import System.IO.Unsafe -import Control.Monad - -import Data.StateVar import Unsafe.Coerce -import Data.Proxy -data ExPrimitiveMode = Points | Triangles | Lines | Patches deriving (Show,Enum) +data ExPrimitiveMode = Points | Triangles | Lines | Patches deriving (Show, Enum) class IsBindable a where - bind :: a -> IO () + bind :: a -> IO () + class IsGLEnumMarshallable a where - toGLEnum :: a -> GLenum + toGLEnum :: a -> GLenum + class IsGenerable a where - generate :: IO a + generate :: IO a + class IsWrappedPrimitive t a where - unwrap :: a -> t - wrap :: t -> a + unwrap :: a -> t + wrap :: t -> a + class HasIntegerParam t a where - parami :: t -> a -> SettableStateVar GLuint + parami :: t -> a -> SettableStateVar GLuint + class HasFloatParam t a where - paramf :: t -> a -> SettableStateVar GLfloat + paramf :: t -> a -> SettableStateVar GLfloat + class HasParamOfType b t a where - param :: t -> a -> SettableStateVar b + param :: t -> a -> SettableStateVar b class IsPrimitiveModeMarshallable a where - marshalPrimitiveMode :: a -> GLuint + marshalPrimitiveMode :: a -> GLuint castPrimitive :: forall a b t. (IsWrappedPrimitive t a, IsWrappedPrimitive t b) => Proxy t -> a -> b castPrimitive _ x = wrap unw - where - unw :: t - unw = unwrap x + where + unw :: t + unw = unwrap x instance (IsWrappedPrimitive a a) where - unwrap = id - wrap = id + unwrap = id + wrap = id + instance (IsWrappedPrimitive GLenum a) => IsGLEnumMarshallable a where - toGLEnum = unwrap + toGLEnum = unwrap instance IsPrimitiveModeMarshallable ExPrimitiveMode where - marshalPrimitiveMode x = case x of - Points -> GL_POINTS - Triangles -> GL_TRIANGLES - Lines -> GL_LINES - Patches -> GL_PATCHES + marshalPrimitiveMode x = case x of + Points -> GL_POINTS + Triangles -> GL_TRIANGLES + Lines -> GL_LINES + Patches -> GL_PATCHES instance IsPrimitiveModeMarshallable GL.PrimitiveMode where - marshalPrimitiveMode x = case x of - GL.Points -> 0x0 - GL.Lines -> 0x1 - GL.LineLoop -> 0x2 - GL.LineStrip -> 0x3 - GL.Triangles -> 0x4 - GL.TriangleStrip -> 0x5 - GL.TriangleFan -> 0x6 - GL.Quads -> 0x7 - GL.QuadStrip -> 0x8 - GL.Polygon -> 0x9 + marshalPrimitiveMode x = case x of + GL.Points -> 0x0 + GL.Lines -> 0x1 + GL.LineLoop -> 0x2 + GL.LineStrip -> 0x3 + GL.Triangles -> 0x4 + GL.TriangleStrip -> 0x5 + GL.TriangleFan -> 0x6 + GL.Quads -> 0x7 + GL.QuadStrip -> 0x8 + GL.Polygon -> 0x9 instance IsPrimitiveModeMarshallable GLuint where - marshalPrimitiveMode = id + marshalPrimitiveMode = id vertexAttributeDivisor :: GL.AttribLocation -> SettableStateVar GLuint vertexAttributeDivisor (GL.AttribLocation loc) = - makeSettableStateVar $ \val -> - glVertexAttribDivisor loc val + makeSettableStateVar $ \val -> + glVertexAttribDivisor loc val {- Sets the number of vertices per patch - for OpenGL -} patchVertices :: (Integral a) => SettableStateVar a -patchVertices = - makeSettableStateVar $ \val -> - glPatchParameteri GL_PATCH_VERTICES $ fromIntegral val +patchVertices = + makeSettableStateVar $ \val -> + glPatchParameteri GL_PATCH_VERTICES $ fromIntegral val {- Returns the maximum number of patches - for a tessilation shader -} maxPatchVertices :: IO CInt maxPatchVertices = - alloca $ \ptr -> do - glGetIntegerv GL_MAX_PATCH_VERTICES ptr - fromIntegral <$> peek ptr + alloca $ \ptr -> do + glGetIntegerv GL_MAX_PATCH_VERTICES ptr + fromIntegral <$> peek ptr getGLVersion :: IO String getGLVersion = - let lift2 (a,b) = do - x <- a ; y <- b ; return (x,y) - in - alloca $ \ptr1 -> alloca $ \ptr2 -> do + let lift2 (a, b) = do + x <- a + y <- b + return (x, y) + in alloca $ \ptr1 -> alloca $ \ptr2 -> do glGetIntegerv GL_MAJOR_VERSION ptr1 glGetIntegerv GL_MINOR_VERSION ptr2 - (v1,v2) <- lift2 (peek ptr1, peek ptr2) + (v1, v2) <- lift2 (peek ptr1, peek ptr2) return ("OpenGL " ++ show v1 ++ "." ++ show v2) coerced :: a -coerced = unsafeCoerce (0::Int) +coerced = unsafeCoerce (0 :: Int) |