{-# LINE 1 "src/Foreign/R/EventLoop.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
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
{
InputHandler -> FunPtr (Ptr () -> IO ())
inputHandlerCallback :: FunPtr (Ptr () -> IO ())
, InputHandler -> CInt
inputHandlerActivity :: CInt
, InputHandler -> CInt
inputHandlerActive :: CInt
, InputHandler -> Fd
inputHandlerFD :: Fd
, InputHandler -> Ptr ()
inputHandlerUserData :: Ptr ()
, InputHandler -> Ptr InputHandler
inputHandlerNext :: Ptr InputHandler
} deriving (InputHandler -> InputHandler -> Bool
(InputHandler -> InputHandler -> Bool)
-> (InputHandler -> InputHandler -> Bool) -> Eq InputHandler
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputHandler -> InputHandler -> Bool
$c/= :: InputHandler -> InputHandler -> Bool
== :: InputHandler -> InputHandler -> Bool
$c== :: InputHandler -> InputHandler -> Bool
Eq, Int -> InputHandler -> ShowS
[InputHandler] -> ShowS
InputHandler -> String
(Int -> InputHandler -> ShowS)
-> (InputHandler -> String)
-> ([InputHandler] -> ShowS)
-> Show InputHandler
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputHandler] -> ShowS
$cshowList :: [InputHandler] -> ShowS
show :: InputHandler -> String
$cshow :: InputHandler -> String
showsPrec :: Int -> InputHandler -> ShowS
$cshowsPrec :: Int -> InputHandler -> ShowS
Show)
instance Storable InputHandler where
sizeOf :: InputHandler -> Int
sizeOf _ = (40)
{-# LINE 53 "src/Foreign/R/EventLoop.hsc" #-}
alignment _ = 8
{-# LINE 54 "src/Foreign/R/EventLoop.hsc" #-}
peek hptr = InputHandler <$>
(\hsc_ptr -> peekByteOff hsc_ptr 8) hptr <*>
{-# LINE 56 "src/Foreign/R/EventLoop.hsc" #-}
(\hsc_ptr -> peekByteOff hsc_ptr 0) hptr <*>
{-# LINE 57 "src/Foreign/R/EventLoop.hsc" #-}
(\hsc_ptr -> peekByteOff hsc_ptr 24) hptr <*>
{-# LINE 58 "src/Foreign/R/EventLoop.hsc" #-}
(Fd <$> (\hsc_ptr -> peekByteOff hsc_ptr 4) hptr) <*>
{-# LINE 59 "src/Foreign/R/EventLoop.hsc" #-}
(\hsc_ptr -> peekByteOff hsc_ptr 32) hptr <*>
{-# LINE 60 "src/Foreign/R/EventLoop.hsc" #-}
(castPtr <$> (\hsc_ptr -> peekByteOff hsc_ptr 16) hptr)
{-# LINE 61 "src/Foreign/R/EventLoop.hsc" #-}
poke hptr InputHandler{..} = do
(\hsc_ptr -> pokeByteOff hsc_ptr 8) hptr inputHandlerCallback
{-# LINE 63 "src/Foreign/R/EventLoop.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 0) hptr inputHandlerActivity
{-# LINE 64 "src/Foreign/R/EventLoop.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 24) hptr inputHandlerActive
{-# LINE 65 "src/Foreign/R/EventLoop.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 4) hptr (case inputHandlerFD of Fd fd -> fd)
{-# LINE 66 "src/Foreign/R/EventLoop.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 32) hptr inputHandlerUserData
{-# LINE 67 "src/Foreign/R/EventLoop.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 16) hptr (castPtr inputHandlerNext)
{-# LINE 68 "src/Foreign/R/EventLoop.hsc" #-}
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 :: Ptr InputHandler
-> Fd -> FunPtr (Ptr () -> IO ()) -> Int -> IO (Ptr InputHandler)
addInputHandler ihptr :: Ptr InputHandler
ihptr fd :: Fd
fd f :: FunPtr (Ptr () -> IO ())
f activity :: Int
activity = do
Ptr InputHandler
-> Fd -> FunPtr (Ptr () -> IO ()) -> CInt -> IO (Ptr InputHandler)
addInputHandler_ Ptr InputHandler
ihptr Fd
fd FunPtr (Ptr () -> IO ())
f (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
activity)
foreign import ccall "removeInputHandler" removeInputHandler_
:: Ptr (Ptr InputHandler)
-> Ptr InputHandler
-> IO CInt
removeInputHandler :: Ptr InputHandler -> Ptr InputHandler -> IO Bool
removeInputHandler :: Ptr InputHandler -> Ptr InputHandler -> IO Bool
removeInputHandler handlers :: Ptr InputHandler
handlers ih :: Ptr InputHandler
ih =
Ptr InputHandler -> (Ptr (Ptr InputHandler) -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Ptr InputHandler
handlers ((Ptr (Ptr InputHandler) -> IO Bool) -> IO Bool)
-> (Ptr (Ptr InputHandler) -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \handlersptr :: Ptr (Ptr InputHandler)
handlersptr -> do
CInt
rc <- Ptr (Ptr InputHandler) -> Ptr InputHandler -> IO CInt
removeInputHandler_ Ptr (Ptr InputHandler)
handlersptr Ptr InputHandler
ih
case CInt
rc of
0 -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool
False
1 -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool
True
_ -> String -> IO Bool
forall a. HasCallStack => String -> a
error "removeInputHandler: unexpected result."