Haskell中如何高效实现OpenGL场景旋转？

我在Haskell中渲染OpenGL场景时使用如下数据结构存储上下文：

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

Triangles对象包含待显示3D物体的顶点和法线，以三角形三元组列表形式存储。

窗口Resize实现 #

main函数中设置reshapeCallback为Just (resize 0)，resize函数实现如下：

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

渲染回调实现 #

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

主函数实现 #

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

核心问题与疑问 #

• 旋转逻辑判断：通过keyboardCallback实现的场景旋转，是否确实是旋转3D物体而非相机？
• 资源消耗优化：当前旋转操作（尤其是持续按键时）资源占用过高，风扇高速运转，如何优化实现，达到类似R语言rgl包旋转时的流畅低耗效果？
• IORef必要性：示例中的triangles是否不需要用IORef存储？
• 重绘时机控制：即使无操作时电脑也发烫，推测mainLoop一直在重复执行重绘，有没有办法控制仅在必要时（如参数变化、窗口大小改变）才触发重绘？

内容的提问来源于stack exchange，提问作者Stéphane Laurent