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

问题描述 投票：0回答：1

要用 Haskell 渲染一个 OpenGL 场景，我使用这样的结构：

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


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

我使用

reshapeCallback
（在
main
函数中）
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
功能也会持续执行 - 没有办法控制它的重新执行吗？

haskell opengl 3d
1个回答
0
投票

应用程序的主要瓶颈是绘制所有三角形。

您可以通过将三角形按顺序存储在平面数组中并使用更多较低级别的基元来绘制法线和顶点来提高性能：

import Foreign.Ptr
import Foreign.Marshal.Array

type F = Double
type Triangles = (Int, Ptr F)

[..]

fromVoxel :: Voxel F -> F -> (XYZ F -> XYZ F) -> IO Triangles
fromVoxel vox isolevel gradient = do 
  mesh <- makeMesh vox isolevel
  let vertices = _vertices mesh
      faces    = _faces mesh
      normals  = makeNormals vertices gradient
      triangle face =
        ( (normals ! i, vertices ! i)
        , (normals ! j, vertices ! j)
        , (normals ! k, vertices ! k)
        )
        where
          (i, j, k) = face
      flatten = concatMap $ \(((x1,x2,x3),(x4,x5,x6)),((x7,x8,x9),(x10,x11,x12)),((x13,x14,x15),(x16,x17,x18))) -> 
        [x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18]
  withArrayLen (flatten (map triangle faces)) (\n p -> pure (n, p))

[..]

display :: Context -> DisplayCallback
display context = do
  clear [ColorBuffer, DepthBuffer]
  r1 <- get (contextRot1 context)
  r2 <- get (contextRot2 context)
  r3 <- get (contextRot3 context)
  (n, 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
  unsafeRenderPrimitive Triangles $ forM_ [0..n `quot` 18] $ \i -> drawTriangle triangles (i * 18 * 8)
  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://learnopengl.com/Getting-started/Hello-Triangle 中所述。这允许您将形状加载到数组中并将其发送到 GPU 一次。然后你不需要在每一帧上遍历所有的三角形。

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.