diff options
author | Kosyrev Serge <_deepfire@feelingofgreen.ru> | 2018-09-18 03:29:34 +0300 |
---|---|---|
committer | Kosyrev Serge <_deepfire@feelingofgreen.ru> | 2018-09-19 01:54:15 +0300 |
commit | f5fe9f8ab7bd9e4ba14a990dd8cac3652f7e9dd3 (patch) | |
tree | 0726ddbabee89286b2d364c90ca6a06cf45ef17b | |
parent | 176ac6939f635e15bb1f5b63f1b210b46f483419 (diff) |
fix | getTextureRenderTargetCommands: honor image component type
-rw-r--r-- | src/LambdaCube/Compiler/CoreToIR.hs | 55 |
1 files changed, 49 insertions, 6 deletions
diff --git a/src/LambdaCube/Compiler/CoreToIR.hs b/src/LambdaCube/Compiler/CoreToIR.hs index decd171e..5d10ad79 100644 --- a/src/LambdaCube/Compiler/CoreToIR.hs +++ b/src/LambdaCube/Compiler/CoreToIR.hs | |||
@@ -38,6 +38,8 @@ import LambdaCube.Compiler.Core (Subst(..), down, nType) | |||
38 | import qualified LambdaCube.Compiler.Core as I | 38 | import qualified LambdaCube.Compiler.Core as I |
39 | import LambdaCube.Compiler.Infer (neutType', makeCaseFunPars') | 39 | import LambdaCube.Compiler.Infer (neutType', makeCaseFunPars') |
40 | 40 | ||
41 | import Debug.Trace | ||
42 | |||
41 | import Data.Version | 43 | import Data.Version |
42 | import Paths_lambdacube_compiler (version) | 44 | import Paths_lambdacube_compiler (version) |
43 | 45 | ||
@@ -209,9 +211,15 @@ getCommands backend e = case e of | |||
209 | 211 | ||
210 | getTextureRenderTargetCommands :: IR.Backend -> IR.V2 Word32 -> ExpTV -> CG ([IR.Command],[IR.Command]) | 212 | getTextureRenderTargetCommands :: IR.Backend -> IR.V2 Word32 -> ExpTV -> CG ([IR.Command],[IR.Command]) |
211 | getTextureRenderTargetCommands backend dim body = do | 213 | getTextureRenderTargetCommands backend dim body = do |
212 | targetItems <- forM (getSemantics body) $ \semantic -> do | 214 | let semantics = getSemantics body |
215 | imageTypes = getImageTextureTypes body | ||
216 | targetItems <- forM (zip semantics imageTypes) | ||
217 | $ \(semantic, imageType) -> do | ||
213 | texture <- addL textureLens IR.TextureDescriptor | 218 | texture <- addL textureLens IR.TextureDescriptor |
214 | { IR.textureType = IR.Texture2D (if semantic == IR.Color then IR.FloatT IR.RGBA else IR.FloatT IR.Red) 1 | 219 | { IR.textureType = IR.Texture2D (if semantic == IR.Color |
220 | then imageType IR.RGBA | ||
221 | else IR.FloatT IR.Red) | ||
222 | 1 | ||
215 | , IR.textureSize = IR.VV2U dim | 223 | , IR.textureSize = IR.VV2U dim |
216 | , IR.textureSemantic = semantic | 224 | , IR.textureSemantic = semantic |
217 | , IR.textureSampler = IR.SamplerDescriptor | 225 | , IR.textureSampler = IR.SamplerDescriptor |
@@ -239,8 +247,17 @@ type SamplerBinding = (IR.UniformName,IR.ImageRef) | |||
239 | frameBufferType (A2 "FrameBuffer" _ ty) = ty | 247 | frameBufferType (A2 "FrameBuffer" _ ty) = ty |
240 | frameBufferType x = error $ "illegal target type: " ++ ppShow x | 248 | frameBufferType x = error $ "illegal target type: " ++ ppShow x |
241 | 249 | ||
250 | getFramebufferType :: ExpTV -> [ExpTV] | ||
251 | getFramebufferType = compList . frameBufferType . tyOf | ||
252 | |||
242 | getSemantics :: ExpTV -> [IR.ImageSemantic] | 253 | getSemantics :: ExpTV -> [IR.ImageSemantic] |
243 | getSemantics = compSemantics . frameBufferType . tyOf | 254 | getSemantics = map compSemantic . getFramebufferType |
255 | |||
256 | getImageTextureTypes :: ExpTV -> [IR.ColorArity -> IR.TextureDataType] | ||
257 | getImageTextureTypes = map (imageInputTypeTextureType . compImageInputType) . getFramebufferType | ||
258 | |||
259 | getImageInputTypes :: ExpTV -> [IR.InputType] | ||
260 | getImageInputTypes = map compImageInputType . getFramebufferType | ||
244 | 261 | ||
245 | getFragFilter (A2 "map" (EtaPrim2 "filterFragment" p) x) = (Just p, x) | 262 | getFragFilter (A2 "map" (EtaPrim2 "filterFragment" p) x) = (Just p, x) |
246 | getFragFilter x = (Nothing, x) | 263 | getFragFilter x = (Nothing, x) |
@@ -265,8 +282,6 @@ compFrameBuffer = \case | |||
265 | A1 "ColorImage" a -> IR.ClearImage IR.Color $ compValue a | 282 | A1 "ColorImage" a -> IR.ClearImage IR.Color $ compValue a |
266 | x -> error $ "compFrameBuffer " ++ ppShow x | 283 | x -> error $ "compFrameBuffer " ++ ppShow x |
267 | 284 | ||
268 | compSemantics = map compSemantic . compList | ||
269 | |||
270 | compList (A2 ":" a x) = a : compList x | 285 | compList (A2 ":" a x) = a : compList x |
271 | compList (A0 "Nil") = [] | 286 | compList (A0 "Nil") = [] |
272 | compList x = error $ "compList: " ++ ppShow x | 287 | compList x = error $ "compList: " ++ ppShow x |
@@ -282,12 +297,39 @@ compEdgeMode = \case | |||
282 | A0 "ClampToEdge" -> IR.ClampToEdge | 297 | A0 "ClampToEdge" -> IR.ClampToEdge |
283 | x -> error $ "compEdgeMode: " ++ ppShow x | 298 | x -> error $ "compEdgeMode: " ++ ppShow x |
284 | 299 | ||
285 | compSemantic = \case | 300 | compSemantic x = case x of |
286 | A0 "Depth" -> IR.Depth | 301 | A0 "Depth" -> IR.Depth |
287 | A0 "Stencil" -> IR.Stencil | 302 | A0 "Stencil" -> IR.Stencil |
288 | A1 "Color" _ -> IR.Color | 303 | A1 "Color" _ -> IR.Color |
289 | x -> error $ "compSemantic: " ++ ppShow x | 304 | x -> error $ "compSemantic: " ++ ppShow x |
290 | 305 | ||
306 | imageInputTypeTextureType :: HasCallStack => IR.InputType -> (IR.ColorArity -> IR.TextureDataType) | ||
307 | imageInputTypeTextureType IR.Float = IR.FloatT | ||
308 | imageInputTypeTextureType IR.Int = IR.IntT | ||
309 | imageInputTypeTextureType IR.V2I = IR.IntT | ||
310 | imageInputTypeTextureType IR.V3I = IR.IntT | ||
311 | imageInputTypeTextureType IR.V4I = IR.IntT | ||
312 | imageInputTypeTextureType IR.V2F = IR.FloatT | ||
313 | imageInputTypeTextureType IR.V3F = IR.FloatT | ||
314 | imageInputTypeTextureType IR.V4F = IR.FloatT | ||
315 | imageInputTypeTextureType x = error $ "Unsupported input type: " <> show x | ||
316 | |||
317 | -- mirrors Builtins.lc:imageType | ||
318 | compImageInputType :: HasCallStack => ExpTV -> IR.InputType | ||
319 | compImageInputType = \case | ||
320 | A0 "Depth" -> IR.Float | ||
321 | A0 "Stencil" -> IR.Int | ||
322 | A1 "Color" c -> case c of | ||
323 | (A2 "VecS" x y) -> flip fromMaybe (compInputType_ c) $ | ||
324 | error $ "Unexpected (compInputType) color image element type: " <> ppShow c | ||
325 | -- -> case x of | ||
326 | -- A0 "Float" -> (IR.Float, y) | ||
327 | -- A0 "Int" -> (IR.Int, y) | ||
328 | -- A0 "Word" -> (IR.Int, y) | ||
329 | -- _ -> error $ "Unexpected color image component type: " <> ppShow x | ||
330 | _ -> error $ "Unexpected color image element type: " <> ppShow c | ||
331 | x -> error $ "compImageType: " ++ ppShow x | ||
332 | |||
291 | compAC (ETuple x) = IR.AccumulationContext Nothing $ map compFrag x | 333 | compAC (ETuple x) = IR.AccumulationContext Nothing $ map compFrag x |
292 | 334 | ||
293 | compBlending x = case x of | 335 | compBlending x = case x of |
@@ -398,6 +440,7 @@ showGLSLType msg = \case | |||
398 | 440 | ||
399 | supType = isJust . compInputType_ | 441 | supType = isJust . compInputType_ |
400 | 442 | ||
443 | compInputType_ :: ExpTV -> Maybe IR.InputType | ||
401 | compInputType_ x = case x of | 444 | compInputType_ x = case x of |
402 | TFloat -> Just IR.Float | 445 | TFloat -> Just IR.Float |
403 | TVec 2 TFloat -> Just IR.V2F | 446 | TVec 2 TFloat -> Just IR.V2F |