#if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} #else {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.Key -- Copyright : (c) Alastair Reid, 1997-2003, 2013 shelarcy -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module Graphics.Win32.Key where import Control.Monad (liftM) import Graphics.Win32.GDI.Types (HWND) import System.Win32.Types ( DWORD, UINT, WORD, ptrToMaybe, BOOL, SHORT, failIfFalse_, failIfZero ) import Control.Exception ( bracket ) import Foreign.Ptr ( Ptr, nullPtr ) import Foreign.C.Types ( CWchar(..) ) import Foreign.Marshal.Array ( allocaArray, peekArray ) import System.Win32.String ( LPTSTR, LPCTSTR , withTString, withTStringBuffer, peekTString ) import System.Win32.Thread ( TID, getCurrentThreadId ) ##include "windows_cconv.h" #include #include "winuser_compat.h" type VKey = DWORD #{enum VKey, , vK_LBUTTON = VK_LBUTTON , vK_RBUTTON = VK_RBUTTON , vK_CANCEL = VK_CANCEL , vK_MBUTTON = VK_MBUTTON , vK_BACK = VK_BACK , vK_TAB = VK_TAB , vK_CLEAR = VK_CLEAR , vK_RETURN = VK_RETURN , vK_SHIFT = VK_SHIFT , vK_CONTROL = VK_CONTROL , vK_MENU = VK_MENU , vK_PAUSE = VK_PAUSE , vK_CAPITAL = VK_CAPITAL , vK_ESCAPE = VK_ESCAPE , vK_SPACE = VK_SPACE , vK_PRIOR = VK_PRIOR , vK_NEXT = VK_NEXT , vK_END = VK_END , vK_HOME = VK_HOME , vK_LEFT = VK_LEFT , vK_UP = VK_UP , vK_RIGHT = VK_RIGHT , vK_DOWN = VK_DOWN , vK_SELECT = VK_SELECT , vK_EXECUTE = VK_EXECUTE , vK_SNAPSHOT = VK_SNAPSHOT , vK_INSERT = VK_INSERT , vK_DELETE = VK_DELETE , vK_HELP = VK_HELP , vK_NUMPAD0 = VK_NUMPAD0 , vK_NUMPAD1 = VK_NUMPAD1 , vK_NUMPAD2 = VK_NUMPAD2 , vK_NUMPAD3 = VK_NUMPAD3 , vK_NUMPAD4 = VK_NUMPAD4 , vK_NUMPAD5 = VK_NUMPAD5 , vK_NUMPAD6 = VK_NUMPAD6 , vK_NUMPAD7 = VK_NUMPAD7 , vK_NUMPAD8 = VK_NUMPAD8 , vK_NUMPAD9 = VK_NUMPAD9 , vK_MULTIPLY = VK_MULTIPLY , vK_ADD = VK_ADD , vK_SEPARATOR = VK_SEPARATOR , vK_SUBTRACT = VK_SUBTRACT , vK_DECIMAL = VK_DECIMAL , vK_DIVIDE = VK_DIVIDE , vK_F1 = VK_F1 , vK_F2 = VK_F2 , vK_F3 = VK_F3 , vK_F4 = VK_F4 , vK_F5 = VK_F5 , vK_F6 = VK_F6 , vK_F7 = VK_F7 , vK_F8 = VK_F8 , vK_F9 = VK_F9 , vK_F10 = VK_F10 , vK_F11 = VK_F11 , vK_F12 = VK_F12 , vK_F13 = VK_F13 , vK_F14 = VK_F14 , vK_F15 = VK_F15 , vK_F16 = VK_F16 , vK_F17 = VK_F17 , vK_F18 = VK_F18 , vK_F19 = VK_F19 , vK_F20 = VK_F20 , vK_F21 = VK_F21 , vK_F22 = VK_F22 , vK_F23 = VK_F23 , vK_F24 = VK_F24 , vK_NUMLOCK = VK_NUMLOCK , vK_SCROLL = VK_SCROLL , vK_XBUTTON1 = VK_XBUTTON1 , vK_XBUTTON2 = VK_XBUTTON2 , vK_KANA = VK_KANA , vK_HANGUL = VK_HANGUL , vK_JUNJA = VK_JUNJA , vK_FINAL = VK_FINAL , vK_HANJA = VK_HANJA , vK_KANJI = VK_KANJI , vK_CONVERT = VK_CONVERT , vK_NONCONVERT = VK_NONCONVERT , vK_ACCEPT = VK_ACCEPT , vK_MODECHANGE = VK_MODECHANGE , vK_PRINT = VK_PRINT , vK_APPS = VK_APPS , vK_SLEEP = VK_SLEEP , vK_LWIN = VK_LWIN , vK_RWIN = VK_RWIN , vK_LSHIFT = VK_LSHIFT , vK_RSHIFT = VK_RSHIFT , vK_LCONTROL = VK_LCONTROL , vK_RCONTROL = VK_RCONTROL , vK_LMENU = VK_LMENU , vK_RMENU = VK_RMENU , vK_BROWSER_BACK = VK_BROWSER_BACK , vK_BROWSER_FORWARD = VK_BROWSER_FORWARD , vK_BROWSER_REFRESH = VK_BROWSER_REFRESH , vK_BROWSER_STOP = VK_BROWSER_STOP , vK_BROWSER_SEARCH = VK_BROWSER_SEARCH , vK_BROWSER_FAVORITES = VK_BROWSER_FAVORITES , vK_BROWSER_HOME = VK_BROWSER_HOME , vK_VOLUME_MUTE = VK_VOLUME_MUTE , vK_VOLUME_DOWN = VK_VOLUME_DOWN , vK_VOLUME_UP = VK_VOLUME_UP , vK_MEDIA_NEXT_TRACK = VK_MEDIA_NEXT_TRACK , vK_MEDIA_PREV_TRACK = VK_MEDIA_PREV_TRACK , vK_MEDIA_STOP = VK_MEDIA_STOP , vK_MEDIA_PLAY_PAUSE = VK_MEDIA_PLAY_PAUSE , vK_LAUNCH_MAIL = VK_LAUNCH_MAIL , vK_LAUNCH_MEDIA_SELECT = VK_LAUNCH_MEDIA_SELECT , vK_LAUNCH_APP1 = VK_LAUNCH_APP1 , vK_LAUNCH_APP2 = VK_LAUNCH_APP2 , vK_OEM_1 = VK_OEM_1 , vK_OEM_PLUS = VK_OEM_PLUS , vK_OEM_COMMA = VK_OEM_COMMA , vK_OEM_MINUS = VK_OEM_MINUS , vK_OEM_PERIOD = VK_OEM_PERIOD , vK_OEM_2 = VK_OEM_2 , vK_OEM_3 = VK_OEM_3 , vK_OEM_4 = VK_OEM_4 , vK_OEM_5 = VK_OEM_5 , vK_OEM_6 = VK_OEM_6 , vK_OEM_7 = VK_OEM_7 , vK_OEM_8 = VK_OEM_8 , vK_OEM_102 = VK_OEM_102 , vK_PROCESSKEY = VK_PROCESSKEY , vK_PACKET = VK_PACKET , vK_ATTN = VK_ATTN , vK_CRSEL = VK_CRSEL , vK_EXSEL = VK_EXSEL , vK_EREOF = VK_EREOF , vK_PLAY = VK_PLAY , vK_ZOOM = VK_ZOOM , vK_NONAME = VK_NONAME , vK_PA1 = VK_PA1 , vK_OEM_CLEAR = VK_OEM_CLEAR } foreign import WINDOWS_CCONV unsafe "windows.h VkKeyScanExW" c_VkKeyScanEx :: CWchar -> HKL -> IO SHORT foreign import WINDOWS_CCONV unsafe "windows.h MapVirtualKeyW" c_MapVirtualKey :: VKey -> UINT -> IO UINT foreign import WINDOWS_CCONV unsafe "windows.h MapVirtualKeyExW" c_MapVirtualKeyEx :: VKey -> UINT -> HKL -> IO UINT foreign import WINDOWS_CCONV unsafe "windows.h EnableWindow" enableWindow :: HWND -> Bool -> IO Bool getActiveWindow :: IO (Maybe HWND) getActiveWindow = liftM ptrToMaybe c_GetActiveWindow foreign import WINDOWS_CCONV unsafe "windows.h GetActiveWindow" c_GetActiveWindow :: IO HWND foreign import WINDOWS_CCONV unsafe "windows.h GetAsyncKeyState" getAsyncKeyState :: Int -> IO WORD getFocus :: IO (Maybe HWND) getFocus = liftM ptrToMaybe c_GetFocus foreign import WINDOWS_CCONV unsafe "windows.h GetFocus" c_GetFocus :: IO HWND foreign import WINDOWS_CCONV unsafe "windows.h GetKBCodePage" getKBCodePage :: IO UINT foreign import WINDOWS_CCONV unsafe "windows.h IsWindowEnabled" isWindowEnabled :: HWND -> IO Bool getCurrentKeyboardLayout :: IO HKL getCurrentKeyboardLayout = do tid <- getCurrentThreadId c_GetKeyboardLayout tid getKeyboardLayoutList :: IO [HKL] getKeyboardLayoutList = do len' <- failIfZero "GetKeyboardLayoutList" $ c_GetKeyboardLayoutList 0 nullPtr let len = fromIntegral len' allocaArray len $ \buf -> do _ <- failIfZero "GetKeyboardLayoutList" $ c_GetKeyboardLayoutList len buf peekArray len buf getKeyboardLayoutName :: IO String getKeyboardLayoutName = withTStringBuffer 256 $ \buf -> do failIfFalse_ "GetKeyboardLayoutName" $ c_GetKeyboardLayoutName buf peekTString buf withLoadKeyboardLayout :: KeyLayoutFlags -> (HKL -> IO a) -> IO a withLoadKeyboardLayout flag io = withTStringBuffer 256 $ \buf -> do failIfFalse_ "GetKeyboardLayoutName" $ c_GetKeyboardLayoutName buf bracket (c_LoadKeyboardLayout buf flag) unloadKeyboardLayout io withLoadKeyboardLayoutWithName :: String -> KeyLayoutFlags -> (HKL -> IO a) -> IO a withLoadKeyboardLayoutWithName str flag io = withTString str $ \c_str -> bracket (c_LoadKeyboardLayout c_str flag) unloadKeyboardLayout io unloadKeyboardLayout :: HKL -> IO () unloadKeyboardLayout = failIfFalse_ "UnloadKeyboardLayout" . c_UnloadKeyboardLayout foreign import WINDOWS_CCONV unsafe "windows.h GetKeyboardLayout" c_GetKeyboardLayout :: TID -> IO HKL foreign import WINDOWS_CCONV unsafe "windows.h GetKeyboardLayoutList" c_GetKeyboardLayoutList :: Int -> (Ptr HKL) -> IO UINT foreign import WINDOWS_CCONV unsafe "windows.h GetKeyboardLayoutNameW" c_GetKeyboardLayoutName :: LPTSTR -> IO BOOL foreign import WINDOWS_CCONV unsafe "windows.h LoadKeyboardLayoutW" c_LoadKeyboardLayout :: LPCTSTR -> KeyLayoutFlags -> IO HKL foreign import WINDOWS_CCONV unsafe "windows.h UnloadKeyboardLayout" c_UnloadKeyboardLayout :: HKL -> IO BOOL type HKL = Ptr () type KeyLayoutFlags = UINT #{enum KeyLayoutFlags, , kLF_ACTIVATE = KLF_ACTIVATE , kLF_NOTELLSHELL = KLF_NOTELLSHELL , kLF_REORDER = KLF_REORDER , kLF_REPLACELANG = KLF_REPLACELANG , kLF_SUBSTITUTE_OK = KLF_SUBSTITUTE_OK , kLF_SETFORPROCESS = KLF_SETFORPROCESS }