Signatures, comments, dead-code removal.

4 files changed, 32 insertions, 4 deletions

diff --git a/src/LambdaCube/GL/Backend.hs b/src/LambdaCube/GL/Backend.hs
index 1cf3f62..c5e3190 100644
--- a/src/LambdaCube/GL/Backend.hs
+++ b/src/LambdaCube/GL/Backend.hs
@@ -220,7 +220,10 @@ clearRenderTarget GLRenderTarget{..} values = do
     (mask,_) <- foldM setClearValue (0,0) values
     glClear $ fromIntegral mask
 
+printGLStatus :: IO ()
 printGLStatus = checkGL >>= print
+
+printFBOStatus :: IO ()
 printFBOStatus = checkFBO >>= print
 
 compileProgram :: Program -> IO GLProgram
@@ -777,6 +780,8 @@ renderSlot glDrawCallCounterRef glVertexBufferRef glIndexBufferRef cmds = forM_
     --isOk <- checkGL
     --putStrLn $ isOk ++ " - " ++ show cmd
 
+setupRenderTarget :: IORef (Maybe InputConnection)
+                           -> GLRenderTarget -> IO ()
 setupRenderTarget glInput GLRenderTarget{..} = do
   -- set target viewport
   ic' <- readIORef glInput
@@ -792,6 +797,11 @@ setupRenderTarget glInput GLRenderTarget{..} = do
       Nothing -> return ()
       Just bl -> withArray bl $ glDrawBuffers (fromIntegral $ length bl)
 
+setupDrawContext :: IORef Bool
+                          -> IORef GLDrawContext
+                          -> IORef (Maybe InputConnection)
+                          -> GLDrawContext
+                          -> IO ()
 setupDrawContext glForceSetup glDrawContextRef glInput new = do
   old <- readIORef glDrawContextRef
   writeIORef glDrawContextRef new
@@ -878,6 +888,7 @@ data CGState
   , samplerMapping        :: IntMap GLSampler
   }
 
+initCGState :: CGState
 initCGState = CGState
   { drawCommands          = mempty
   -- draw context data
@@ -895,6 +906,8 @@ type CG a = State CGState a
 emit :: GLCommand -> CG ()
 emit cmd = modify $ \s -> s {drawCommands = cmd : drawCommands s}
 
+drawContext :: MonadState CGState m =>
+                     Vector GLProgram -> m GLDrawContext
 drawContext programs = do
   GLProgram{..} <- (programs !) <$> gets currentProgram
   let f = take (Map.size inputTextures) . IntMap.toList
diff --git a/src/LambdaCube/GL/Input.hs b/src/LambdaCube/GL/Input.hs
index 30125d9..5d2a49e 100644
--- a/src/LambdaCube/GL/Input.hs
+++ b/src/LambdaCube/GL/Input.hs
@@ -397,6 +397,7 @@ type UniM = Writer [Map GLUniformName InputSetter -> IO ()]
 class UniformSetter a where
   (@=) :: GLUniformName -> IO a -> UniM ()
 
+setUniM :: (n -> Map GLUniformName InputSetter -> a -> IO ()) -> n -> IO a -> UniM ()
 setUniM setUni n act = tell [\s -> let f = setUni n s in f =<< act]
 
 instance UniformSetter Bool   where (@=) = setUniM uniformBool
@@ -426,10 +427,12 @@ instance UniformSetter M43F   where (@=) = setUniM uniformM43F
 instance UniformSetter M44F   where (@=) = setUniM uniformM44F
 instance UniformSetter TextureData where (@=) = setUniM uniformFTexture2D
 
+updateUniforms :: GLStorage -> UniM a -> IO ()
 updateUniforms storage m = sequence_ l where
   setters = uniformSetter storage
   l = map ($ setters) $ execWriter m
 
+updateObjectUniforms :: Object -> UniM a -> IO ()
 updateObjectUniforms object m = sequence_ l where
   setters = objectUniformSetter object
   l = map ($ setters) $ execWriter m
diff --git a/src/LambdaCube/GL/Mesh.hs b/src/LambdaCube/GL/Mesh.hs
index 95ca582..384cdd1 100644
--- a/src/LambdaCube/GL/Mesh.hs
+++ b/src/LambdaCube/GL/Mesh.hs
@@ -46,13 +46,18 @@ data GPUMesh
   , gpuData   :: GPUData
   }
 
-addMeshToObjectArray :: GLStorage -> String -> [String] -> GPUMesh -> IO Object
+addMeshToObjectArray :: GLStorage
+                        -> String   -- ^ Slot name for a PrimitiveStream.
+                        -> [String] -- ^ Uniform names.  IORefs will be put in 'objUniSetup'.
+                        -> GPUMesh
+                        -> IO Object
 addMeshToObjectArray input slotName objUniNames (GPUMesh _ (GPUData prim streams indices _)) = do
     -- select proper attributes
     let (ObjectArraySchema slotPrim slotStreams) = fromMaybe (error $ "addMeshToObjectArray - missing object array: " ++ slotName) $ Map.lookup slotName $! objectArrays $! schema input
         filterStream n _ = Map.member n slotStreams
     addObject input slotName prim indices (Map.filterWithKey filterStream streams) objUniNames
 
+withV :: (v a -> (Ptr a -> io) -> io) -> v a -> (Ptr () -> io) -> io
 withV w a f = w a (\p -> f $ castPtr p)
 
 meshAttrToArray :: MeshAttribute -> Array
@@ -77,11 +82,17 @@ meshAttrToStream b i (A_M44F  v) = Stream Attribute_M44F b i 0 (V.length v)
 meshAttrToStream b i (A_Int   v) = Stream Attribute_Int b i 0 (V.length v)
 meshAttrToStream b i (A_Word  v) = Stream Attribute_Word b i 0 (V.length v)
 
-updateMesh :: GPUMesh -> [(String,MeshAttribute)] -> Maybe MeshPrimitive -> IO ()
+-- | Update a mesh without allocating new buffer objects.  Each update must
+-- provide new values for all existing array elements.
+updateMesh :: GPUMesh                     -- ^ Mesh to be updated.
+              -> [(String,MeshAttribute)] -- ^ A list of updates.
+              -> Maybe MeshPrimitive      -- ^ Ignored.
+              -> IO ()
 updateMesh (GPUMesh (Mesh dMA dMP) (GPUData _ dS dI _)) al mp = do
   -- check type match
   let arrayChk (Array t1 s1 _) (Array t2 s2 _) = t1 == t2 && s1 == s2
-      ok = and [Map.member n dMA && arrayChk (meshAttrToArray a1) (meshAttrToArray a2) | (n,a1) <- al, let a2 = fromMaybe (error $ "missing mesh attribute: " ++ n) $ Map.lookup n dMA]
+      ok = and [ Map.member n dMA && arrayChk (meshAttrToArray a1) (meshAttrToArray a2)
+                 | (n,a1) <- al, let a2 = fromMaybe (error $ "missing mesh attribute: " ++ n) $ Map.lookup n dMA]
   if not ok then putStrLn "updateMesh: attribute mismatch!"
     else do
       forM_ al $ \(n,a) -> do
@@ -98,6 +109,8 @@ updateMesh (GPUMesh (Mesh dMA dMP) (GPUData _ dS dI _)) al mp = do
                 (a,b) -> a == b
 -}
 
+-- | This allocates buffer objects.  Use 'disposeMesh' to free them.  Use
+-- 'updateMesh' to modify the allocated buffer object data.
 uploadMeshToGPU :: Mesh -> IO GPUMesh
 uploadMeshToGPU mesh@(Mesh attrs mPrim) = do
     let mkIndexBuf v = do
diff --git a/src/LambdaCube/GL/Util.hs b/src/LambdaCube/GL/Util.hs
index b267c7f..fbc0f50 100644
--- a/src/LambdaCube/GL/Util.hs
+++ b/src/LambdaCube/GL/Util.hs
@@ -260,7 +260,6 @@ fromGLType (t,1)
     | t == GL_UNSIGNED_INT_SAMPLER_BUFFER               = UTextureBuffer
     | t == GL_UNSIGNED_INT_SAMPLER_CUBE                 = UTextureCube
     | otherwise = error "Failed fromGLType"
-fromGLUniformType _ = error "Failed fromGLType"
 
 printShaderLog :: GLuint -> IO String
 printShaderLog o = do