From 873d346e104e4c68ca8be0dc673d936276f3e602 Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Sat, 11 May 2019 20:02:02 -0400
Subject: TextureBuffer support.

---
 lc/Builtins.lc                      |  6 ++++++
 src/LambdaCube/Compiler/CoreToIR.hs | 11 +++++++++++
 2 files changed, 17 insertions(+)

diff --git a/lc/Builtins.lc b/lc/Builtins.lc
index 1657fc8f..c2e2e7a9 100644
--- a/lc/Builtins.lc
+++ b/lc/Builtins.lc
@@ -558,6 +558,11 @@ data Texture where
 data TextureCube where
 	TextureCubeSlot :: String -- texture slot name
                     -> TextureCube
+
+data TextureBuffer where
+	TextureBufferSlot :: String -- texture slot name
+                    -> TextureBuffer
+
 data Filter
   = PointFilter
   | LinearFilter
@@ -572,6 +577,7 @@ data Sampler = Sampler Filter EdgeMode Texture
 -- builtin
 texture2D :: Sampler -> Vec 2 Float -> Vec 4 Float
 textureCube :: TextureCube -> Vec 3 Float -> Vec 4 Float
+textureBuffer :: TextureBuffer -> Int -> Float
 
 
 -- todo: remove
diff --git a/src/LambdaCube/Compiler/CoreToIR.hs b/src/LambdaCube/Compiler/CoreToIR.hs
index 7e4bfbd8..b587096e 100644
--- a/src/LambdaCube/Compiler/CoreToIR.hs
+++ b/src/LambdaCube/Compiler/CoreToIR.hs
@@ -492,6 +492,7 @@ showGLSLType msg = \case
     IR.M43F  -> "mat4x3"
     IR.FTexture2D -> "sampler2D"
     IR.FTextureCube -> "samplerCube"
+    IR.FTextureBuffer -> "samplerBuffer"
     t -> error $ "toGLSLType: " ++ msg ++ " " ++ show t
 
 supType :: ExpTV -> Bool
@@ -773,6 +774,8 @@ genGLSLs backend
       <> ["precision highp float;" | backend == WebGL1]
       <> ["precision highp int;"   | backend == WebGL1]
       <> [shaderFunc "vec4" "texture2D" ["sampler2D s", "vec2 uv"] [shaderReturn "texture(s,uv)"] | backend == OpenGL33]
+      <> [shaderFunc "vec4" "textureCube" ["samplerCube s", "vec3 x"] [shaderReturn "texture(s,x)"] | backend == OpenGL33]
+      <> [shaderFunc "float" "textureBuffer" ["samplerBuffer s", "int x"] [shaderReturn "texelFetch(s,x).r"] | backend == OpenGL33]
       <> [shaderFunc "mat4" "transpose" ["mat4 m"]  -- todo: not just for 4 dimension
             [ shaderLet "vec4 i0" "m[0]"
             , shaderLet "vec4 i1" "m[1]"
@@ -802,6 +805,7 @@ data Uniform
     = UUniform
     | UTexture2DSlot
     | UTextureCubeSlot
+    | UTextureBufferSlot
     | UTexture2D IR.Filter IR.EdgeMode Integer Integer ExpTV
 
 type Uniforms = Map String (Uniform, IR.InputType)
@@ -846,6 +850,11 @@ genGLSL backend dns e = case e of
         [EString s] -> do
             tellUniform $ Map.singleton s $ (,) UTextureCubeSlot IR.FTextureCube
             pure $ text s
+    "TextureBufferSlot" -> case xs of
+        [EString s] -> do
+            tellUniform $ Map.singleton s $ (,) UTextureBufferSlot IR.FTextureBuffer
+            pure $ text s
+
 
 
     'P':'r':'i':'m':n | n'@(_:_) <- trName (dropS n) -> call n' xs
@@ -941,6 +950,7 @@ genGLSL backend dns e = case e of
         trName n = case n of
             "texture2D" -> "texture2D"
             "textureCube" -> "textureCube"
+            "textureBuffer" -> "textureBuffer"
 
             "True"  -> "true"
             "False" -> "false"
@@ -1545,6 +1555,7 @@ genHLSLs backend
     shader xs = vcat $
          [shaderFunc "vec4" "texture2D" ["sampler2D s", "vec2 uv"] [shaderReturn "texture(s,uv)"] | backend == OpenGL33]
       <> [shaderFunc "vec4" "textureCube" ["samplerCube s", "vec3 x"] [shaderReturn "texture(s,x)"] | backend == OpenGL33]
+      <> [shaderFunc "float" "textureBuffer" ["samplerBuffer s", "int x"] [shaderReturn "texelFetch(s,x).r"] | backend == OpenGL33]
       <> [shaderFunc "mat4" "transpose" ["mat4 m"]  -- todo: not just for 4 dimension
             [ shaderLet "vec4 i0" "m[0]"
             , shaderLet "vec4 i1" "m[1]"
-- 
cgit v1.2.3