@@ -76,7 +76,7 @@ class Storable a => UniformComponent a where
76
76
uniform3 :: UniformLocation -> a -> a -> a -> IO ()
77
77
uniform4 :: UniformLocation -> a -> a -> a -> a -> IO ()
78
78
79
- getUniform :: Storable (b a ) => Program -> UniformLocation -> Ptr (b a ) -> IO ()
79
+ getUniform :: Storable (b a ) => GLuint -> GLint -> Ptr (b a ) -> IO ()
80
80
81
81
uniform1v :: UniformLocation -> GLsizei -> Ptr a -> IO ()
82
82
uniform2v :: UniformLocation -> GLsizei -> Ptr a -> IO ()
@@ -89,7 +89,7 @@ instance UniformComponent GLint where
89
89
uniform3 (UniformLocation ul) = glUniform3i ul
90
90
uniform4 (UniformLocation ul) = glUniform4i ul
91
91
92
- getUniform ( Program p) ( UniformLocation ul) = glGetUniformiv p ul . castPtr
92
+ getUniform p ul = glGetUniformiv p ul . castPtr
93
93
94
94
uniform1v (UniformLocation ul) = glUniform1iv ul
95
95
uniform2v (UniformLocation ul) = glUniform2iv ul
@@ -102,7 +102,7 @@ instance UniformComponent GLuint where
102
102
uniform3 (UniformLocation ul) = glUniform3ui ul
103
103
uniform4 (UniformLocation ul) = glUniform4ui ul
104
104
105
- getUniform ( Program p) ( UniformLocation ul) = glGetUniformuiv p ul . castPtr
105
+ getUniform p ul = glGetUniformuiv p ul . castPtr
106
106
107
107
uniform1v (UniformLocation ul) = glUniform1uiv ul
108
108
uniform2v (UniformLocation ul) = glUniform2uiv ul
@@ -115,7 +115,7 @@ instance UniformComponent GLfloat where
115
115
uniform3 (UniformLocation ul) = glUniform3f ul
116
116
uniform4 (UniformLocation ul) = glUniform4f ul
117
117
118
- getUniform ( Program p) ( UniformLocation ul) = glGetUniformfv p ul . castPtr
118
+ getUniform p ul = glGetUniformfv p ul . castPtr
119
119
120
120
uniform1v (UniformLocation ul) = glUniform1fv ul
121
121
uniform2v (UniformLocation ul) = glUniform2fv ul
@@ -128,7 +128,7 @@ instance UniformComponent GLdouble where
128
128
uniform3 (UniformLocation ul) = glUniform3d ul
129
129
uniform4 (UniformLocation ul) = glUniform4d ul
130
130
131
- getUniform ( Program p) ( UniformLocation ul) = glGetUniformdv p ul . castPtr
131
+ getUniform p ul = glGetUniformdv p ul . castPtr
132
132
133
133
uniform1v (UniformLocation ul) = glUniform1dv ul
134
134
uniform2v (UniformLocation ul) = glUniform2dv ul
@@ -154,38 +154,35 @@ makeUniformVar :: (UniformComponent a, Storable (b a))
154
154
=> (UniformLocation -> b a -> IO () )
155
155
-> UniformLocation -> StateVar (b a )
156
156
makeUniformVar setter location = makeStateVar getter (setter location)
157
- where getter = do program <- fmap fromJust $ get currentProgram
158
- allocaBytes maxUniformBufferSize $ \ buf -> do
159
- getUniform program location buf
160
- peek buf
161
-
162
- getSimpleUniform :: Program -> UniformLocation -> Ptr a -> IO ()
163
- getSimpleUniform (Program p) (UniformLocation ul) = glGetUniformfv p ul . castPtr
164
-
165
- makeSimpleUniformVar :: (UniformComponent a )
166
- => UniformLocation -> StateVar a
167
- makeSimpleUniformVar location = makeStateVar getter (uniform1 location)
168
- where getter = do program <- fmap fromJust $ get currentProgram
169
- allocaBytes maxUniformBufferSize $ \ buf -> do
170
- getSimpleUniform program location buf
171
- peek buf
157
+ where getter = allocaBytes maxUniformBufferSize $ \ buf -> do
158
+ getUniformWith getUniform location buf
159
+ peek buf
160
+
161
+ single :: (UniformLocation -> StateVar (Vertex1 a ))
162
+ -> (UniformLocation -> StateVar a )
163
+ single var location = makeStateVar (do Vertex1 x <- get (var location); return x)
164
+ (\ x -> var location $= Vertex1 x)
172
165
173
166
instance Uniform GLfloat where
174
- uniform = makeSimpleUniformVar
167
+ uniform = single uniform
175
168
uniformv = uniform1v
176
169
177
170
instance Uniform GLint where
178
- uniform = makeSimpleUniformVar
171
+ uniform = single uniform
179
172
uniformv = uniform1v
180
173
181
174
instance Uniform GLuint where
182
- uniform = makeSimpleUniformVar
175
+ uniform = single uniform
183
176
uniformv = uniform1v
184
177
185
178
instance Uniform GLdouble where
186
- uniform = makeSimpleUniformVar
179
+ uniform = single uniform
187
180
uniformv = uniform1v
188
181
182
+ instance UniformComponent a => Uniform (Vertex1 a ) where
183
+ uniform = makeUniformVar $ \ location (Vertex1 x) -> uniform1 location x
184
+ uniformv location count = uniform1v location count . (castPtr :: Ptr (Vertex1 b ) -> Ptr b )
185
+
189
186
instance UniformComponent a => Uniform (Vertex2 a ) where
190
187
uniform = makeUniformVar $ \ location (Vertex2 x y) -> uniform2 location x y
191
188
uniformv location count = uniform2v location count . (castPtr :: Ptr (Vertex2 b ) -> Ptr b )
@@ -198,6 +195,22 @@ instance UniformComponent a => Uniform (Vertex4 a) where
198
195
uniform = makeUniformVar $ \ location (Vertex4 x y z w) -> uniform4 location x y z w
199
196
uniformv location count = uniform4v location count . (castPtr :: Ptr (Vertex4 b ) -> Ptr b )
200
197
198
+ instance UniformComponent a => Uniform (Vector1 a ) where
199
+ uniform = makeUniformVar $ \ location (Vector1 x) -> uniform1 location x
200
+ uniformv location count = uniform1v location count . (castPtr :: Ptr (Vector1 b ) -> Ptr b )
201
+
202
+ instance UniformComponent a => Uniform (Vector2 a ) where
203
+ uniform = makeUniformVar $ \ location (Vector2 x y) -> uniform2 location x y
204
+ uniformv location count = uniform2v location count . (castPtr :: Ptr (Vector2 b ) -> Ptr b )
205
+
206
+ instance UniformComponent a => Uniform (Vector3 a ) where
207
+ uniform = makeUniformVar $ \ location (Vector3 x y z) -> uniform3 location x y z
208
+ uniformv location count = uniform3v location count . (castPtr :: Ptr (Vector3 b ) -> Ptr b )
209
+
210
+ instance UniformComponent a => Uniform (Vector4 a ) where
211
+ uniform = makeUniformVar $ \ location (Vector4 x y z w) -> uniform4 location x y z w
212
+ uniformv location count = uniform4v location count . (castPtr :: Ptr (Vector4 b ) -> Ptr b )
213
+
201
214
instance UniformComponent a => Uniform (TexCoord1 a ) where
202
215
uniform = makeUniformVar $ \ location (TexCoord1 s) -> uniform1 location s
203
216
uniformv location count = uniform1v location count . (castPtr :: Ptr (TexCoord1 b ) -> Ptr b )
0 commit comments