
XHB uses existentials to enable X extensions to define their own events and still have them delivered to the user by the main library, so I had the chance to mess around with them and reactive. If you comment out the keyPressH, things are perfectly fine, but there's no dispatch on event types. With the forkIO, the program stumbles over an indefinite block on the next event. The adaptE without fromEventE is the only thing keeping the program alive: It seems that if there is only a single event that is possibly not handled, things go haywire... even if every event is guaranteed to be handled (in some other adaptE). Without any adaptE things work fine, too. I don't know if multiple adaptE's are supposed to work, but it'd be certainly nice if they would. I'm going to try to join the Nothings sorted out by joinMaybes back into the stream, hopefully that'll convince the RTS. {-# LANGUAGE ExistentialQuantification #-} module Main where -- current darcs XHB -- hack it to export Graphics.XHB.Connection.Types -- port of http://en.wikibooks.org/wiki/X_Window_Programming/XCB -- run your X server on :0 or change getScreen import Graphics.XHB as X import FRP.Reactive as R import FRP.Reactive.LegacyAdapters import Control.Concurrent import Control.Monad import System.Exit import Control.Applicative printErrors c = (forkIO . forever) $ waitForError c >>= print getScreen = head . roots_Setup . conf_setup . conn_conf castXid = fromXid . toXid main = do (Just c) <- connect printErrors c print $ displayInfo c let s = getScreen c black = black_pixel_SCREEN s white = white_pixel_SCREEN s root = root_SCREEN s depth = root_depth_SCREEN s visual = root_visual_SCREEN s g <- newResource c createGC c (MkCreateGC g (castXid root) (toValueParam [(GCForeground,white) ,(GCGraphicsExposures,0) ] )) w <- newResource c createWindow c (MkCreateWindow depth w root 0 0 640 480 0 0 visual (toValueParam [(CWBackPixel,black) ,(CWEventMask,toMask [ EventMaskExposure , EventMaskKeyPress ] ) ] )) lock <- newEmptyMVar sync <- makeSync evs <- eventsE sync c mapWindow c w forkIO $ adaptE $ keyPressH lock c $ fromEventE evs -- forkIO $ adaptE $ exposeH c $ fromEventE evs adaptE $ (fmap.const) (putStrLn "some event" ) evs --readMVar lock keyPressH :: MVar () -> Connection -> R.Event KeyPress -> R.Event Action keyPressH lock _ = (fmap.const) $ putStrLn "key" >> putMVar lock () exposeH :: Connection -> R.Event KeyPress -> R.Event Action exposeH _ = fmap print fromEventE :: X.Event a => R.Event SomeEvent -> R.Event a fromEventE = joinMaybes <$> fmap fromEvent type Sync = Clock TimeT makeSync = makeClock eventsE :: Sync -> Connection -> IO (R.Event SomeEvent) eventsE cl c = do (sink, res) <- makeEvent cl (forkIO . forever) $ putStrLn "tick " >> waitForEvent c >>= sink return res -- (c) this sig last receiving data processing entity. Inspect headers for copyright history. All rights reserved. Copying, hiring, renting, performance and/or quoting of this signature prohibited.

Achim Schneider
I'm going to try to join the Nothings sorted out by joinMaybes back into the stream, hopefully that'll convince the RTS.
Indeed, it does: http://moonpatio.com:8080/fastcgi/hpaste.fcgi/view?id=1050 -- (c) this sig last receiving data processing entity. Inspect headers for copyright history. All rights reserved. Copying, hiring, renting, performance and/or quoting of this signature prohibited.
participants (1)
-
Achim Schneider