HOpenGLライブラリを使用してHaskellで作成したい、かなり複雑なビデオゲームの概念実証作業を行っています。クライアント/サーバーイベントベースの通信を実装するモジュールを作成することから始めました。画面にクリックを描画するために単純なプログラムに接続しようとすると、問題が発生します。
イベントライブラリは、通信の優先キューにされたTChanのリストを使用します。サーバーバウンドおよびクライアントバウンドのメッセージに対応する「out」キューと「in」キューを返します。イベントの送受信は、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で新しいイベントがないか着信キューをチェックしてから、イベントに関連付けられたハンドラーを呼び出します。1つのイベント（画面をクリアするだけのInitイベント）をdisplayCallbackでキャッチできますが、その後は何もキャッチされません。関連するコードは次のとおりです。
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関数内から実行されます。
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は実際には何も実行しておらず、クライアントコードはそれ自体のイベントをリッスンすることは想定されていないため、acceptInputを削除しました。これが、キューを返す理由です。
編集3：
質問を少し明確にします。@Shangと@Laarから学んだことを取り入れて、それを実行しました。Client.hsのスレッドをforkIOの代わりにforkOSを使用するように変更しました（そしてghcで-threadedを使用しました）。イベントは正常に通信されているようですが、表示コールバックで受信されていません。また、表示コールバックの最後に呼び出しを試みpostRedisplayましたが、呼び出されることはないと思います（再試行により、OpenGLスレッド全体がブロックされていると思われるため）。
表示コールバックでの再試行は、OpenGLスレッド全体をブロックしますか？もしそうなら、ディスプレイコールバックを新しいスレッドにフォークしても安全ですか？複数のものが同時に画面に描画しようとしている可能性があるので、そうなるとは思いませんが、ロックで処理できるかもしれません。別の解決策は、関数を変換して、でlookupHandlerラップされた関数を返し、Maybeイベントがない場合は何もしないことです。回避しようとしていたビジーループが本質的に発生するため、これは理想的とは言えないように感じます。
編集4：
forkOSを実行したときにghcで-threadedを使用したことを忘れました。
編集5：
レンダリング関数（ディスプレイコールバック）での再試行がすべてのOpenGLをブロックしているという理論のテストを行いました。レンダリング関数を書き直して、ブロックされなくなったので、期待どおりに機能しました。画面を1回クリックすると、サーバーと元のクリックの2つのポイントが表示されます。新しいレンダリング関数のコードは次のとおりです（注：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％に固定することです。Edit 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の回答は担当者が低いため、受け入れています。