{-# LANGUAGE GADTs #-} -- | Quartz Window Services -- -- This includes the onscreen windows seen on the user’s desktop and any -- offscreen windows used by the running applications. You can also use Quartz -- Window Services to generate images based on the contents of windows. -- -- See: https://developer.apple.com/documentation/coregraphics/quartz_window_services module MacSdk.Framework.CoreGraphics.Window ( WindowID , CGWindowID , WindowListOption(..) , WindowInfoDictionary , WindowListKey(..) , OptionalWindowListKey(..) , getDictionary -- * Getting window information , windowListCopyWindowInfo , windowInfoLookupKey , windowInfoLookupOptionalKey ) where import MacSdk.Framework.CoreFoundation import MacSdk.Framework.CoreGraphics.Window.Types import MacSdk.Framework.CoreGraphics.Rect import Foreign (nullPtr) import Control.Monad.IO.Class (MonadIO(..)) import Data.Maybe (fromMaybe) -------------------------------------------------------------------------------- -- Getting window information newtype WindowInfoDictionary = WindowInfoDictionary { getDictionary :: Dictionary } -- CFArrayRef CGWindowListCopyWindowInfo(CGWindowListOption option, CGWindowID relativeToWindow); foreign import ccall unsafe "CGWindowListCopyWindowInfo" cg_window_list_copy_window_info :: CGWindowListOption -> CGWindowID -> IO CFArrayRef -- | Returns an array of 'Dictionary' elements, each of which contains -- information about one of the windows in the current user session. -- -- The second parameter specifies the ID of the window to use as a reference -- point when determining which other window dictionaries to return. For options -- that do not require a reference window, this parameter should be 'Nothing'. -- -- The first parameter is a list of options describing which window dictionaries -- to return. An empty list retrieves all windows, including both onscreen and -- offscreen windows. When retrieving a list with this option, the second -- parameter should be set to 'Nothing'. -- -- If there are no windows matching the desired criteria, the function -- returns an empty array. If you call this function from outside of a GUI -- security session or when no window server is running, this function returns -- 'Nothing'. windowListCopyWindowInfo :: MonadIO m => [WindowListOption] -> Maybe WindowID -> m (Maybe (Array WindowInfoDictionary)) windowListCopyWindowInfo opts mwid = fmap (fmap Array) . liftIO $ do arr <- cg_window_list_copy_window_info (orEdOptions opts) (fromMaybe nullWindowID mwid) if arr == nullPtr then pure Nothing else fmap Just (retainManageCFObj arr) windowInfoLookupKey :: MonadIO m => WindowInfoDictionary -> WindowListKey ty -> m ty windowInfoLookupKey (WindowInfoDictionary dict) key = case key of WindowNumber -> do int <- getDictValue' dict skey >>= flip numberGetValue NumberSInt32Type pure (maybe (err key) fromIntegral int) WindowStoreType -> undefined WindowLayer -> undefined WindowBounds -> do rectDict <- getDictValue' dict skey fromMaybe (err key) <$> rectMakeWithDictionaryRepresentation rectDict WindowSharingState -> undefined WindowAlpha -> undefined WindowOwnerPID -> do int <- getDictValue' dict skey >>= flip numberGetValue NumberIntType pure (maybe (err key) fromIntegral int) WindowMemoryUsage -> undefined where skey = toWindowListKeyString key err :: WindowListKey ty -> ty err k = error ("windowInfoLookupKey: failed to lookup a required window list key: " ++ show k) windowInfoLookupOptionalKey :: MonadIO m => WindowInfoDictionary -> OptionalWindowListKey ty -> m (Maybe ty) windowInfoLookupOptionalKey (WindowInfoDictionary dict) key = case key of WindowOwnerName -> getDictValueSafe dict skey WindowName -> getDictValueSafe dict skey WindowIsOnscreen -> undefined WindowBackingLocationVideoMemory -> undefined where skey = toOptionalWindowListKeyString key -- foo :: WindowInfoDictionary -> IO () -- foo d = do -- windowInfoLookupKey d WindowNumber >>= print -- windowInfoLookupOptionalKey d WindowName >>= -- maybe (pure ()) (toString CFStringEncodingUTF8 >=> print) -- windowInfoLookupOptionalKey d WindowOwnerName >>= -- maybe (pure ()) (toString CFStringEncodingUTF8 >=> print) -- putStrLn ""