如何在Haskell中高效地旋转OpenGL场景？

Question

如何在Haskell中高效地旋转OpenGL场景？

4

使用Haskell渲染一个OpenGL场景，我使用以下结构：

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

Triangles 对象包含要显示的 3D 对象的顶点和法线，排列在三元组列表中形成三角形。

我在 main 函数中使用 reshapeCallback（）并与 Just (resize 0) 一起使用：

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 函数的代码：

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的OpenGL时，我可以用鼠标平稳地旋转场景，这根本不会消耗资源。因此，我想知道我在Haskell中使用的方法是否可以改进。我不知道rgl如何执行旋转。

编辑

注1：在此示例中，三角形并不需要使用IORef。

注2：即使我没有按任何按键，只是观看场景，笔记本电脑也会发热；在我看来，main函数在不断执行，即使什么也没有改变-难道没有一种方法可以控制它的重新执行吗？

- Stéphane Laurent

起初我没有找到应用程序的链接。我想这是这个。 - chi

2

我想知道：使用“o”键增加延迟（多次）是否有帮助？看起来延迟从0毫秒开始，可能会强制重新绘制场景太快？每次按下“o”键应增加10毫秒。（这只是一个猜测） - chi

不，这个延迟只是为了控制某个动画的速度，与重复显示无关。 - Stéphane Laurent

mainloop 定义在哪里？我在代码库中找不到它。 - lsmor

1

@lsmor mainloop 是来自于 OpenGL 库或者 GLUT，我不确定。 - Stéphane Laurent

顺便提一下，你不应该使用threadDelay来改变动画速度。相反，你可以测量时间两个帧之间的差异，并根据经过的时间调整速度。 - Noughtmare

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Noughtmare · Accepted Answer

你的应用程序主要瓶颈在于绘制所有三角形的过程。

你可以通过将三角形按顺序存储到一个扁平数组中，并使用更低级别的基元来绘制法线和顶点，以提高性能：

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))

然而，如果您的显示器刷新率非常高，则可能不足够。或者如果禁用了垂直同步，则这可能根本没有帮助。那么唯一的结果就是绘制更多的帧。

不幸的是，我认为没有简单的方法可以在GLUT中启用垂直同步。您可以切换到GLFW-b，它允许您使用swapInterval 1启用垂直同步。我在这里制作了一个快速原型：https://gist.github.com/noughtmare/5c5b0b609f33b009055d58ee2418c339。将我的监视器设置为60fps，只需要约33％的一个CPU核心。我注意到GLFW没有空闲回调，因此我将其合并到主循环中。但延迟功能实际上并不适合那里，所以我将其留了下来。

如果你真的想要挤出最大的性能，那么你应该切换到使用顶点缓冲区，如https://learnopengl.com/Getting-started/Hello-Triangle所述。这样可以将形状加载到数组中，并一次性发送到GPU。然后你就不需要在每一帧遍历所有三角形了。