Render to image instead of screen

[vladfi1]

I'd like to be able to directly generate images (and then save them to files) instead of displaying anything to the screen. Is this easily doable?

[ghorn]

The type you want seems to be render :: VisObject Double -> Image where Image is a bitmap or something. That is difficult for me.

I have something which you could use instead: http://hackage.haskell.org/package/not-gloss-0.7.6.2/docs/Vis.html#v:visMovie

You give a list [VisObject Double] and it renders it in a loop while you move the camera to where you want it. Then you press spacebar and it writes images to disk, one for each VisObject Double. It also prints a shell command which will turn it into a .mp4 for you. Is that good enough?

[vladfi1]

Do you think it would be possible to excise the relevant code from visMovie to get render :: VisObject Double -> (IO) Image? I need to programmatically generate a large number of images, so manually hitting spacebar while watching a movie isn't really an option.

[vladfi1]

I've wrangled with the code a bit and gotten something that looks like it might work.

module Main where

import qualified Graphics.UI.GLUT as GLUT
import Graphics.UI.GLUT ( Capability(..), ClearBuffer(..), Color4(..), ColorMaterialParameter(..)
                        , ComparisonFunction(..), Cursor(..), DisplayMode(..), Face(..)
                        , Key(..), KeyState(..), Light(..), Modifiers(..), Position(..)
                        , ShadingModel(..), Size(..)
                        , DisplayCallback, ReshapeCallback
                        , ($=)
                        )
import Text.Printf ( printf )
import Codec.BMP
import qualified Data.ByteString.Unsafe as BS
import Data.Word ( Word8 )
import Foreign.Marshal.Alloc ( free )
import Foreign.Marshal.Array ( mallocArray )
import Foreign.Ptr ( Ptr, castPtr )
import Foreign.Storable ( sizeOf )
import Control.Concurrent

import Vis
import Vis.VisObject
import Vis.Camera

import qualified Data.ByteString as B

makePictures :: Real b => Camera -> VisObject b -> IO ()
makePictures cam visobj = do
  GLUT.clear [ GLUT.ColorBuffer, GLUT.DepthBuffer ]

  -- draw the scene
  GLUT.preservingMatrix $ do
    setCamera cam
    drawObjects $ (fmap realToFrac) visobj

  GLUT.flush
  --GLUT.swapBuffers
  --_ <- swapMVar visReadyMVar True
  --GLUT.postRedisplay Nothing

  putStrLn "end makePictures"

screenShot :: Real b => Camera -> VisObject b -> IO BMP
screenShot camera visobj = do
  -- todo: are width/height reversed?
  size@(Size width height) <- GLUT.get GLUT.windowSize
  let pos = Position 0 0
  ubytePtr <- mallocArray (fromIntegral (4*width*height)) :: IO (Ptr GLUT.GLubyte)
  let pixelData = GLUT.PixelData GLUT.RGBA GLUT.UnsignedByte ubytePtr
  makePictures camera visobj
  -- "glFinish" will do the job, but it may be overkill.
  -- "swapBuffers" is probably good enough.
  -- http://stackoverflow.com/questions/2143240/opengl-glflush-vs-glfinish
  -- We just need to make sure that readPixels will do the right thing
  GLUT.finish

  putStrLn "readPixels"

  GLUT.readPixels pos size pixelData
  let wordPtr :: Ptr Word8
      wordPtr
        | sizeOf (0 :: GLUT.GLubyte) == sizeOf (0 :: Word8) = castPtr ubytePtr
        | otherwise = error "GLubyte size /= Word8 size"

  putStrLn "pack"

  bs <- BS.unsafePackCStringFinalizer
        wordPtr (fromIntegral (4*width*height)) (free ubytePtr)

  --print $ BS.length bs

  let bmp :: BMP
      bmp = packRGBA32ToBMP32 (fromIntegral width) (fromIntegral height) bs

  putStrLn "bmp"

  return bmp

cam = makeCamera (Camera0 0 0 0)
cylinder = Cylinder (10, 10) red

main = do
  GLUT.getArgsAndInitialize
  bmp <- screenShot cam cylinder
  print $ B.length (bmpRawImageData bmp)
  putStrLn "write"
  writeBMP "vis.bmp" bmp

None of the GLUT calls fail, which is promising. However, the B.length call never returns ("write" never gets printed), and similarly for writeBMP. Any ideas?

[ghorn]

I think you're got the right idea. But this looks like it's going to try to open a window. I would like to allocate a pixel buffer and write the frame to that, so that no window needs to open and it is more programmatic. I will try to look at this but I won't have time for at least a few days.

[vladfi1]

Upon further inspection it looks like the ByteString created by unsafePackCStringFinalizer has length zero... because the width and height are zero! They are gotten from the window size, and of course there is no window.

Edit: Setting the width/height to nonzero allows the program to run, but the generated image is just black with some red noise at the bottom though.

[vladfi1]

Bump? I've tried a number of other approaches without success :(

[ghorn]

I'm sorry I haven't had a chance to work on this. I intend to but I have been unusually busy. This looks promising http://stackoverflow.com/questions/3191978/how-to-use-glut-opengl-to-render-to-a-file/14324292#14324292. I will try to port it to not-gloss this week.

[vladfi1]

Any progress on this?

[ghorn]

I haven't had time to do a proper solution, but I have attempted a workaround for you:

not-gloss/not-gloss/src/Vis/Vis.hs

Lines 315 to 327 in 745610e

	-- | Make a series of images, one from each 'VisObject'.
	-- When 'visMovieImmediately' is executed a window is opened and without
	-- waiting the images are created and saved to disk.
	visMovieImmediately
	:: forall b
	. Real b
	=> Options -- ^ user options
	-> (Int -> FilePath) -- ^ where to write the bitmaps
	-> Double -- ^ sample time
	-> [VisObject b] -- ^ movie to draw
	-> Maybe Cursor -- ^ optional cursor
	-> IO ()
	visMovieImmediately = visMovie' True

It still has to open a window to do any drawing, which is inconvenient, but it immediately starts drawing. I have not tested this. Can you test it and let me know if it unblocks you?

[ghorn]

I will upload it to hackage if it works for you

[vladfi1]

I get render to screen but no images appear to be generated. Here is my code:

module Main where

import Vis.Vis
import Vis

import Linear

cylinder = Trans (V3 0 0 1) $ Cylinder (0.1, 0.2) green

main :: IO ()
main = visMovieImmediately defaultOpts (const "temp.bmp") 0 [cylinder] Nothing

Edt: Pressing spacebar will cause the image to be created.