How to efficiently rotate an OpenGL scene in Haskell?

Question

To render an OpenGL scene with Haskell, I use such a structure:

data Context = Context
    {
      contextRot1      :: IORef GLfloat
    , contextRot2      :: IORef GLfloat
    , contextRot3      :: IORef GLfloat
    , contextZoom      :: IORef Double
    , contextTriangles :: IORef Triangles
    }

The Triangles object contains the vertices and the normals of the 3D object to be displayed, arranged in a list of triplets forming triangles.

I use the reshapeCallback (in the main function) Just (resize 0) with:

resize :: Double -> Size -> IO ()
resize zoom s@(Size w h) = do
  viewport $= (Position 0 0, s)
  matrixMode $= Projection
  loadIdentity
  perspective 45.0 (w'/h') 1.0 100.0
  lookAt (Vertex3 0 (-9 + zoom) 0) (Vertex3 0 0 0) (Vector3 0 0 1)
  matrixMode $= Modelview 0
  where
    w' = realToFrac w
    h' = realToFrac h

Then I use this displayCallback:

display :: Context -> DisplayCallback
display context = do
  clear [ColorBuffer, DepthBuffer]
  r1 <- get (contextRot1 context)
  r2 <- get (contextRot2 context)
  r3 <- get (contextRot3 context)
  triangles <- get (contextTriangles context)
  zoom <- get (contextZoom context)
  (_, size) <- get viewport
  loadIdentity
  resize zoom size
  rotate r1 $ Vector3 1 0 0
  rotate r2 $ Vector3 0 1 0
  rotate r3 $ Vector3 0 0 1
  renderPrimitive Triangles $ mapM_ drawTriangle triangles
  swapBuffers
  where
  drawTriangle ((v1, v2, v3), (n1, n2, n3)) = do
    materialDiffuse Front $= whitesmoke
    normal (toNormal n1)
    vertex (toVertex v1)
    normal (toNormal n2)
    vertex (toVertex v2)
    normal (toNormal n3)
    vertex (toVertex v3)
    where
      toNormal (x, y, z) = Normal3 x y z
      toVertex (x, y, z) = Vertex3 x y z

And this is the main function:

main :: IO ()
main = do
  _ <- getArgsAndInitialize
  _ <- createWindow "Kohn-Nirenberg surface"
  windowSize $= Size 512 512
  initialDisplayMode $= [RGBAMode, DoubleBuffered, WithDepthBuffer]
  clearColor $= discord
  materialAmbient Front $= white
  lighting $= Enabled
  lightModelTwoSide $= Enabled
  light (Light 0) $= Enabled
  position (Light 0) $= Vertex4 0 (-100) 0 1
  ambient (Light 0) $= black
  diffuse (Light 0) $= white
  specular (Light 0) $= white
  depthFunc $= Just Less
  shadeModel $= Smooth
  cullFace $= Just Back
  rot1 <- newIORef 0.0
  rot2 <- newIORef 0.0
  rot3 <- newIORef 0.0
  zoom <- newIORef 0.0
  triangles <- newIORef =<< trianglesIO 
  displayCallback $= display Context {contextRot1 = rot1,
                                      contextRot2 = rot2,
                                      contextRot3 = rot3,
                                      contextZoom = zoom,
                                      contextTriangles = triangles}
  reshapeCallback $= Just (resize 0)
  anim      <- newIORef False
  delay     <- newIORef 0
  save      <- newIORef False
  snapshots <- newIORef 0
  keyboardCallback $= Just (keyboard rot1 rot2 rot3 zoom anim delay save)
  idleCallback $= Just (idle anim delay save snapshots rot3)
  putStrLn "*** Kohn-Nirenberg surface ***\n\
        \    To quit, press q.\n\
        \    Scene rotation:\n\
        \        e, r, t, y, u, i\n\
        \    Zoom: l, m\n\
        \    Animation: a\n\
        \    Animation speed: o, p\n\
        \    Save animation: s\n\
        \"
  mainLoop

I'm not showing all the code because it is too long and some parts are not relevant to the present question (e.g. saving an animation). You can find the full code here if needed.

Now, thanks to the keyboardCallback (not shown here), I can rotate the scene. I think this rotates the 3D object, not the camera. Is it right?

It happens that rotating consumes a lot of resources (I can hear the laptop blowing hard when continuously pressing a rotate key).

However when I use OpenGL with the R package rgl, I can smoothly rotate the scene with the mouse, this is not resource-consuming at all. So I'm wondering whether the way I use in Haskell, shown here, could be improved. I don't know how rgl does to perform the rotations.

---

EDIT

Note 1: it is not necessary to use an IORef for the triangles in this example.

Note 2: the laptop blows even if I don't press any key, just when watching the scene; it seems to me that the main function is continuously executed, even when nothing changes - isn't there a way to control its re-execution?

Answer 1

The main bottleneck in your application is the drawing of all your triangles.

You can improve the performance by storing the triangles in sequential order in a flat array and use more lower level primitives to draw the normals and vertices:

import qualified Data.Vector.Storable as VS

type F = Double
type Triangles = VS.Vector F

[..]

fromVoxel :: Voxel F -> F -> (XYZ F -> XYZ F) -> IO Triangles
fromVoxel vox isolevel grad = do 
  mesh <- makeMesh vox isolevel
  let vertices = _vertices mesh
      faces    = _faces mesh
      flat (x,y,z) = [x,y,z]
      f i = flat (normaliz (grad (vertices ! i))) ++ flat (vertices ! i)
  pure (VS.fromList (concat [f i ++ f j ++ f k | (i,j,k) <- faces]))

[..]

display :: Context -> DisplayCallback
display context = do
  clear [ColorBuffer, DepthBuffer]
  r1 <- get (contextRot1 context)
  r2 <- get (contextRot2 context)
  r3 <- get (contextRot3 context)
  triangles <- get (contextTriangles context)
  zoom <- get (contextZoom context)
  (_, size) <- get viewport
  loadIdentity
  resize zoom size
  rotate r1 $ Vector3 1 0 0
  rotate r2 $ Vector3 0 1 0
  rotate r3 $ Vector3 0 0 1
  materialDiffuse Front $= whitesmoke
  VS.unsafeWith triangles $ \ptr ->
    unsafeRenderPrimitive Triangles $
      forM_ [0 .. (VS.length triangles `quot` 18) - 1] $ \i -> drawTriangle ptr (18 * 8 * i)
  swapBuffers
  where
  drawTriangle p i = do
    normalv (plusPtr p (i + 0 * 8) :: Ptr (Normal3 F))
    vertexv (plusPtr p (i + 3 * 8) :: Ptr (Vertex3 F))
    normalv (plusPtr p (i + 6 * 8) :: Ptr (Normal3 F))
    vertexv (plusPtr p (i + 9 * 8) :: Ptr (Vertex3 F))
    normalv (plusPtr p (i + 12 * 8) :: Ptr (Normal3 F))
    vertexv (plusPtr p (i + 15 * 8) :: Ptr (Vertex3 F))

However this may not do enough if your display has a very high refresh rate. Or this may not help at all if vsync is disabled. Then the only result will be that this draws more frames.

Unfortunately, I believe there is no easy way to enable vsync with GLUT. You can switch to GLFW-b which does allow you to enable vsync with swapInterval 1. I've made a quick prototype of that here: https://gist.github.com/noughtmare/5c5b0b609f33b009055d58ee2418c339. With my monitor set to 60fps it takes only about 33% of one CPU core. One thing I noticed is that GLFW doesn't have an idle callback, so I've just merged it into the main loop. But the delay functionality doesn't really fit there, so I've left that out.

If you really want to squeeze the maximum performance out then you should switch to using vertex buffers as described on https://learnopengl.com/Getting-started/Hello-Triangle. This allows you to load your shape into an array and send it to your GPU once. Then you don't need to traverse all your triangles on every frame.