{-| Quarts Event Services. This module provides features for managing event taps—filters for observing and altering the stream of low-level user input events in macOS. See: https://developer.apple.com/documentation/coregraphics/quartz_event_services?language=objc -} module MacSdk.Framework.CoreGraphics.Event ( Event , EventType(..) , EventField(..) , EventSource , EventTapLocation(..) , EventTapCallback , MouseButtonPress(..) , KeyEventPosition(..) , CGKeyCode , module MacSdk.Framework.CoreGraphics.Event.Flag -- * Events , eventCreate , createMouseEvent , createKeyboardEvent , eventFlags , getEventField , eventGetType , eventSetType , eventSetFlags -- * Event taps , EventTap , eventTapEnable , eventTapDisable , eventPost , eventTapCreate , eventTapMachPort , eventTapRelease , QuartzEvents(..) , kCGSessionEventTap , kCGHeadInsertEventTap , kCGEventTapOptionDefault ) where import Foreign.C.Types (CInt(..), CBool(..)) import Foreign.Ptr import Foreign import System.IO.Unsafe import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad (guard) import MacSdk.Framework.CoreFoundation import MacSdk.Framework.CoreGraphics.Rect import MacSdk.Framework.CoreGraphics.Event.Type import MacSdk.Framework.CoreGraphics.Event.Flag import MacSdk.Framework.CoreGraphics.Event.Field import MacSdk.Framework.CoreGraphics.Event.Mask import MacSdk.Framework.CoreGraphics.Event.Location data CGEvent type CGEventRef = Ptr CGEvent -- | Type of low-level Quartz events. A typical event in macOS originates when -- the user manipulates an input device such as a mouse or a keyboard. You can -- use event taps to gain access to Quartz events. type Event = Object CGEvent instance CFClass CGEvent data CGEventSource type CGEventSourceRef = Ptr CGEventSource -- | Type of objects representing the source of a Quartz event. type EventSource = Object CGEventSource instance CFClass CGEventSource -------------------------------------------------------------------------------- -- Working with Events foreign import ccall unsafe "CGEventCreate" cg_event_create :: CGEventSourceRef -> IO CGEventRef -- | Returns a new Quartz event to be filled in. If no event source is -- specified, a default source is used. Returns 'Nothing' if the event could not -- be created. eventCreate :: Maybe EventSource -> IO (Maybe Event) eventCreate = maybe (aux nullPtr) (flip withCFPtr aux) where aux p = do ref <- cg_event_create p if ref == nullPtr then pure Nothing else Just <$> manageCFObj ref type CGMouseButton = Word32 data MouseButtonPress = LeftButtonPress | RightButtonPress | CenterButtonPress toPressCode :: MouseButtonPress -> CGMouseButton toPressCode = \case LeftButtonPress -> 0 RightButtonPress -> 1 CenterButtonPress -> 2 foreign import ccall unsafe "CGEventCreateMouseEvent_" cg_event_create_mouse_event :: CGEventSourceRef -> CGEventType -> Ptr Point -> CGMouseButton -> IO CGEventRef -- | Returns a new Quartz mouse event. If no event source is specified, a -- default source is used. Returns 'Nothing' if the event could not be created. createMouseEvent :: Maybe EventSource -> EventType -> Point -> MouseButtonPress -> IO (Maybe Event) createMouseEvent mes ety p mbp = maybe (aux nullPtr) (flip withCFPtr aux) mes where aux es = alloca $ \ptr -> do poke ptr p ref <- cg_event_create_mouse_event es (toEventTypeCode ety) ptr (toPressCode mbp) if ref == nullPtr then pure Nothing else Just <$> manageCFObj ref -------------------------------------------------------------------------------- type CGKeyCode = Word32 foreign import ccall unsafe "CGEventCreateKeyboardEvent" cg_event_create_keyboard_event :: CGEventSourceRef -> CGKeyCode -> CBool -> IO CGEventRef data KeyEventPosition = KeyDown | KeyUp createKeyboardEvent :: MonadIO m => Maybe EventSource -> CGKeyCode -> KeyEventPosition -> m (Maybe Event) createKeyboardEvent mes k pos = liftIO $ maybe (aux nullPtr) (flip withCFPtr aux) mes where aux es = do res <- cg_event_create_keyboard_event es k $ case pos of { KeyDown -> 1 ; KeyUp -> 0 } if res == nullPtr then pure Nothing else Just <$> manageCFObj res -------------------------------------------------------------------------------- foreign import ccall unsafe "CGEventSetFlags" cg_event_set_flags :: CGEventRef -> CGEventFlags -> IO () eventSetFlags :: MonadIO m => Event -> CGEventFlags -> m () eventSetFlags e flags = liftIO $ withCFPtr e (flip cg_event_set_flags flags) -------------------------------------------------------------------------------- foreign import ccall unsafe "CGEventPost" cg_event_post :: CGEventTapLocation -> CGEventRef -> IO () -- | Posts a Quartz event into the event stream at a specified location. eventPost :: MonadIO m => EventTapLocation -> Event -> m () eventPost loc ev = liftIO $ withCFPtr ev (cg_event_post (toCGEventTapLocation loc)) -------------------------------------------------------------------------------- foreign import ccall unsafe "CGEventSetType" cg_event_set_type :: CGEventRef -> CGEventType -> IO () -- | Sets the event type of a Quartz event. eventSetType :: MonadIO m => Event -> EventType -> m () eventSetType ev ety = liftIO $ withCFPtr ev (flip cg_event_set_type (toEventTypeCode ety)) -------------------------------------------------------------------------------- type CGEventType = Word32 foreign import ccall unsafe "CGEventGetType" cg_event_get_type :: CGEventRef -> IO CGEventType -- | Returns the event type of a Quartz event (left mouse down, for example). eventGetType :: Event -> IO EventType eventGetType = flip withCFPtr (fmap fromEventTypeCode . cg_event_get_type) -------------------------------------------------------------------------------- foreign import ccall unsafe "CGSIsSecureEventInputSet" check_secure_input_set :: IO CBool checkSecureInputSet :: IO Bool checkSecureInputSet = fmap Foreign.toBool check_secure_input_set -------------------------------------------------------------------------------- foreign import ccall unsafe "CGEventGetFlags" cgEventGetFlags :: CGEventRef -> IO CGEventFlags -- | Returns the event flags of a Quartz event. eventFlags :: Event -> IO CGEventFlags eventFlags = flip withCFPtr cgEventGetFlags -------------------------------------------------------------------------------- type CGEventField = Word32 foreign import ccall unsafe "CGEventGetIntegerValueField" cgEventGetIntegerValueField :: CGEventRef -> CGEventField -> IO Word64 foreign import ccall unsafe "CGEventGetDoubleValueField" cgEventGetDoubleValueField :: CGEventRef -> CGEventField -> IO Double getEventField :: Event -> EventField ty -> IO ty getEventField e efs = withCFPtr e $ \p -> let code = toEventFieldCode efs in decideFieldType (cgEventGetIntegerValueField p code) (cgEventGetDoubleValueField p code) efs -------------------------------------------------------------------------------- foreign import ccall unsafe "CGEventTapEnable" cg_event_tap_enable :: CFMachPortRef -> CBool -> IO () -- | Enables an event tap. -- -- Event taps are normally enabled when created. If an event tap becomes -- unresponsive, or if a user requests that event taps be disabled, then a -- EventTapDisabled event is passed to the event tap callback function. Event -- taps may be re-enabled by calling this function. eventTapEnable :: MonadIO m => EventTap -> m () eventTapEnable = liftIO . flip withCFPtr (`cg_event_tap_enable` 1) . _etMachPort -- | Disables an event tap. eventTapDisable :: MonadIO m => EventTap -> m () eventTapDisable = liftIO . flip withCFPtr (`cg_event_tap_enable` 0) . _etMachPort -------------------------------------------------------------------------------- type CGEventTapPlacement = CInt type CGEventTapOptions = CInt foreign import ccall unsafe mykCGSessionEventTap :: IO CGEventTapLocation kCGSessionEventTap :: CGEventTapLocation kCGSessionEventTap = unsafePerformIO mykCGSessionEventTap {-# NOINLINE kCGSessionEventTap #-} foreign import ccall unsafe mykCGHeadInsertEventTap :: IO CGEventTapPlacement kCGHeadInsertEventTap :: CGEventTapPlacement kCGHeadInsertEventTap = unsafePerformIO mykCGHeadInsertEventTap {-# NOINLINE kCGHeadInsertEventTap #-} foreign import ccall unsafe mykCGEventTapOptionDefault :: IO CGEventTapOptions kCGEventTapOptionDefault :: CGEventTapOptions kCGEventTapOptionDefault = unsafePerformIO mykCGEventTapOptionDefault {-# NOINLINE kCGEventTapOptionDefault #-} data CGEventTapProxy_ type CGEventTapProxy = Ptr CGEventTapProxy_ -- | Type that represents state within the client application that’s associated -- with an event tap. newtype EventTapProxy = EventTapProxy { getEventTapProxy :: CGEventTapProxy } type CGEventTapCallBack = CGEventTapProxy -> CGEventType -> CGEventRef -> Ptr () -> IO CGEventRef -- | Type of client-supplied callback function that’s invoked whenever an -- associated event tap receives a Quartz event. -- -- An event tap proxy object is passed to the callback function when it receives -- a new Quartz event. The function needs the proxy to post Quartz events using -- the function 'eventTapPostEvent'. -- -- If the event tap is an active filter, your callback function should return -- one of the following: -- -- * The (possibly modified) event that is passed in, or a newly-constructed -- event, wrapped in 'Just'. This event is passed back to the event system. -- -- * 'Nothing' if the event passed in is to be deleted. -- -- If the event tap is an passive listener, the callback function may return the -- event that is passed in wrapped in 'Just', or 'Nothing'. In either case, the -- event stream is not affected. type EventTapCallback a = EventTapProxy -> EventType -> Event -> a -> IO (Maybe Event) foreign import ccall "wrapper" wrapCGEventTapCallBack :: CGEventTapCallBack -> IO (FunPtr CGEventTapCallBack) foreign import ccall "CGEventTapCreate" cgEventTapCreate :: CGEventTapLocation -> CGEventTapPlacement -> CGEventTapOptions -> CGEventMask -> FunPtr CGEventTapCallBack -> Ptr () -> IO CFMachPortRef data EventTap = EventTap { _etMachPort :: MachPort , _etMachPortRef :: Ref , _etCallb :: FunPtr CGEventTapCallBack } eventTapMachPort :: EventTap -> MachPort eventTapMachPort = _etMachPort eventTapRelease :: MonadIO m => EventTap -> m () eventTapRelease (EventTap _ ref cb) = liftIO (refRelease ref >> freeHaskellFunPtr cb) -- | Returns a newly-created 'EventTap', or 'Nothing' if the event tap could not -- be created. When you are finished using the event tap, you should release it -- using the function 'eventTapRelease'. -- -- Event taps receive key up and key down events if one of the following -- conditions is true: -- -- * The current process is running as the root user. -- -- * Access for assistive devices is enabled. In OS X v10.4, you can enable this -- feature using System Preferences, Universal Access panel, Keyboard view. You -- should check whether AX privileges have been granted with 'checkAXPrivileges'. -- -- After creating an event tap, you can add it to a run loop as follows: -- -- * Retrieve the event tap's 'MachPort' with 'eventTapMachPort' and pass it to -- the 'machPortRunLoopSource' function to create a run loop event source. -- -- * Call the 'runLoopAddSource' function to add the source to the appropriate -- run loop. -- -- Alternatively, you can 'addSourceToMainLoop' to start the event tap with -- default parameters. eventTapCreate :: CGEventTapLocation -> CGEventTapPlacement -> CGEventTapOptions -> QuartzEvents -> EventTapCallback a -> a -> IO (Maybe EventTap) eventTapCreate l p o evs callb userData = do ptr <- castStablePtrToPtr <$> newStablePtr userData c' <- wrapCGEventTapCallBack $ \proxy ety e ptr' -> do ev <- retainManageCFObj e x <- deRefStablePtr (castPtrToStablePtr ptr') me <- callb (EventTapProxy proxy) (fromEventTypeCode ety) ev x maybe (pure nullPtr) (flip withCFPtr pure) me machPtr <- cgEventTapCreate l p o (getEventMask (toMask evs)) c' ptr mach <- manageCFObj machPtr ref <- objRetain mach -- Event taps are normally enabled when created. If not, something went wrong -- and we fail. en <- toBool <$> cgEventTapIsEnabled machPtr pure $ guard (machPtr /= nullPtr && en) >> Just (EventTap mach ref c')