From 9c8b68d747cb28047e444447a3398c136ba26c8d Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Thu, 2 May 2019 17:07:35 -0400
Subject: TextureCube support.

---
 lc/Builtins.lc                      | 4 ++++
 src/LambdaCube/Compiler/CoreToIR.hs | 9 +++++++++
 2 files changed, 13 insertions(+)

diff --git a/lc/Builtins.lc b/lc/Builtins.lc
index 15840268..1657fc8f 100644
--- a/lc/Builtins.lc
+++ b/lc/Builtins.lc
@@ -555,6 +555,9 @@ data Texture where
                 -> Image 1 (Color (Vec 4 Float))
                 -> Texture
 
+data TextureCube where
+	TextureCubeSlot :: String -- texture slot name
+                    -> TextureCube
 data Filter
   = PointFilter
   | LinearFilter
@@ -568,6 +571,7 @@ data Sampler = Sampler Filter EdgeMode Texture
 
 -- builtin
 texture2D :: Sampler -> Vec 2 Float -> Vec 4 Float
+textureCube :: TextureCube -> Vec 3 Float -> Vec 4 Float
 
 
 -- todo: remove
diff --git a/src/LambdaCube/Compiler/CoreToIR.hs b/src/LambdaCube/Compiler/CoreToIR.hs
index 30353129..7e4bfbd8 100644
--- a/src/LambdaCube/Compiler/CoreToIR.hs
+++ b/src/LambdaCube/Compiler/CoreToIR.hs
@@ -491,6 +491,7 @@ showGLSLType msg = \case
     IR.M42F  -> "mat4x2"
     IR.M43F  -> "mat4x3"
     IR.FTexture2D -> "sampler2D"
+    IR.FTextureCube -> "samplerCube"
     t -> error $ "toGLSLType: " ++ msg ++ " " ++ show t
 
 supType :: ExpTV -> Bool
@@ -800,6 +801,7 @@ genGLSLs backend
 data Uniform
     = UUniform
     | UTexture2DSlot
+    | UTextureCubeSlot
     | UTexture2D IR.Filter IR.EdgeMode Integer Integer ExpTV
 
 type Uniforms = Map String (Uniform, IR.InputType)
@@ -840,6 +842,11 @@ genGLSL backend dns e = case e of
             s <- newName
             tellUniform $ Map.singleton s $ (,) (UTexture2D (compFilter textureFilter) (compEdgeMode edgeMode) w h b) IR.FTexture2D
             pure $ text s
+    "TextureCubeSlot" -> case xs of
+        [EString s] -> do
+            tellUniform $ Map.singleton s $ (,) UTextureCubeSlot IR.FTextureCube
+            pure $ text s
+
 
     'P':'r':'i':'m':n | n'@(_:_) <- trName (dropS n) -> call n' xs
      where
@@ -933,6 +940,7 @@ genGLSL backend dns e = case e of
       where
         trName n = case n of
             "texture2D" -> "texture2D"
+            "textureCube" -> "textureCube"
 
             "True"  -> "true"
             "False" -> "false"
@@ -1536,6 +1544,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 "mat4" "transpose" ["mat4 m"]  -- todo: not just for 4 dimension
             [ shaderLet "vec4 i0" "m[0]"
             , shaderLet "vec4 i1" "m[1]"
-- 
cgit v1.2.3