Wykonuję prace sprawdzające koncepcję dość złożonej gry wideo, którą chciałbym napisać w Haskell za pomocą biblioteki HOpenGL. Zacząłem od napisania modułu, który implementuje komunikację opartą na zdarzeniach klient-serwer. Mój problem pojawia się, gdy próbuję podłączyć go do prostego programu do rysowania kliknięć na ekranie.

Biblioteka zdarzeń używa listy TChans utworzonych w kolejce priorytetowej do komunikacji. Zwraca kolejkę „out” i kolejkę „in” odpowiadającą wiadomościom związanym z serwerem i związanym z klientem. Zdarzenia wysyłania i odbierania są wykonywane w osobnych wątkach przy użyciu forkIO. Testowanie biblioteki zdarzeń bez części OpenGL pokazuje, że komunikuje się ona pomyślnie. Oto kod, którego użyłem do przetestowania:

-- 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)))
   }

Daje to oczekiwaną wydajność, a mianowicie całą masę zdarzeń wysyłania i odbierania. Nie sądzę, aby problem tkwił w bibliotece obsługi zdarzeń.

Część kodu OpenGL sprawdza kolejkę przychodzącą pod kątem nowych zdarzeń w displayCallback, a następnie wywołuje powiązaną procedurę obsługi zdarzenia. Mogę dostać jedno zdarzenie (zdarzenie Init, które po prostu usuwa ekran), aby zostać złapanym przez displayCallback, ale po tym nic nie zostanie złapane. Oto odpowiedni kod:

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

Zatem moje teorie, dlaczego tak się dzieje, są następujące:

Wywołanie zwrotne blokuje wszystkie wątki wysyłające i odbierające podczas ponownej próby.Kolejki nie są zwracane poprawnie, więc kolejki, które odczytuje klient, są inne niż te, które czyta część OpenGL.

Czy są jakieś inne powody, dla których mogłoby się to dziać?

Kompletny kod do tego jest zbyt długi, aby opublikować go tutaj, chociaż nie za długo (5 plików poniżej 100 linii każdy), jednak jest to wszystko w GitHubtutaj.

Edytuj 1:
Klient jest uruchamiany z głównej funkcji w kodzie HOpenGL w następujący sposób:

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

Jedyna flaga, którą przekazuję do GHC, gdy kompiluję kod, to-package GLUT.

Edytuj 2:
Wyczyściłem trochę kod na Githubie. Usunąłem acceptInput, ponieważ tak naprawdę nic nie robił, a kod klienta nie powinien słuchać własnych wydarzeń, dlatego zwraca kolejki.

Edytuj 3:
Trochę wyjaśniam moje pytanie. Wziąłem to, czego nauczyłem się z @Shang i @Laar, i uruchomiłem z nim. Zmieniłem wątki w Client.hs, aby używał forkOS zamiast forkIO (i używał -threaded w ghc), i wygląda na to, że zdarzenia są pomyślnie komunikowane, jednak nie są odbierane w wywołaniu zwrotnym wyświetlacza. Próbowałem też dzwonićpostRedisplay na końcu wywołania zwrotnego wyświetlania, ale nie sądzę, aby kiedykolwiek zostało wywołane (ponieważ uważam, że ponowna próba blokuje cały wątek OpenGL).

Czy próba ponownego wywołania zwrotnego zablokuje cały wątek OpenGL? Jeśli tak, czy byłoby bezpiecznie rozwidlić wywołanie zwrotne wyświetlacza w nowy wątek? Nie wyobrażam sobie tego, ponieważ istnieje możliwość, że wiele rzeczy może próbować narysować na ekranie w tym samym czasie, ale mogę być w stanie poradzić sobie z tym zamkiem. Innym rozwiązaniem byłoby przekonwertowanielookupHandler funkcja zwracająca funkcję zapakowaną w aMaybei po prostu nic nie rób, jeśli nie ma żadnych wydarzeń. Wydaje mi się, że byłoby to mniej niż idealne, ponieważ wtedy miałem w zasadzie zapętloną pętlę, której starałem się unikać.

Edytuj 4:
Zapomniałem wspomnieć, że użyłem wątku w ghc, gdy robiłem forkOS.

Edytuj 5:
Poszedłem i sprawdziłem moją teorię, że ponawianie próby w funkcji renderowania (wywołanie zwrotne) blokowało cały OpenGL. Przepisałem funkcję renderowania, aby już nie blokowała i działała tak, jakbym chciał, aby działała. Jedno kliknięcie na ekranie daje dwa punkty, jeden z serwera iz oryginalnego kliknięcia. Oto kod nowej funkcji renderowania (uwaga: to jestnie w 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

Próbowałem go z postRedisplay i bez niego, i działa tylko z nim. Problemem staje się teraz to, że procesor jest w 100% powiązany, ponieważ jest to zajęta pętla. W Edit 4 zaproponowałem wyłączenie wywołania zwrotnego wyświetlacza. Nadal myślę o tym, jak to zrobić.

Uwaga, ponieważ jeszcze o tym nie wspominałem. Każdy, kto chce zbudować / uruchomić kod powinien to zrobić tak:

$ 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

Edytuj 6:Rozwiązanie
Rozwiązanie! Idąc w parze z wątkami, postanowiłem utworzyć wątek w kodzie OpenGL, który sprawdzałby zdarzenia, blokował, jeśli ich nie ma, a następnie wywołuje program obsługi, a następnie postRedisplay. Oto jest:

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

Wywołanie zwrotne jest po prostu:

render = GLUT.swapBuffers

I działa, nie przypisuje procesora do 100%, a zdarzenia są obsługiwane szybko. Zamieszczam to tutaj, ponieważ nie mógłbym tego zrobić bez innych odpowiedzi i czuję się źle biorąc rep, gdy obie odpowiedzi były bardzo pomocne, więc akceptuję odpowiedź @ Laar, ponieważ ma on niższą Rep.