Я делаю некоторые экспериментальные работы для довольно сложной видеоигры, которую я хотел бы написать на Haskell, используя библиотеку HOpenGL. Я начал с написания модуля, который реализует связь между клиентом и сервером на основе событий. Моя проблема возникает, когда я пытаюсь подключить ее к простой программе для рисования кликов на экране.

Библиотека событий использует список TChans, помещенный в очередь с приоритетами для связи. Возвращает "out" очередь и & quot; в & quot; очередь, соответствующая серверным и клиентским сообщениям. Отправка и получение событий выполняются в отдельных потоках с использованием 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

Итак, мои теории относительно того, почему это происходит:

The display callback is blocking all of the sending and receiving threads on the retry. The queues are not being returned properly, so that the queues that the client reads are different than the ones that the OpenGL part reads.

Есть ли другие причины, по которым это может происходить?

Полный код для этого слишком длинный, чтобы публиковать здесь, хотя и не слишком длинный (5 файлов по 100 строк в каждом), однако это все на GitHubВот.

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 (и использовал -threaded at ghc), и похоже, что события успешно передаются, однако они не принимаются в обратном вызове дисплея. Я тоже пробовал звонитьpostRedisplay в конце отображения обратного вызова, но я не думаю, что он когда-либо будет вызван (потому что я думаю, что повторная попытка блокирует весь поток OpenGL).

Будет ли повторная попытка в обратном вызове дисплея заблокировать весь поток OpenGL? Если это произойдет, будет ли безопасно преобразовать обратный вызов дисплея в новый поток? Я не думаю, что это произойдет, поскольку существует вероятность того, что несколько объектов могут одновременно пытаться рисовать на экране, но я мог бы справиться с этим с помощью блокировки. Другое решение было бы преобразоватьlookupHandler функция для возврата функции, завернутой вMaybeи просто ничего не делать, если нет событий. Я чувствую, что это было бы далеко не идеально, поскольку у меня тогда был бы по сути занятой цикл, которого я пытался избежать.

Edit 4:
Забыл упомянуть, что я использовал -rereaded на ghc, когда я делал forkOS.

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, и он работает только с ним. Теперь проблема заключается в том, что это привязывает ЦП к 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

Edit 6: Solution
Решение! Продолжая работу с потоками, я решил создать поток в коде 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

И это работает, он не привязывает ЦП к 100%, и события обрабатываются быстро. Я публикую это здесь, потому что я не мог сделать это без других ответов, и мне плохо, когда я повторяю ответы, когда ответы были очень полезны, поэтому я принимаю ответ @ Laar, так как у него более низкая репутация.