From eef90e5765cbeb5d41b3db9f170ead03c5fd10bd Mon Sep 17 00:00:00 2001
From: Kosyrev Serge <_deepfire@feelingofgreen.ru>
Date: Wed, 19 Sep 2018 01:54:55 +0300
Subject: getCommands:  make program output type depend on pipeline type

---
 src/LambdaCube/Compiler/CoreToIR.hs | 13 +++++++++++--
 1 file changed, 11 insertions(+), 2 deletions(-)

diff --git a/src/LambdaCube/Compiler/CoreToIR.hs b/src/LambdaCube/Compiler/CoreToIR.hs
index 5d10ad79..30d05916 100644
--- a/src/LambdaCube/Compiler/CoreToIR.hs
+++ b/src/LambdaCube/Compiler/CoreToIR.hs
@@ -95,7 +95,7 @@ addTarget backend a tl = do
     rt <- addL targetLens $ IR.RenderTarget $ Vector.fromList tl
     second (IR.SetRenderTarget rt:) <$> getCommands backend a
 
-getCommands :: Backend -> ExpTV{-FrameBuffer-} -> CG ([IR.Command],[IR.Command])
+getCommands :: HasCallStack => Backend -> ExpTV{-FrameBuffer-} -> CG ([IR.Command],[IR.Command])
 getCommands backend e = case e of
 
     A1 "FrameBuffer" (ETuple a) -> return ([], [IR.ClearRenderTarget $ Vector.fromList $ map compFrameBuffer a])
@@ -112,11 +112,20 @@ getCommands backend e = case e of
 
             pUniforms' = snd <$> Map.filter ((\case UTexture2D{} -> False; _ -> True) . fst) pUniforms
 
+            imageSemantics   = getSemantics  e
+            imageTypes       = getImageInputTypes e
+            outImageType
+              = case imageTypes of
+                  []  -> error "Component-free pipelines are not supported."
+                  [x] -> x
+                  xs  -> flip fromMaybe (lookup IR.Color $ zip imageSemantics xs) $
+                         error "Multiple outputs, but no Color buffer?"
+
             prg = IR.Program
                 { IR.programUniforms    = pUniforms'
                 , IR.programStreams     = Map.fromList $ zip vertexInput $ map (uncurry IR.Parameter) input
                 , IR.programInTextures  = snd <$> Map.filter ((\case UUniform{} -> False; _ -> True) . fst) pUniforms
-                , IR.programOutput      = pure $ IR.Parameter "f0" IR.V4F -- TODO
+                , IR.programOutput      = pure $ IR.Parameter "f0" outImageType
                 , IR.vertexShader       = show vertSrc
                 , IR.geometryShader     = mempty -- TODO
                 , IR.fragmentShader     = show fragSrc
-- 
cgit v1.2.3