blob: 9b50ddbc7614d30d8527f5bb841a89927bf3a883 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
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 Graphics.GL.Compatibility30
import Graphics.GL.Core43
import qualified Graphics.Rendering.OpenGL as GL
import System.IO.Unsafe
import Unsafe.Coerce
data ExPrimitiveMode = Points | Triangles | Lines | Patches deriving (Show, Enum)
class IsBindable a where
bind :: a -> IO ()
class IsGLEnumMarshallable a where
toGLEnum :: a -> GLenum
class IsGenerable a where
generate :: IO a
class IsWrappedPrimitive t a where
unwrap :: a -> t
wrap :: t -> a
class HasIntegerParam t a where
parami :: t -> a -> SettableStateVar GLuint
class HasFloatParam t a where
paramf :: t -> a -> SettableStateVar GLfloat
class HasParamOfType b t a where
param :: t -> a -> SettableStateVar b
class IsPrimitiveModeMarshallable a where
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
instance (IsWrappedPrimitive a a) where
unwrap = id
wrap = id
instance (IsWrappedPrimitive GLenum a) => IsGLEnumMarshallable a where
toGLEnum = unwrap
instance IsPrimitiveModeMarshallable ExPrimitiveMode where
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
instance IsPrimitiveModeMarshallable GLuint where
marshalPrimitiveMode = id
vertexAttributeDivisor :: GL.AttribLocation -> SettableStateVar GLuint
vertexAttributeDivisor (GL.AttribLocation loc) =
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
{- 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
getGLVersion :: IO String
getGLVersion =
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)
return ("OpenGL " ++ show v1 ++ "." ++ show v2)
coerced :: a
coerced = unsafeCoerce (0 :: Int)
|
