我正在为一个相当复杂的视频游戏做一些概念验证工作，我想使用 HOpenGL 库在 Haskell 中编写。我首先编写一个模块来实现基于客户端-服务器事件的通信。当我尝试将其连接到一个简单的程序以在屏幕上绘制点击时，我的问题出现了。
事件库使用 TChan 列表作为优先级队列进行通信。它返回与服务器绑定和客户端绑定消息相对应的“输出”队列和“输入”队列。发送和接收事件是使用 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 部分读取的队列不同。
还有其他原因导致这种情况发生吗？
完整的代码虽然不是太长，但太长了，无法在这里发布（5 个文件，每个文件不到 100 行），但都在 GitHub 上here https://github.com/RocketPuppy/PupEvents.
Edit 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.
Edit 2:
我稍微清理了一下 Github 上的代码。我删除了acceptInput，因为它实际上没有做任何事情，并且客户端代码无论如何也不应该监听它自己的事件，这就是它返回队列的原因。
Edit 3:
我稍微澄清一下我的问题。我从@Shang 和@Laar 那里学到了一些东西，并开始运用它。我将 Client.hs 中的线程更改为使用 forkOS 而不是 forkIO （并在 ghc 中使用 -threaded），看起来事件已成功通信，但在显示回调中未接收到它们。我也尝试过打电话postRedisplay在显示回调结束时，但我认为它不会被调用（因为我认为重试会阻塞整个 OpenGL 线程）。
显示回调中的重试会阻塞整个OpenGL线程吗？如果是这样，将显示回调分叉到新线程中是否安全？我不认为会发生这种情况，因为存在多个事物可能同时尝试绘制到屏幕上的可能性，但我也许可以用锁来处理它。另一种解决方案是将lookupHandler函数返回一个包装在 a 中的函数Maybe，如果没有任何事件，则什么都不做。我觉得这不太理想，因为我基本上会遇到一个繁忙的循环，这是我试图避免的。
Edit 4:
忘了说了，当我做 forkOS 时，我在 ghc 上使用了 -threaded。
Edit 5:
我去测试了我的理论：渲染函数（显示回调）中的重试会阻塞所有 OpenGL。我重写了渲染函数，使其不再阻塞，并且它的工作方式就像我希望的那样。在屏幕上单击一下即可获得两个点，一个来自服务器，一个来自原始单击。这是新渲染函数的代码（注意：它是not在 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
Edit 6: Solution
