module Graphics.Rendering.OpenGL.Capture (capturePPM) where
import Control.Monad (forM_)
import Foreign (allocaBytes, plusPtr)
import qualified Data.ByteString.Internal as BSI
import qualified Data.ByteString as BS
import Data.ByteString (ByteString)
import Graphics.Rendering.OpenGL
capturePPM :: IO ByteString
capturePPM = do
(p0, s0@(Size vw vh)) <- get viewport
let p6 = "P6\n" ++ show vw ++ " " ++ show vh ++ "\n255\n"
allocaBytes (fromIntegral (vw*vh*3)) $ \ptr -> do
preservingBufferBinding PixelPackBuffer $ do
bindBuffer PixelPackBuffer $= Nothing
preservingClientAttrib [PixelStoreAttributes] $ do
rowAlignment Pack $= 1
readPixels p0 s0 $ PixelData RGB UnsignedByte ptr
px <- BSI.create (fromIntegral $ vw * vh * 3) $ \d ->
forM_ [0..vh1] $ \y ->
BSI.memcpy
(d `plusPtr` fromIntegral (y*vw*3))
(ptr `plusPtr` fromIntegral ((vh1y)*vw*3))
(fromIntegral (vw*3))
return $ BS.pack (map (toEnum . fromEnum) p6) `BS.append` px
preservingBufferBinding :: BufferTarget -> IO a -> IO a
preservingBufferBinding target action = do
buffer <- get $ bindBuffer target
result <- action
bindBuffer target $= buffer
return result