add withFrameBuffer to support screen capture

lambdacube3d · Jul 23, 2012 · 87117fa · 87117fa
1 parent b915026
commit 87117fa
Show file tree

Hide file tree

Showing 3 changed files with 13 additions and 2 deletions.
diff --git a/lambdacube-core/LC_B_GLData.hs b/lambdacube-core/LC_B_GLData.hs
@@ -25,7 +25,6 @@ import Graphics.Rendering.OpenGL.Raw.Core32
     , gl_LINES
     , gl_LINE_STRIP
     , gl_POINTS
-    , gl_STATIC_DRAW
     , gl_TRIANGLES
     , gl_TRIANGLE_FAN
     , gl_TRIANGLE_STRIP
@@ -40,6 +39,7 @@ import Graphics.Rendering.OpenGL.Raw.Core32
     , glGenVertexArrays
     , gl_ARRAY_BUFFER
     , gl_ELEMENT_ARRAY_BUFFER
+    , gl_STATIC_DRAW
 
     -- * TEXTURE related *
     -- texture data

diff --git a/q3demo/Main.hs b/q3demo/Main.hs
@@ -48,6 +48,9 @@ import Zip
 import Items
 import qualified MD3 as MD3
 
+import Codec.Image.DevIL
+import Foreign
+
 -- Utility code
 tableTexture :: [Float] -> ByteString -> Trie InputSetter -> IO ()
 tableTexture t n s = do
@@ -89,8 +92,15 @@ quad = Mesh
     a = -1
     b = 1
 
+-- framebuffer capture function
+withFrameBuffer :: Int -> Int -> Int -> Int -> (Ptr Word8 -> IO ()) -> IO ()
+withFrameBuffer x y w h fn = allocaBytes (w*h*4) $ \p -> do
+    glReadPixels (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) gl_RGBA gl_UNSIGNED_BYTE $ castPtr p
+    fn p
+
 main :: IO ()
 main = do
+    ilInit
     ar <- loadArchive
 
     let imageShader txName = defaultCommonAttrs {caStages = sa:saLM:[]}

diff --git a/q3demo/q3demo.cabal b/q3demo/q3demo.cabal
@@ -51,4 +51,5 @@ Executable q3demo
                   stb-image,
                   type-level-numbers,
                   vect,
-                  zlib
+                  zlib,
+                  Codec-Image-DevIL