diff options
Diffstat (limited to 'src/LambdaCube/Compiler/CoreToIR.hs')
-rw-r--r-- | src/LambdaCube/Compiler/CoreToIR.hs | 34 |
1 files changed, 33 insertions, 1 deletions
diff --git a/src/LambdaCube/Compiler/CoreToIR.hs b/src/LambdaCube/Compiler/CoreToIR.hs index 6646d345..decd171e 100644 --- a/src/LambdaCube/Compiler/CoreToIR.hs +++ b/src/LambdaCube/Compiler/CoreToIR.hs | |||
@@ -22,6 +22,7 @@ import qualified Data.Map as Map | |||
22 | import qualified Data.Set as Set | 22 | import qualified Data.Set as Set |
23 | import qualified Data.Vector as Vector | 23 | import qualified Data.Vector as Vector |
24 | import GHC.Stack | 24 | import GHC.Stack |
25 | import GHC.Word | ||
25 | import Control.Arrow hiding ((<+>)) | 26 | import Control.Arrow hiding ((<+>)) |
26 | import Control.Monad.Writer | 27 | import Control.Monad.Writer |
27 | import Control.Monad.State | 28 | import Control.Monad.State |
@@ -58,7 +59,12 @@ compilePipeline backend exp = IR.Pipeline | |||
58 | ((subCmds,cmds), (streams, programs, targets, slots, textures)) | 59 | ((subCmds,cmds), (streams, programs, targets, slots, textures)) |
59 | = flip runState ((0, mempty), mempty, (0, mempty), mempty, (0, mempty)) $ case toExp exp of | 60 | = flip runState ((0, mempty), mempty, (0, mempty), mempty, (0, mempty)) $ case toExp exp of |
60 | A1 "ScreenOut" a -> addTarget backend a [IR.TargetItem s $ Just $ IR.Framebuffer s | s <- getSemantics a] | 61 | A1 "ScreenOut" a -> addTarget backend a [IR.TargetItem s $ Just $ IR.Framebuffer s | s <- getSemantics a] |
61 | x -> error $ "ScreenOut expected inststead of " ++ ppShow x | 62 | A2 "TextureOut" rtexDimE rtexE -> do |
63 | let rtexDim = case compValue rtexDimE of | ||
64 | IR.VV2I v -> fromIntegral <$> v | ||
65 | x -> error "Render texture dimensions should be a pair of non-negative integrals." | ||
66 | getTextureRenderTargetCommands backend rtexDim rtexE | ||
67 | x -> error $ "ScreenOut or TextureOut expected inststead of " ++ ppShow x | ||
62 | 68 | ||
63 | type CG = State (List IR.StreamData, Map IR.Program Int, List IR.RenderTarget, Map String (Int, IR.Slot), List IR.TextureDescriptor) | 69 | type CG = State (List IR.StreamData, Map IR.Program Int, List IR.RenderTarget, Map String (Int, IR.Slot), List IR.TextureDescriptor) |
64 | 70 | ||
@@ -174,6 +180,7 @@ getCommands backend e = case e of | |||
174 | let (a, tf) = case img of | 180 | let (a, tf) = case img of |
175 | A1 "PrjImageColor" a -> (,) a $ \[_, x] -> x | 181 | A1 "PrjImageColor" a -> (,) a $ \[_, x] -> x |
176 | A1 "PrjImage" a -> (,) a $ \[x] -> x | 182 | A1 "PrjImage" a -> (,) a $ \[x] -> x |
183 | x -> error $ "Unexpected image: " <> ppShow x | ||
177 | tl <- forM (getSemantics a) $ \semantic -> do | 184 | tl <- forM (getSemantics a) $ \semantic -> do |
178 | texture <- addL textureLens IR.TextureDescriptor | 185 | texture <- addL textureLens IR.TextureDescriptor |
179 | { IR.textureType = IR.Texture2D (if semantic == IR.Color then IR.FloatT IR.RGBA else IR.FloatT IR.Red) 1 | 186 | { IR.textureType = IR.Texture2D (if semantic == IR.Color then IR.FloatT IR.RGBA else IR.FloatT IR.Red) 1 |
@@ -200,6 +207,31 @@ getCommands backend e = case e of | |||
200 | return ([(n, tx)], subCmds ++ cmds) | 207 | return ([(n, tx)], subCmds ++ cmds) |
201 | _ -> return mempty | 208 | _ -> return mempty |
202 | 209 | ||
210 | getTextureRenderTargetCommands :: IR.Backend -> IR.V2 Word32 -> ExpTV -> CG ([IR.Command],[IR.Command]) | ||
211 | getTextureRenderTargetCommands backend dim body = do | ||
212 | targetItems <- forM (getSemantics body) $ \semantic -> do | ||
213 | 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 | ||
215 | , IR.textureSize = IR.VV2U dim | ||
216 | , IR.textureSemantic = semantic | ||
217 | , IR.textureSampler = IR.SamplerDescriptor | ||
218 | { IR.samplerWrapS = IR.Repeat | ||
219 | , IR.samplerWrapT = Just IR.Repeat | ||
220 | , IR.samplerWrapR = Nothing | ||
221 | , IR.samplerMinFilter = IR.Nearest | ||
222 | , IR.samplerMagFilter = IR.Nearest | ||
223 | , IR.samplerBorderColor = IR.VV4F (IR.V4 0 0 0 1) | ||
224 | , IR.samplerMinLod = Nothing | ||
225 | , IR.samplerMaxLod = Nothing | ||
226 | , IR.samplerLodBias = 0 | ||
227 | , IR.samplerCompareFunc = Nothing | ||
228 | } | ||
229 | , IR.textureBaseLevel = 0 | ||
230 | , IR.textureMaxLevel = 0 | ||
231 | } | ||
232 | return $ IR.TargetItem semantic $ Just $ IR.TextureImage texture 0 Nothing | ||
233 | addTarget backend body targetItems | ||
234 | |||
203 | type SamplerBinding = (IR.UniformName,IR.ImageRef) | 235 | type SamplerBinding = (IR.UniformName,IR.ImageRef) |
204 | 236 | ||
205 | ---------------------------------------------------------------- | 237 | ---------------------------------------------------------------- |