module Graphics.Win32.Window where
import System.Win32.Types
import Graphics.Win32.GDI.Types
import Graphics.Win32.Message
import Control.Monad
import Data.Maybe
import Foreign hiding (unsafePerformIO)
import System.IO.Unsafe
type ClassName = LPCTSTR
mkClassName :: String -> ClassName
mkClassName name = unsafePerformIO (newTString name)
type ClassStyle = UINT
cS_VREDRAW :: ClassStyle
cS_VREDRAW = 1
cS_HREDRAW :: ClassStyle
cS_HREDRAW = 2
cS_OWNDC :: ClassStyle
cS_OWNDC = 32
cS_CLASSDC :: ClassStyle
cS_CLASSDC = 64
cS_PARENTDC :: ClassStyle
cS_PARENTDC = 128
cS_SAVEBITS :: ClassStyle
cS_SAVEBITS = 2048
cS_DBLCLKS :: ClassStyle
cS_DBLCLKS = 8
cS_BYTEALIGNCLIENT :: ClassStyle
cS_BYTEALIGNCLIENT = 4096
cS_BYTEALIGNWINDOW :: ClassStyle
cS_BYTEALIGNWINDOW = 8192
cS_NOCLOSE :: ClassStyle
cS_NOCLOSE = 512
cS_GLOBALCLASS :: ClassStyle
cS_GLOBALCLASS = 16384
type WNDCLASS =
(ClassStyle,
HINSTANCE,
Maybe HICON,
Maybe HCURSOR,
Maybe HBRUSH,
Maybe LPCTSTR,
ClassName)
--ToDo!
withWNDCLASS :: WNDCLASS -> (Ptr WNDCLASS -> IO a) -> IO a
withWNDCLASS (style, inst, mb_icon, mb_cursor, mb_bg, mb_menu, cls) f =
allocaBytes (40) $ \ p -> do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) p style
(\hsc_ptr -> pokeByteOff hsc_ptr 4) p genericWndProc_p
(\hsc_ptr -> pokeByteOff hsc_ptr 8) p (0::INT)
(\hsc_ptr -> pokeByteOff hsc_ptr 12) p (0::INT)
(\hsc_ptr -> pokeByteOff hsc_ptr 16) p inst
(\hsc_ptr -> pokeByteOff hsc_ptr 20) p (maybePtr mb_icon)
(\hsc_ptr -> pokeByteOff hsc_ptr 24) p (maybePtr mb_cursor)
(\hsc_ptr -> pokeByteOff hsc_ptr 28) p (maybePtr mb_bg)
(\hsc_ptr -> pokeByteOff hsc_ptr 32) p (maybePtr mb_menu)
(\hsc_ptr -> pokeByteOff hsc_ptr 36) p cls
f p
foreign import stdcall unsafe "WndProc.h &genericWndProc"
genericWndProc_p :: FunPtr WindowClosure
registerClass :: WNDCLASS -> IO (Maybe ATOM)
registerClass cls =
withWNDCLASS cls $ \ p ->
liftM numToMaybe $ c_RegisterClass p
foreign import stdcall unsafe "windows.h RegisterClassW"
c_RegisterClass :: Ptr WNDCLASS -> IO ATOM
foreign import stdcall unsafe "windows.h UnregisterClassW"
unregisterClass :: ClassName -> HINSTANCE -> IO ()
type WindowStyle = DWORD
wS_OVERLAPPED :: WindowStyle
wS_OVERLAPPED = 0
wS_POPUP :: WindowStyle
wS_POPUP = 2147483648
wS_CHILD :: WindowStyle
wS_CHILD = 1073741824
wS_CLIPSIBLINGS :: WindowStyle
wS_CLIPSIBLINGS = 67108864
wS_CLIPCHILDREN :: WindowStyle
wS_CLIPCHILDREN = 33554432
wS_VISIBLE :: WindowStyle
wS_VISIBLE = 268435456
wS_DISABLED :: WindowStyle
wS_DISABLED = 134217728
wS_MINIMIZE :: WindowStyle
wS_MINIMIZE = 536870912
wS_MAXIMIZE :: WindowStyle
wS_MAXIMIZE = 16777216
wS_CAPTION :: WindowStyle
wS_CAPTION = 12582912
wS_BORDER :: WindowStyle
wS_BORDER = 8388608
wS_DLGFRAME :: WindowStyle
wS_DLGFRAME = 4194304
wS_VSCROLL :: WindowStyle
wS_VSCROLL = 2097152
wS_HSCROLL :: WindowStyle
wS_HSCROLL = 1048576
wS_SYSMENU :: WindowStyle
wS_SYSMENU = 524288
wS_THICKFRAME :: WindowStyle
wS_THICKFRAME = 262144
wS_MINIMIZEBOX :: WindowStyle
wS_MINIMIZEBOX = 131072
wS_MAXIMIZEBOX :: WindowStyle
wS_MAXIMIZEBOX = 65536
wS_GROUP :: WindowStyle
wS_GROUP = 131072
wS_TABSTOP :: WindowStyle
wS_TABSTOP = 65536
wS_OVERLAPPEDWINDOW :: WindowStyle
wS_OVERLAPPEDWINDOW = 13565952
wS_POPUPWINDOW :: WindowStyle
wS_POPUPWINDOW = 2156396544
wS_CHILDWINDOW :: WindowStyle
wS_CHILDWINDOW = 1073741824
wS_TILED :: WindowStyle
wS_TILED = 0
wS_ICONIC :: WindowStyle
wS_ICONIC = 536870912
wS_SIZEBOX :: WindowStyle
wS_SIZEBOX = 262144
wS_TILEDWINDOW :: WindowStyle
wS_TILEDWINDOW = 13565952
type WindowStyleEx = DWORD
wS_EX_DLGMODALFRAME :: WindowStyleEx
wS_EX_DLGMODALFRAME = 1
wS_EX_NOPARENTNOTIFY :: WindowStyleEx
wS_EX_NOPARENTNOTIFY = 4
wS_EX_TOPMOST :: WindowStyleEx
wS_EX_TOPMOST = 8
wS_EX_ACCEPTFILES :: WindowStyleEx
wS_EX_ACCEPTFILES = 16
wS_EX_TRANSPARENT :: WindowStyleEx
wS_EX_TRANSPARENT = 32
wS_EX_MDICHILD :: WindowStyleEx
wS_EX_MDICHILD = 64
wS_EX_TOOLWINDOW :: WindowStyleEx
wS_EX_TOOLWINDOW = 128
wS_EX_WINDOWEDGE :: WindowStyleEx
wS_EX_WINDOWEDGE = 256
wS_EX_CLIENTEDGE :: WindowStyleEx
wS_EX_CLIENTEDGE = 512
wS_EX_CONTEXTHELP :: WindowStyleEx
wS_EX_CONTEXTHELP = 1024
wS_EX_RIGHT :: WindowStyleEx
wS_EX_RIGHT = 4096
wS_EX_LEFT :: WindowStyleEx
wS_EX_LEFT = 0
wS_EX_RTLREADING :: WindowStyleEx
wS_EX_RTLREADING = 8192
wS_EX_LTRREADING :: WindowStyleEx
wS_EX_LTRREADING = 0
wS_EX_LEFTSCROLLBAR :: WindowStyleEx
wS_EX_LEFTSCROLLBAR = 16384
wS_EX_RIGHTSCROLLBAR :: WindowStyleEx
wS_EX_RIGHTSCROLLBAR = 0
wS_EX_CONTROLPARENT :: WindowStyleEx
wS_EX_CONTROLPARENT = 65536
wS_EX_STATICEDGE :: WindowStyleEx
wS_EX_STATICEDGE = 131072
wS_EX_APPWINDOW :: WindowStyleEx
wS_EX_APPWINDOW = 262144
wS_EX_OVERLAPPEDWINDOW :: WindowStyleEx
wS_EX_OVERLAPPEDWINDOW = 768
wS_EX_PALETTEWINDOW :: WindowStyleEx
wS_EX_PALETTEWINDOW = 392
cW_USEDEFAULT :: Pos
cW_USEDEFAULT = 2147483648
type Pos = Int
type MbPos = Maybe Pos
maybePos :: Maybe Pos -> Pos
maybePos = fromMaybe cW_USEDEFAULT
type WindowClosure = HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT
foreign import stdcall "wrapper"
mkWindowClosure :: WindowClosure -> IO (FunPtr WindowClosure)
setWindowClosure :: HWND -> WindowClosure -> IO ()
setWindowClosure wnd closure = do
fp <- mkWindowClosure closure
_ <- c_SetWindowLong wnd (21) (castFunPtrToLONG fp)
return ()
foreign import stdcall unsafe "windows.h SetWindowLongW"
c_SetWindowLong :: HWND -> INT -> LONG -> IO LONG
createWindow
:: ClassName -> String -> WindowStyle ->
Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos ->
Maybe HWND -> Maybe HMENU -> HINSTANCE -> WindowClosure ->
IO HWND
createWindow = createWindowEx 0
createWindowEx
:: WindowStyle -> ClassName -> String -> WindowStyle
-> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos
-> Maybe HWND -> Maybe HMENU -> HINSTANCE -> WindowClosure
-> IO HWND
createWindowEx estyle cname wname wstyle mb_x mb_y mb_w mb_h mb_parent mb_menu inst closure = do
c_wname <- newTString wname
wnd <- failIfNull "CreateWindowEx" $
c_CreateWindowEx estyle cname c_wname wstyle
(maybePos mb_x) (maybePos mb_y) (maybePos mb_w) (maybePos mb_h)
(maybePtr mb_parent) (maybePtr mb_menu) inst nullPtr
setWindowClosure wnd closure
return wnd
foreign import stdcall "windows.h CreateWindowExW"
c_CreateWindowEx
:: WindowStyle -> ClassName -> LPCTSTR -> WindowStyle
-> Pos -> Pos -> Pos -> Pos
-> HWND -> HMENU -> HINSTANCE -> LPVOID
-> IO HWND
defWindowProc :: Maybe HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT
defWindowProc mb_wnd msg w l =
c_DefWindowProc (maybePtr mb_wnd) msg w l
foreign import stdcall "windows.h DefWindowProcW"
c_DefWindowProc :: HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT
getClientRect :: HWND -> IO RECT
getClientRect wnd =
allocaRECT $ \ p_rect -> do
failIfFalse_ "GetClientRect" $ c_GetClientRect wnd p_rect
peekRECT p_rect
foreign import stdcall unsafe "windows.h GetClientRect"
c_GetClientRect :: HWND -> Ptr RECT -> IO Bool
getWindowRect :: HWND -> IO RECT
getWindowRect wnd =
allocaRECT $ \ p_rect -> do
failIfFalse_ "GetWindowRect" $ c_GetWindowRect wnd p_rect
peekRECT p_rect
foreign import stdcall unsafe "windows.h GetWindowRect"
c_GetWindowRect :: HWND -> Ptr RECT -> IO Bool
invalidateRect :: Maybe HWND -> Maybe LPRECT -> Bool -> IO ()
invalidateRect wnd p_mb_rect erase =
failIfFalse_ "InvalidateRect" $
c_InvalidateRect (maybePtr wnd) (maybePtr p_mb_rect) erase
foreign import stdcall "windows.h InvalidateRect"
c_InvalidateRect :: HWND -> LPRECT -> Bool -> IO Bool
screenToClient :: HWND -> POINT -> IO POINT
screenToClient wnd pt =
withPOINT pt $ \ p_pt -> do
failIfFalse_ "ScreenToClient" $ c_ScreenToClient wnd p_pt
peekPOINT p_pt
foreign import stdcall unsafe "windows.h ScreenToClient"
c_ScreenToClient :: HWND -> Ptr POINT -> IO Bool
clientToScreen :: HWND -> POINT -> IO POINT
clientToScreen wnd pt =
withPOINT pt $ \ p_pt -> do
failIfFalse_ "ClientToScreen" $ c_ClientToScreen wnd p_pt
peekPOINT p_pt
foreign import stdcall unsafe "windows.h ClientToScreen"
c_ClientToScreen :: HWND -> Ptr POINT -> IO Bool
setWindowText :: HWND -> String -> IO ()
setWindowText wnd text =
withTString text $ \ c_text ->
failIfFalse_ "SetWindowText" $ c_SetWindowText wnd c_text
foreign import stdcall "windows.h SetWindowTextW"
c_SetWindowText :: HWND -> LPCTSTR -> IO Bool
type PAINTSTRUCT =
( HDC
, Bool
, RECT
)
type LPPAINTSTRUCT = Addr
sizeofPAINTSTRUCT :: DWORD
sizeofPAINTSTRUCT = (64)
allocaPAINTSTRUCT :: (LPPAINTSTRUCT -> IO a) -> IO a
allocaPAINTSTRUCT = allocaBytes (64)
beginPaint :: HWND -> LPPAINTSTRUCT -> IO HDC
beginPaint wnd paint =
failIfNull "BeginPaint" $ c_BeginPaint wnd paint
foreign import stdcall "windows.h BeginPaint"
c_BeginPaint :: HWND -> LPPAINTSTRUCT -> IO HDC
foreign import stdcall "windows.h EndPaint"
endPaint :: HWND -> LPPAINTSTRUCT -> IO ()
type ShowWindowControl = DWORD
sW_HIDE :: ShowWindowControl
sW_HIDE = 0
sW_SHOWNORMAL :: ShowWindowControl
sW_SHOWNORMAL = 1
sW_SHOWMINIMIZED :: ShowWindowControl
sW_SHOWMINIMIZED = 2
sW_SHOWMAXIMIZED :: ShowWindowControl
sW_SHOWMAXIMIZED = 3
sW_MAXIMIZE :: ShowWindowControl
sW_MAXIMIZE = 3
sW_SHOWNOACTIVATE :: ShowWindowControl
sW_SHOWNOACTIVATE = 4
sW_SHOW :: ShowWindowControl
sW_SHOW = 5
sW_MINIMIZE :: ShowWindowControl
sW_MINIMIZE = 6
sW_SHOWMINNOACTIVE :: ShowWindowControl
sW_SHOWMINNOACTIVE = 7
sW_SHOWNA :: ShowWindowControl
sW_SHOWNA = 8
sW_RESTORE :: ShowWindowControl
sW_RESTORE = 9
foreign import stdcall "windows.h ShowWindow"
showWindow :: HWND -> ShowWindowControl -> IO Bool
adjustWindowRect :: RECT -> WindowStyle -> Bool -> IO RECT
adjustWindowRect rect style menu =
withRECT rect $ \ p_rect -> do
failIfFalse_ "AdjustWindowRect" $ c_AdjustWindowRect p_rect style menu
peekRECT p_rect
foreign import stdcall unsafe "windows.h AdjustWindowRect"
c_AdjustWindowRect :: Ptr RECT -> WindowStyle -> Bool -> IO Bool
adjustWindowRectEx :: RECT -> WindowStyle -> Bool -> WindowStyleEx -> IO RECT
adjustWindowRectEx rect style menu exstyle =
withRECT rect $ \ p_rect -> do
failIfFalse_ "AdjustWindowRectEx" $
c_AdjustWindowRectEx p_rect style menu exstyle
peekRECT p_rect
foreign import stdcall unsafe "windows.h AdjustWindowRectEx"
c_AdjustWindowRectEx :: Ptr RECT -> WindowStyle -> Bool -> WindowStyleEx -> IO Bool
foreign import stdcall unsafe "windows.h AnyPopup"
anyPopup :: IO Bool
arrangeIconicWindows :: HWND -> IO ()
arrangeIconicWindows wnd =
failIfFalse_ "ArrangeIconicWindows" $ c_ArrangeIconicWindows wnd
foreign import stdcall unsafe "windows.h ArrangeIconicWindows"
c_ArrangeIconicWindows :: HWND -> IO Bool
beginDeferWindowPos :: Int -> IO HDWP
beginDeferWindowPos n =
failIfNull "BeginDeferWindowPos" $ c_BeginDeferWindowPos n
foreign import stdcall unsafe "windows.h BeginDeferWindowPos"
c_BeginDeferWindowPos :: Int -> IO HDWP
bringWindowToTop :: HWND -> IO ()
bringWindowToTop wnd =
failIfFalse_ "BringWindowToTop" $ c_BringWindowToTop wnd
foreign import stdcall "windows.h BringWindowToTop"
c_BringWindowToTop :: HWND -> IO Bool
childWindowFromPoint :: HWND -> POINT -> IO (Maybe HWND)
childWindowFromPoint wnd pt =
withPOINT pt $ \ p_pt ->
liftM ptrToMaybe $ prim_ChildWindowFromPoint wnd p_pt
childWindowFromPointEx :: HWND -> POINT -> DWORD -> IO (Maybe HWND)
childWindowFromPointEx parent pt flags =
withPOINT pt $ \ p_pt ->
liftM ptrToMaybe $ prim_ChildWindowFromPointEx parent p_pt flags
closeWindow :: HWND -> IO ()
closeWindow wnd =
failIfFalse_ "CloseWindow" $ c_DestroyWindow wnd
deferWindowPos :: HDWP -> HWND -> HWND -> Int -> Int -> Int -> Int -> SetWindowPosFlags -> IO HDWP
deferWindowPos wp wnd after x y cx cy flags =
failIfNull "DeferWindowPos" $ c_DeferWindowPos wp wnd after x y cx cy flags
foreign import stdcall unsafe "windows.h DeferWindowPos"
c_DeferWindowPos :: HDWP -> HWND -> HWND -> Int -> Int -> Int -> Int -> SetWindowPosFlags -> IO HDWP
destroyWindow :: HWND -> IO ()
destroyWindow wnd =
failIfFalse_ "DestroyWindow" $ c_DestroyWindow wnd
foreign import stdcall "windows.h DestroyWindow"
c_DestroyWindow :: HWND -> IO Bool
endDeferWindowPos :: HDWP -> IO ()
endDeferWindowPos pos =
failIfFalse_ "EndDeferWindowPos" $ c_EndDeferWindowPos pos
foreign import stdcall unsafe "windows.h EndDeferWindowPos"
c_EndDeferWindowPos :: HDWP -> IO Bool
findWindow :: String -> String -> IO (Maybe HWND)
findWindow cname wname =
withTString cname $ \ c_cname ->
withTString wname $ \ c_wname ->
liftM ptrToMaybe $ c_FindWindow c_cname c_wname
foreign import stdcall unsafe "windows.h FindWindowW"
c_FindWindow :: LPCTSTR -> LPCTSTR -> IO HWND
findWindowEx :: HWND -> HWND -> String -> String -> IO (Maybe HWND)
findWindowEx parent after cname wname =
withTString cname $ \ c_cname ->
withTString wname $ \ c_wname ->
liftM ptrToMaybe $ c_FindWindowEx parent after c_cname c_wname
foreign import stdcall unsafe "windows.h FindWindowExW"
c_FindWindowEx :: HWND -> HWND -> LPCTSTR -> LPCTSTR -> IO HWND
foreign import stdcall unsafe "windows.h FlashWindow"
flashWindow :: HWND -> Bool -> IO Bool
moveWindow :: HWND -> Int -> Int -> Int -> Int -> Bool -> IO ()
moveWindow wnd x y w h repaint =
failIfFalse_ "MoveWindow" $ c_MoveWindow wnd x y w h repaint
foreign import stdcall "windows.h MoveWindow"
c_MoveWindow :: HWND -> Int -> Int -> Int -> Int -> Bool -> IO Bool
foreign import stdcall unsafe "windows.h GetDesktopWindow"
getDesktopWindow :: IO HWND
foreign import stdcall unsafe "windows.h GetForegroundWindow"
getForegroundWindow :: IO HWND
getParent :: HWND -> IO HWND
getParent wnd =
failIfNull "GetParent" $ c_GetParent wnd
foreign import stdcall unsafe "windows.h GetParent"
c_GetParent :: HWND -> IO HWND
getTopWindow :: HWND -> IO HWND
getTopWindow wnd =
failIfNull "GetTopWindow" $ c_GetTopWindow wnd
foreign import stdcall unsafe "windows.h GetTopWindow"
c_GetTopWindow :: HWND -> IO HWND
type SetWindowPosFlags = UINT
sWP_NOSIZE :: SetWindowPosFlags
sWP_NOSIZE = 1
sWP_NOMOVE :: SetWindowPosFlags
sWP_NOMOVE = 2
sWP_NOZORDER :: SetWindowPosFlags
sWP_NOZORDER = 4
sWP_NOREDRAW :: SetWindowPosFlags
sWP_NOREDRAW = 8
sWP_NOACTIVATE :: SetWindowPosFlags
sWP_NOACTIVATE = 16
sWP_FRAMECHANGED :: SetWindowPosFlags
sWP_FRAMECHANGED = 32
sWP_SHOWWINDOW :: SetWindowPosFlags
sWP_SHOWWINDOW = 64
sWP_HIDEWINDOW :: SetWindowPosFlags
sWP_HIDEWINDOW = 128
sWP_NOCOPYBITS :: SetWindowPosFlags
sWP_NOCOPYBITS = 256
sWP_NOOWNERZORDER :: SetWindowPosFlags
sWP_NOOWNERZORDER = 512
sWP_NOSENDCHANGING :: SetWindowPosFlags
sWP_NOSENDCHANGING = 1024
sWP_DRAWFRAME :: SetWindowPosFlags
sWP_DRAWFRAME = 32
sWP_NOREPOSITION :: SetWindowPosFlags
sWP_NOREPOSITION = 512
type GetDCExFlags = DWORD
dCX_WINDOW :: GetDCExFlags
dCX_WINDOW = 1
dCX_CACHE :: GetDCExFlags
dCX_CACHE = 2
dCX_CLIPCHILDREN :: GetDCExFlags
dCX_CLIPCHILDREN = 8
dCX_CLIPSIBLINGS :: GetDCExFlags
dCX_CLIPSIBLINGS = 16
dCX_PARENTCLIP :: GetDCExFlags
dCX_PARENTCLIP = 32
dCX_EXCLUDERGN :: GetDCExFlags
dCX_EXCLUDERGN = 64
dCX_INTERSECTRGN :: GetDCExFlags
dCX_INTERSECTRGN = 128
dCX_LOCKWINDOWUPDATE :: GetDCExFlags
dCX_LOCKWINDOWUPDATE = 1024
getDCEx :: HWND -> HRGN -> GetDCExFlags -> IO HDC
getDCEx wnd rgn flags =
withForeignPtr rgn $ \ p_rgn ->
failIfNull "GetDCEx" $ c_GetDCEx wnd p_rgn flags
foreign import stdcall unsafe "windows.h GetDCEx"
c_GetDCEx :: HWND -> PRGN -> GetDCExFlags -> IO HDC
getDC :: Maybe HWND -> IO HDC
getDC mb_wnd =
failIfNull "GetDC" $ c_GetDC (maybePtr mb_wnd)
foreign import stdcall unsafe "windows.h GetDC"
c_GetDC :: HWND -> IO HDC
getWindowDC :: Maybe HWND -> IO HDC
getWindowDC mb_wnd =
failIfNull "GetWindowDC" $ c_GetWindowDC (maybePtr mb_wnd)
foreign import stdcall unsafe "windows.h GetWindowDC"
c_GetWindowDC :: HWND -> IO HDC
releaseDC :: Maybe HWND -> HDC -> IO ()
releaseDC mb_wnd dc =
failIfFalse_ "ReleaseDC" $ c_ReleaseDC (maybePtr mb_wnd) dc
foreign import stdcall unsafe "windows.h ReleaseDC"
c_ReleaseDC :: HWND -> HDC -> IO Bool
getDCOrgEx :: HDC -> IO POINT
getDCOrgEx dc =
allocaPOINT $ \ p_pt -> do
failIfFalse_ "GetDCOrgEx" $ c_GetDCOrgEx dc p_pt
peekPOINT p_pt
foreign import stdcall unsafe "windows.h GetDCOrgEx"
c_GetDCOrgEx :: HDC -> Ptr POINT -> IO Bool
hideCaret :: HWND -> IO ()
hideCaret wnd =
failIfFalse_ "HideCaret" $ c_HideCaret wnd
foreign import stdcall unsafe "windows.h HideCaret"
c_HideCaret :: HWND -> IO Bool
showCaret :: HWND -> IO ()
showCaret wnd =
failIfFalse_ "ShowCaret" $ c_ShowCaret wnd
foreign import stdcall unsafe "windows.h ShowCaret"
c_ShowCaret :: HWND -> IO Bool
createCaret :: HWND -> HBITMAP -> Maybe INT -> Maybe INT -> IO ()
createCaret wnd bm mb_w mb_h =
failIfFalse_ "CreateCaret" $
c_CreateCaret wnd bm (maybeNum mb_w) (maybeNum mb_h)
foreign import stdcall unsafe "windows.h CreateCaret"
c_CreateCaret :: HWND -> HBITMAP -> INT -> INT -> IO Bool
destroyCaret :: IO ()
destroyCaret =
failIfFalse_ "DestroyCaret" $ c_DestroyCaret
foreign import stdcall unsafe "windows.h DestroyCaret"
c_DestroyCaret :: IO Bool
getCaretPos :: IO POINT
getCaretPos =
allocaPOINT $ \ p_pt -> do
failIfFalse_ "GetCaretPos" $ c_GetCaretPos p_pt
peekPOINT p_pt
foreign import stdcall unsafe "windows.h GetCaretPos"
c_GetCaretPos :: Ptr POINT -> IO Bool
setCaretPos :: POINT -> IO ()
setCaretPos (x,y) =
failIfFalse_ "SetCaretPos" $ c_SetCaretPos x y
foreign import stdcall unsafe "windows.h SetCaretPos"
c_SetCaretPos :: LONG -> LONG -> IO Bool
type LPMSG = Addr
allocaMessage :: (LPMSG -> IO a) -> IO a
allocaMessage = allocaBytes (28)
getMessage :: LPMSG -> Maybe HWND -> IO Bool
getMessage msg mb_wnd = do
res <- failIf (== 1) "GetMessage" $
c_GetMessage msg (maybePtr mb_wnd) 0 0
return (res /= 0)
foreign import stdcall "windows.h GetMessageW"
c_GetMessage :: LPMSG -> HWND -> UINT -> UINT -> IO LONG
peekMessage :: LPMSG -> Maybe HWND -> UINT -> UINT -> UINT -> IO ()
peekMessage msg mb_wnd filterMin filterMax remove = do
failIf_ (== 1) "PeekMessage" $
c_PeekMessage msg (maybePtr mb_wnd) filterMin filterMax remove
foreign import stdcall "windows.h PeekMessageW"
c_PeekMessage :: LPMSG -> HWND -> UINT -> UINT -> UINT -> IO LONG
foreign import stdcall "windows.h TranslateMessage"
translateMessage :: LPMSG -> IO BOOL
updateWindow :: HWND -> IO ()
updateWindow wnd =
failIfFalse_ "UpdateWindow" $ c_UpdateWindow wnd
foreign import stdcall "windows.h UpdateWindow"
c_UpdateWindow :: HWND -> IO Bool
foreign import stdcall "windows.h DispatchMessageW"
dispatchMessage :: LPMSG -> IO LONG
foreign import stdcall "windows.h SendMessageW"
sendMessage :: HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT