HOpenGL如何處理Haskell中的其他線程和TChans？

Question

我正在為一個相當復雜的視頻游戲做一些概念驗證工作，我想使用HOpenGL庫在Haskell中編寫。 我開始編寫一個實現基於客戶端 - 服務器事件的通信的模塊。 當我嘗試將其連接到一個簡單的程序以在屏幕上繪制點擊時，我的問題出現了。

事件庫使用TChans列表作為優先級隊列進行通信。 它返回一個“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中的新事件，然后調用事件的關聯處理程序。 我可以得到一個事件（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，因為它沒有真正做任何事情，客戶端代碼不應該正在監聽它自己的事件，這就是它返回隊列的原因。

編輯3：
我正在澄清我的問題。 我從@Shang和@Laar那里學到了我所學到的東西。 我更改了Client.hs中的線程以使用forkOS而不是forkIO（並在ghc中使用-threaded），看起來事件正在成功傳遞，但是它們沒有在顯示回調中被接收。 我也嘗試在顯示回調結束時調用postRedisplay ，但我認為它不會被調用（因為我認為重試阻止了整個OpenGL線程）。

顯示回調中的重試會阻塞整個OpenGL線程嗎？ 如果是這樣，將顯示回調分支到新線程是否安全？ 我不認為它會，因為可能存在多個東西可能同時試圖繪制到屏幕上，但我可能能夠用鎖來處理它。 另一種解決方案是將lookupHandler函數轉換為返回包含在Maybe的函數，如果沒有任何事件則不執行任何操作。 我覺得這不太理想，因為我基本上有一個忙碌的循環，這是我試圖避免的。

編輯4：
忘了提到我在使用forkOS時在ghc上使用了-threaded。

編輯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％，因為它是一個繁忙的循環。 在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的回答，因為他有較低的Rep。

Answer 1

一個可能的原因可能是使用線程。

OpenGL為其上下文使用線程本地存儲。 因此，使用OpenGL的所有調用都應該來自相同的OS線程。 HOpenGL（以及OpenGLRaw）是一個圍繞OpenGL庫的相對簡單的綁定，並沒有為這個“問題”提供任何保護或解決方法。

另一方面，您是否使用forkIO來創建輕量級的haskell線程。 不保證此線程保持在同一OS線程上。 因此，RTS可能會將其切換到另一個OS線程，其中線程本地OpenGL上下文不可用。 要解決此問題，可以使用forkOS函數創建綁定的haskell線程。 這個綁定的haskell線程將始終在相同的OS線程上運行，從而使其線程本地狀態可用。 關於這個的文檔可以在Control.Concurrent的'Bound Threads'部分找到， forkOS也可以在那里找到。

編輯：

使用當前的測試代碼，這個問題不存在，因為你沒有使用-threaded。 （刪除了錯誤的推理）

Answer 2

您的render函數最終只被調用一次，因為僅在有新內容繪制的地方調用顯示回調。 要請求重繪，您需要致電

GLUT.postRedisplay Nothing

它需要一個可選的窗口參數，或者在傳遞Nothing時發出“當前”窗口的重繪信號。 您通常從idleCallback或timerCallback調用postRedisplay ，但您也可以在render結束時調用它以請求立即重繪。