{-# LANGUAGE CPP #-}
module Graphics.Win32.Window.ForegroundWindow
( getForegroundWindow
, setForegroundWindow
, c_SetForegroundWindow
, allowSetForegroundWindow
, c_AllowSetForegroundWindow
) where
import Control.Monad ( void )
import Graphics.Win32.GDI.Types ( HWND )
import Graphics.Win32.Window ( getForegroundWindow )
import System.Win32.Process ( ProcessId )
#include "windows_cconv.h"
setForegroundWindow :: HWND -> IO Bool
setForegroundWindow :: HWND -> IO Bool
setForegroundWindow = HWND -> IO Bool
c_SetForegroundWindow
foreign import WINDOWS_CCONV safe "windows.h SetForegroundWindow"
c_SetForegroundWindow :: HWND -> IO Bool
allowSetForegroundWindow :: ProcessId -> IO ()
allowSetForegroundWindow :: ProcessId -> IO ()
allowSetForegroundWindow = IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> (ProcessId -> IO Bool) -> ProcessId -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessId -> IO Bool
c_AllowSetForegroundWindow
foreign import WINDOWS_CCONV safe "windows.h AllowSetForegroundWindow"
c_AllowSetForegroundWindow :: ProcessId -> IO Bool