TextureCube support.

1 files changed, 6 insertions, 7 deletions

diff --git a/src/LambdaCube/GL/Backend.hs b/src/LambdaCube/GL/Backend.hs
index 08f10d4..f3bfe47 100644
--- a/src/LambdaCube/GL/Backend.hs
+++ b/src/LambdaCube/GL/Backend.hs
@@ -4,6 +4,7 @@ module LambdaCube.GL.Backend where
 import Control.Applicative
 import Control.Monad
 import Control.Monad.State.Strict
+import Data.Coerce
 import Data.Maybe
 import Data.Bits
 import Data.IORef
@@ -489,7 +490,7 @@ createStreamCommands texUnitMap topUnis attrs primitive prg = streamUniCmds ++ s
                   , let texUnit = Map.findWithDefault (error "internal error (createStreamCommands - Texture Unit)") n texUnitMap
                   ]
         uniInputType (GLTypedUniform ty _) = unwitnessType ty
-        uniInputType (GLUniform ty _)      = ty
+        uniInputType (GLUniform r)         = objectType r
 
 
     -- object attribute stream commands
@@ -768,12 +769,10 @@ renderSlot glDrawCallCounterRef glVertexBufferRef glIndexBufferRef cmds = forM_
                                                             glDrawElements mode count typ indicesPtr
                                                             modifyIORef glDrawCallCounterRef succ
         GLSetUniform idx (GLTypedUniform ty ref)        -> setUniform idx ty (readIORef ref)
-        GLSetUniform idx (GLUniform ty ref)             -> return () -- putStrLn $ "TODO: setUniform FTexture2D"
-        GLBindTexture txTarget tuRef (GLUniform _ ref)  -> do
-                                                            txObjVal <- readIORef ref
-                                                            -- HINT: ugly and hacky
-                                                            with txObjVal $ \txObjPtr -> do
-                                                                txObj <- peek $ castPtr txObjPtr :: IO GLuint
+        GLSetUniform idx (GLUniform ref)                -> return () -- putStrLn $ "TODO: setUniform FTexture2D"
+        GLBindTexture txTarget tuRef (GLUniform ref)  -> do
+                                                            txObj <- coerce <$> readIORef ref
+                                                            do
                                                                 texUnit <- readIORef tuRef
                                                                 glActiveTexture $ GL_TEXTURE0 + fromIntegral texUnit
                                                                 glBindTexture txTarget txObj