TextureCube support.

1 files changed, 13 insertions, 7 deletions

diff --git a/src/LambdaCube/GL/Type.hs b/src/LambdaCube/GL/Type.hs
index 97b8e25..ce3a365 100644
--- a/src/LambdaCube/GL/Type.hs
+++ b/src/LambdaCube/GL/Type.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving, ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts #-}
 module LambdaCube.GL.Type where
 
+import Data.Coerce
 import Data.IORef
 import Data.Int
 import Data.IntMap.Strict (IntMap)
@@ -70,10 +72,13 @@ data ArrayDesc
     - per object features: enable/disable visibility, set render ordering
 -}
 data GLUniform = forall c. Typeable c => GLTypedUniform (TypeTag c) (IORef (GLUniformValue c))
-               | GLUniform !InputType !(IORef TextureData)
+               | forall t. IsGLObject t => GLUniform (IORef t)
 
 data GLUniformValue c = forall a. GLData a c => GLUniformValue a
 
+class (Coercible t Word32, Typeable t) => IsGLObject t where
+    objectType :: p t -> InputType
+
 instance Show GLUniform where
     showsPrec d (GLTypedUniform t _) = paren '('
                                      . mappend "GLUniform "
@@ -81,7 +86,7 @@ instance Show GLUniform where
                                      . paren ')'
         where paren | d<=10     = (:)
                     | otherwise = \_ -> id
-    showsPrec d (GLUniform t _) = paren '(' . mappend "GLUniform " . showsPrec (d+10) t . paren ')'
+    showsPrec d (GLUniform r) = paren '(' . mappend "GLUniform " . showsPrec (d+10) (objectType r) . paren ')'
         where paren | d<=10     = (:)
                     | otherwise = \_ -> id
 
@@ -396,11 +401,12 @@ data IndexStream b
     , indexLength   :: Int
     }
 
-newtype TextureData
-    = TextureData
-    { textureObject :: GLuint
-    }
-    deriving Storable
+newtype TextureData = Texture2DName GLuint
+instance IsGLObject TextureData where objectType _ = FTexture2D
+
+newtype TextureCubeData = TextureCubeName GLuint
+instance IsGLObject TextureCubeData where objectType _ = FTextureCube
+
 
 data Primitive
     = TriangleStrip