module Foreign.R.EventLoop
( InputHandler(..)
, inputHandlers
, polledEvents
, pollingPeriod
, graphicsPolledEvents
, graphicsPollingPeriod
, checkActivity
, runHandlers
, addInputHandler
, removeInputHandler
) where
import Control.Applicative
import Foreign (FunPtr, Ptr, Storable(..), castPtr)
import Foreign.C
import Foreign.Marshal.Utils (with)
import System.Posix.Types (Fd(..))
import Prelude
data InputHandler = InputHandler
{
inputHandlerCallback :: FunPtr (Ptr () -> IO ())
, inputHandlerActivity :: CInt
, inputHandlerActive :: CInt
, inputHandlerFD :: Fd
, inputHandlerUserData :: Ptr ()
, inputHandlerNext :: Ptr InputHandler
} deriving (Eq, Show)
instance Storable InputHandler where
sizeOf _ = (40)
alignment _ = 8
peek hptr = InputHandler <$>
(\hsc_ptr -> peekByteOff hsc_ptr 8) hptr <*>
(\hsc_ptr -> peekByteOff hsc_ptr 0) hptr <*>
(\hsc_ptr -> peekByteOff hsc_ptr 24) hptr <*>
(Fd <$> (\hsc_ptr -> peekByteOff hsc_ptr 4) hptr) <*>
(\hsc_ptr -> peekByteOff hsc_ptr 32) hptr <*>
(castPtr <$> (\hsc_ptr -> peekByteOff hsc_ptr 16) hptr)
poke hptr InputHandler{..} = do
(\hsc_ptr -> pokeByteOff hsc_ptr 8) hptr inputHandlerCallback
(\hsc_ptr -> pokeByteOff hsc_ptr 0) hptr inputHandlerActivity
(\hsc_ptr -> pokeByteOff hsc_ptr 24) hptr inputHandlerActive
(\hsc_ptr -> pokeByteOff hsc_ptr 4) hptr (case inputHandlerFD of Fd fd -> fd)
(\hsc_ptr -> pokeByteOff hsc_ptr 32) hptr inputHandlerUserData
(\hsc_ptr -> pokeByteOff hsc_ptr 16) hptr (castPtr inputHandlerNext)
foreign import ccall "&R_PolledEvents" polledEvents :: Ptr (FunPtr (IO ()))
foreign import ccall "&R_wait_usec" pollingPeriod :: Ptr CInt
foreign import ccall "&Rg_PolledEvents" graphicsPolledEvents :: Ptr (FunPtr (IO ()))
foreign import ccall "&Rg_wait_usec" graphicsPollingPeriod :: Ptr CInt
foreign import ccall "&R_InputHandlers" inputHandlers :: Ptr (Ptr InputHandler)
data FdSet
foreign import ccall unsafe "R_checkActivity" checkActivity
:: CInt
-> CInt
-> IO (Ptr FdSet)
foreign import ccall "R_runHandlers" runHandlers
:: Ptr InputHandler
-> Ptr FdSet
-> IO ()
foreign import ccall "addInputHandler" addInputHandler_
:: Ptr InputHandler
-> Fd
-> FunPtr (Ptr () -> IO ())
-> CInt
-> IO (Ptr InputHandler)
addInputHandler
:: Ptr InputHandler
-> Fd
-> FunPtr (Ptr () -> IO ())
-> Int
-> IO (Ptr InputHandler)
addInputHandler ihptr fd f activity = do
addInputHandler_ ihptr fd f (fromIntegral activity)
foreign import ccall "removeInputHandler" removeInputHandler_
:: Ptr (Ptr InputHandler)
-> Ptr InputHandler
-> IO CInt
removeInputHandler :: Ptr InputHandler -> Ptr InputHandler -> IO Bool
removeInputHandler handlers ih =
with handlers $ \handlersptr -> do
rc <- removeInputHandler_ handlersptr ih
case rc of
0 -> return $ False
1 -> return $ True
_ -> error "removeInputHandler: unexpected result."