summaryrefslogtreecommitdiff
path: root/src/LambdaCube/GL/Backend.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/LambdaCube/GL/Backend.hs')
-rw-r--r--src/LambdaCube/GL/Backend.hs8
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
30import LambdaCube.IR hiding (streamType) 30import LambdaCube.IR hiding (streamType)
31import qualified LambdaCube.IR as IR 31import qualified LambdaCube.IR as IR
32 32
33import LambdaCube.GL.Input.Type
33import LambdaCube.GL.Type 34import LambdaCube.GL.Type
34import LambdaCube.GL.Util 35import LambdaCube.GL.Util
35 36
@@ -487,7 +488,9 @@ createStreamCommands texUnitMap topUnis attrs primitive prg = streamUniCmds ++ s
487 , let u = topUni n 488 , let u = topUni n
488 , let texUnit = Map.findWithDefault (error "internal error (createStreamCommands - Texture Unit)") n texUnitMap 489 , let texUnit = Map.findWithDefault (error "internal error (createStreamCommands - Texture Unit)") n texUnitMap
489 ] 490 ]
490 uniInputType (GLUniform ty _) = ty 491 uniInputType (GLTypedUniform ty _) = unwitnessType ty
492 uniInputType (GLUniform ty _) = ty
493
491 494
492 -- object attribute stream commands 495 -- object attribute stream commands
493 streamCmds = [attrCmd i s | (i,name) <- Map.elems attrMap, let s = fromMaybe (error $ "missing attribute: " ++ name) $ Map.lookup name attrs] 496 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_
764 setup glIndexBufferRef buf $ glBindBuffer GL_ELEMENT_ARRAY_BUFFER buf 767 setup glIndexBufferRef buf $ glBindBuffer GL_ELEMENT_ARRAY_BUFFER buf
765 glDrawElements mode count typ indicesPtr 768 glDrawElements mode count typ indicesPtr
766 modifyIORef glDrawCallCounterRef succ 769 modifyIORef glDrawCallCounterRef succ
767 GLSetUniform idx (GLUniform ty ref) -> setUniform idx ty ref 770 GLSetUniform idx (GLTypedUniform ty ref) -> setUniform idx ty (readIORef ref)
771 GLSetUniform idx (GLUniform ty ref) -> return () -- putStrLn $ "TODO: setUniform FTexture2D"
768 GLBindTexture txTarget tuRef (GLUniform _ ref) -> do 772 GLBindTexture txTarget tuRef (GLUniform _ ref) -> do
769 txObjVal <- readIORef ref 773 txObjVal <- readIORef ref
770 -- HINT: ugly and hacky 774 -- HINT: ugly and hacky