Representation-agnostic matrix/vector pipeline inputs.

1 files changed, 6 insertions, 2 deletions

diff --git a/src/LambdaCube/GL/Backend.hs b/src/LambdaCube/GL/Backend.hs
index c5e3190..08f10d4 100644
--- a/src/LambdaCube/GL/Backend.hs
+++ b/src/LambdaCube/GL/Backend.hs
@@ -30,6 +30,7 @@ import LambdaCube.Linear
 import LambdaCube.IR hiding (streamType)
 import qualified LambdaCube.IR as IR
 
+import LambdaCube.GL.Input.Type
 import LambdaCube.GL.Type
 import LambdaCube.GL.Util
 
@@ -487,7 +488,9 @@ createStreamCommands texUnitMap topUnis attrs primitive prg = streamUniCmds ++ s
                   , let u = topUni n
                   , let texUnit = Map.findWithDefault (error "internal error (createStreamCommands - Texture Unit)") n texUnitMap
                   ]
-        uniInputType (GLUniform ty _) = ty
+        uniInputType (GLTypedUniform ty _) = unwitnessType ty
+        uniInputType (GLUniform ty _)      = ty
+
 
     -- object attribute stream commands
     streamCmds = [attrCmd i s | (i,name) <- Map.elems attrMap, let s = fromMaybe (error $ "missing attribute: " ++ name) $ Map.lookup name attrs]
@@ -764,7 +767,8 @@ renderSlot glDrawCallCounterRef glVertexBufferRef glIndexBufferRef cmds = forM_
                                                             setup glIndexBufferRef buf $ glBindBuffer GL_ELEMENT_ARRAY_BUFFER buf
                                                             glDrawElements mode count typ indicesPtr
                                                             modifyIORef glDrawCallCounterRef succ
-        GLSetUniform idx (GLUniform ty ref)             -> setUniform idx ty ref
+        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