summaryrefslogtreecommitdiff
path: root/Backend/GL/Backend.hs
diff options
context:
space:
mode:
authorCsaba Hruska <csaba.hruska@gmail.com>2015-09-09 14:53:15 +0200
committerCsaba Hruska <csaba.hruska@gmail.com>2015-09-09 14:53:15 +0200
commit6c0c6a8c4f51d2b2a7ef5cb708bfe5632ba8afe8 (patch)
tree6d8cc7ae3a4cac8cd828bb3e6e2346dd2d8b20cb /Backend/GL/Backend.hs
parent2bdb09a65437b09fef987142a1ee40c12a01b11e (diff)
adjust to IR renaming
Diffstat (limited to 'Backend/GL/Backend.hs')
-rw-r--r--Backend/GL/Backend.hs28
1 files changed, 14 insertions, 14 deletions
diff --git a/Backend/GL/Backend.hs b/Backend/GL/Backend.hs
index 735f386..e748682 100644
--- a/Backend/GL/Backend.hs
+++ b/Backend/GL/Backend.hs
@@ -144,7 +144,7 @@ setupAccumulationContext (AccumulationContext n ops) = cvt ops
144 glDisable gl_BLEND 144 glDisable gl_BLEND
145 glEnable gl_COLOR_LOGIC_OP 145 glEnable gl_COLOR_LOGIC_OP
146 glLogicOp $ logicOperationToGLType op 146 glLogicOp $ logicOperationToGLType op
147 Blend (cEq,aEq) ((scF,dcF),(saF,daF)) (V4 r g b a) -> do 147 Blend cEq aEq scF dcF saF daF (V4 r g b a) -> do
148 glDisable gl_COLOR_LOGIC_OP 148 glDisable gl_COLOR_LOGIC_OP
149 -- FIXME: requires GL 3.1 149 -- FIXME: requires GL 3.1
150 --glEnablei gl_BLEND $ fromIntegral gl_DRAW_BUFFER0 + fromIntegral i 150 --glEnablei gl_BLEND $ fromIntegral gl_DRAW_BUFFER0 + fromIntegral i
@@ -169,17 +169,17 @@ setupAccumulationContext (AccumulationContext n ops) = cvt ops
169 cvtBool True = 1 169 cvtBool True = 1
170 cvtBool False = 0 170 cvtBool False = 0
171 171
172clearRenderTarget :: [(ImageSemantic,Value)] -> IO () 172clearRenderTarget :: [ClearImage] -> IO ()
173clearRenderTarget values = do 173clearRenderTarget values = do
174 let setClearValue (m,i) value = case value of 174 let setClearValue (m,i) value = case value of
175 (Depth, VFloat v) -> do 175 ClearImage Depth (VFloat v) -> do
176 glDepthMask 1 176 glDepthMask 1
177 glClearDepth $ realToFrac v 177 glClearDepth $ realToFrac v
178 return (m .|. gl_DEPTH_BUFFER_BIT, i) 178 return (m .|. gl_DEPTH_BUFFER_BIT, i)
179 (Stencil, VWord v) -> do 179 ClearImage Stencil (VWord v) -> do
180 glClearStencil $ fromIntegral v 180 glClearStencil $ fromIntegral v
181 return (m .|. gl_STENCIL_BUFFER_BIT, i) 181 return (m .|. gl_STENCIL_BUFFER_BIT, i)
182 (Color, c) -> do 182 ClearImage Color c -> do
183 let (r,g,b,a) = case c of 183 let (r,g,b,a) = case c of
184 VFloat r -> (realToFrac r, 0, 0, 1) 184 VFloat r -> (realToFrac r, 0, 0, 1)
185 VV2F (V2 r g) -> (realToFrac r, realToFrac g, 0, 1) 185 VV2F (V2 r g) -> (realToFrac r, realToFrac g, 0, 1)
@@ -212,7 +212,7 @@ compileProgram uniTrie p = do
212 Nothing -> [] 212 Nothing -> []
213 Just s -> [createAndAttach s gl_GEOMETRY_SHADER] 213 Just s -> [createAndAttach s gl_GEOMETRY_SHADER]
214 214
215 forM_ (zip (programOutput p) [0..]) $ \((pack -> n,t),i) -> SB.useAsCString n $ \pn -> do 215 forM_ (zip (programOutput p) [0..]) $ \(Parameter (pack -> n) t,i) -> SB.useAsCString n $ \pn -> do
216 putStrLn ("variable " ++ show n ++ " attached to color number #" ++ show i) 216 putStrLn ("variable " ++ show n ++ " attached to color number #" ++ show i)
217 glBindFragDataLocation po i $ castPtr pn 217 glBindFragDataLocation po i $ castPtr pn
218 putStr " + setup shader output mapping: " >> printGLStatus 218 putStr " + setup shader output mapping: " >> printGLStatus
@@ -230,7 +230,7 @@ compileProgram uniTrie p = do
230 print uniforms 230 print uniforms
231 print attributes 231 print attributes
232 let lcUniforms = (toTrie $ programUniforms p) `unionL` (toTrie $ programInTextures p) 232 let lcUniforms = (toTrie $ programUniforms p) `unionL` (toTrie $ programInTextures p)
233 lcStreams = fmap snd (toTrie $ programStreams p) 233 lcStreams = fmap ty (toTrie $ programStreams p)
234 check a m = and $ map go $ T.toList m 234 check a m = and $ map go $ T.toList m
235 where go (k,b) = case T.lookup k a of 235 where go (k,b) = case T.lookup k a of
236 Nothing -> True 236 Nothing -> True
@@ -250,7 +250,7 @@ compileProgram uniTrie p = do
250 , inputUniforms = T.fromList inUniforms 250 , inputUniforms = T.fromList inUniforms
251 , inputTextures = T.fromList inTextures 251 , inputTextures = T.fromList inTextures
252 , inputTextureUniforms = S.fromList $ texUnis 252 , inputTextureUniforms = S.fromList $ texUnis
253 , inputStreams = T.fromList [(n,(idx,pack attrName)) | ((n,idx),(_,(attrName,_))) <- zip (T.toList $ attributes) (T.toList $ toTrie $ programStreams p)] 253 , inputStreams = T.fromList [(n,(idx, pack attrName)) | ((n,idx),(_,(Parameter attrName _))) <- zip (T.toList $ attributes) (T.toList $ toTrie $ programStreams p)]
254 } 254 }
255 255
256compileSampler :: SamplerDescriptor -> IO GLSampler 256compileSampler :: SamplerDescriptor -> IO GLSampler
@@ -284,10 +284,10 @@ compileRenderTarget :: Vector TextureDescriptor -> Vector GLTexture -> RenderTar
284compileRenderTarget texs glTexs (RenderTarget targets) = do 284compileRenderTarget texs glTexs (RenderTarget targets) = do
285 let isFB (Framebuffer _) = True 285 let isFB (Framebuffer _) = True
286 isFB _ = False 286 isFB _ = False
287 images = [img | (_,Just img) <- targets] 287 images = [img | TargetItem _ (Just img) <- targets]
288 case all isFB images of 288 case all isFB images of
289 True -> do 289 True -> do
290 let bufs = [cvt img | (Color,img) <- targets] 290 let bufs = [cvt img | TargetItem Color img <- targets]
291 cvt a = case a of 291 cvt a = case a of
292 Nothing -> gl_NONE 292 Nothing -> gl_NONE
293 Just (Framebuffer Color) -> gl_BACK_LEFT 293 Just (Framebuffer Color) -> gl_BACK_LEFT
@@ -342,17 +342,17 @@ compileRenderTarget texs glTexs (RenderTarget targets) = do
342 | otherwise -> attach2D 342 | otherwise -> attach2D
343 TextureBuffer _ -> fail "internalError (compileRenderTarget/TextureBuffer)!" 343 TextureBuffer _ -> fail "internalError (compileRenderTarget/TextureBuffer)!"
344 344
345 go a (Stencil,Just img) = do 345 go a (TargetItem Stencil (Just img)) = do
346 fail "Stencil support is not implemented yet!" 346 fail "Stencil support is not implemented yet!"
347 return a 347 return a
348 go a (Depth,Just img) = do 348 go a (TargetItem Depth (Just img)) = do
349 attach gl_DEPTH_ATTACHMENT img 349 attach gl_DEPTH_ATTACHMENT img
350 return a 350 return a
351 go (bufs,colorIdx) (Color,Just img) = do 351 go (bufs,colorIdx) (TargetItem Color (Just img)) = do
352 let attachment = gl_COLOR_ATTACHMENT0 + fromIntegral colorIdx 352 let attachment = gl_COLOR_ATTACHMENT0 + fromIntegral colorIdx
353 attach attachment img 353 attach attachment img
354 return (attachment : bufs, colorIdx + 1) 354 return (attachment : bufs, colorIdx + 1)
355 go (bufs,colorIdx) (Color,Nothing) = return (gl_NONE : bufs, colorIdx + 1) 355 go (bufs,colorIdx) (TargetItem Color Nothing) = return (gl_NONE : bufs, colorIdx + 1)
356 go a _ = return a 356 go a _ = return a
357 (bufs,_) <- foldM go ([],0) targets 357 (bufs,_) <- foldM go ([],0) targets
358 withArray (reverse bufs) $ glDrawBuffers (fromIntegral $ length bufs) 358 withArray (reverse bufs) $ glDrawBuffers (fromIntegral $ length bufs)