9

我正在为一个相当复杂的视频游戏做一些概念验证工作，我想使用 HOpenGL 库在 Haskell 中编写。我首先编写了一个实现基于客户端-服务器事件的通信的模块。当我尝试将它连接到一个简单的程序以在屏幕上绘制点击时，我的问题出现了。

事件库使用一个 TChans 列表组成一个优先级队列进行通信。它返回对应于服务器绑定和客户端绑定消息的“出”队列和“入”队列。使用 forkIO 在不同的线程中发送和接收事件。在没有 OpenGL 部分的情况下测试事件库表明它通信成功。这是我用来测试它的代码： 

-- Client connects to server at localhost with 3 priorities in the priority queue
do { (outQueue, inQueue) <- client Nothing 3
   -- send 'Click' events until terminated, the server responds with the coords negated
   ; mapM_ (\x -> atomically $ writeThing outQueue (lookupPriority x) x)
           (repeat (Click (fromIntegral 2) (fromIntegral 4)))
   }

这会产生预期的输出，即大量的发送和接收事件。我认为问题不在于事件处理库。

代码的 OpenGL 部分在 displayCallback 中检查传入队列中的新事件，然后调用事件的关联处理程序。我可以让 displayCallback 捕获一个事件（Init 事件，它只是清除屏幕），但之后什么都没有捕获。以下是相关代码：

atomically $ PQ.writeThing inqueue (Events.lookupPriority Events.Init) Events.Init
    GLUT.mainLoop

render pqueue =
    do  event <- atomically $
            do  e <- PQ.getThing pqueue
                case e of
                    Nothing -> retry
                    Just event -> return event
        putStrLn $ "Got event"
        (Events.lookupHandler event Events.Client) event
        GL.flush
        GLUT.swapBuffers

所以我关于为什么会发生这种情况的理论是：

  • 显示回调在重试时阻塞了所有发送和接收线程。
  • 队列未正确返回，因此客户端读取的队列与 OpenGL 部分读取的队列不同。

还有其他原因导致这种情况发生吗？

完整的代码太长了，虽然不是太长（每个 100 行以下 5 个文件），但这里发布的代码太长了，但它都在 GitHub上。

编辑 1：
客户端从 HOpenGL 代码的主函数中运行，如下所示：

main =
    do  args <- getArgs
        let ip = args !! 0
        let priorities = args !! 1
        (progname, _) <- GLUT.getArgsAndInitialize
        -- Run the client here and bind the queues to use for communication
        (outqueue, inqueue) <- Client.client (Just ip) priorities
        GLUT.createWindow "Hello World"
        GLUT.initialDisplayMode $= [GLUT.DoubleBuffered, GLUT.RGBAMode]
        GLUT.keyboardMouseCallback $= Just (keyboardMouse outqueue)
        GLUT.displayCallback $= render inqueue
        PQ.writeThing inqueue (Events.lookupPriority Events.Init) Events.Init
        GLUT.mainLoop

我在编译代码时传递给 GHC 的唯一标志是-package GLUT.

编辑 2：
我清理了 Github 上的代码。我删除了acceptInput，因为它实际上并没有做任何事情，而且客户端代码不应该监听它自己的事件，这就是它返回队列的原因。

编辑3：
我稍微澄清一下我的问题。我从@Shang 和@Laar 那里学到了一些东西，然后就跟着跑了。我将 Client.hs 中的线程更改为使用 forkOS 而不是 forkIO （并在 ghc 中使用 -threading），看起来事件正在成功通信，但是在显示回调中没有收到它们。我也尝试postRedisplay在显示回调结束时调用，但我认为它不会被调用（因为我认为重试阻塞了整个 OpenGL 线程）。

显示回调中的重试会阻塞整个 OpenGL 线程吗？如果是这样，将显示回调分叉到新线程中是否安全？我不认为它会，因为可能存在多个事物可能同时尝试绘制到屏幕上的可能性，但我可能能够用锁来处理它。另一种解决方案是将lookupHandler函数转换为返回包装在 a 中的函数Maybe，如果没有任何事件，则什么也不做。我觉得这不太理想，因为我基本上会有一个繁忙的循环，这是我试图避免的事情。

编辑 4：
忘了提到我在做 forkOS 时在 ghc 使用了 -threading。

编辑5：
我去测试了我的理论，即渲染函数（显示回调）中的重试阻塞了所有的OpenGL。我重写了渲染函数，使它不再阻塞，它就像我想要的那样工作。屏幕上的一次点击给出两点，一个来自服务器，一个来自原始点击。这是新渲染函数的代码（注意：它不在Github 中）：

render pqueue =
    do  event <- atomically $ PQ.getThing pqueue
        case (Events.lookupHandler event Events.Client) of
            Nothing -> return ()
            Just handler -> 
                do  let e = case event of {Just e' -> e'}
                    handler e
                    return ()
        GL.flush
        GLUT.swapBuffers
        GLUT.postRedisplay Nothing

我在有和没有 postRedisplay 的情况下都试过了，它只适用于它。现在的问题是，这将 CPU 固定在 100%，因为它是一个繁忙的循环。在编辑 4 中，我建议线程化显示回调。我还在想办法做到这一点。

一个注释，因为我还没有提到它。任何想要构建/运行代码的人都应该这样做：

$ ghc -threaded -package GLUT helloworldOGL.hs -o helloworldOGL
$ ghc server.hs -o server
-- one or the other, I usually do 0.0.0.0
$ ./server "localhost" 3
$ ./server "0.0.0.0" 3
$ ./helloworldOGL "localhost" 3

编辑 6：解决方案
解决方案！与线程一起，我决定在 OpenGL 代码中创建一个线程来检查事件，如果没有则阻塞，然后调用处理程序，然后调用 postRedisplay。这里是：

checkEvents pqueue = forever $
    do  event <- atomically $
            do  e <- PQ.getThing pqueue
                case e of
                    Nothing -> retry
                    Just event -> return event
        putStrLn $ "Got event"
        (Events.lookupHandler event Events.Client) event
        GLUT.postRedisplay Nothing

显示回调很简单：

render = GLUT.swapBuffers

而且它有效，它不会将 CPU 固定为 100%，并且事件会得到及时处理。我在这里发布这个是因为没有其他答案我无法做到这一点，而且当答案都非常有帮助时，我很难接受代表，所以我接受@Laar 的回答，因为他的代表较低。

4

2 回答 2

4

一种可能的原因可能是使用了线程。

OpenGL 为其上下文使用线程本地存储。因此，所有使用 OpenGL 的调用都应该从同一个 OS 线程进行。HOpenGL（和 OpenGLRaw 也是）是围绕 OpenGL 库的一个相对简单的绑定，并且没有为这个“问题”提供任何保护或解决方法。

另一方面，您是否正在使用forkIO创建轻量级的 haskell 线程。不保证该线程保持在同一个操作系统线程上。因此，RTS 可能会将其切换到另一个线程本地 OpenGL 上下文不可用的操作系统线程。为了解决这个问题，有一个forkOS函数，它创建了一个绑定的 haskell 线程。这个绑定的 haskell 线程将始终在同一个 OS 线程上运行，因此它的线程本地状态可用。有关此的文档可以在Control.Concurrent的“绑定线程”部分找到，forkOS也可以在那里找到。

编辑：

使用当前的测试代码，这个问题不存在，因为您没有使用 -thread。（删除了不正确的推理）

于 2012-07-12T10:26:49.140 回答
4

你的render函数最终只被调用一次，因为显示回调只在有新东西要绘制的地方被调用。要请求重绘，您需要调用

GLUT.postRedisplay Nothing

它需要一个可选的 window 参数，或者在您传递Nothing. 您通常postRedisplay从 aidleCallback或 a调用，timerCallback但您也可以在结束时调用它render以请求立即重绘。

于 2012-07-12T12:08:46.440 回答