{-# LINE 1 "Graphics\\Win32\\Window.hsc" #-}

{-# LANGUAGE CApiFFI #-}

{-# LANGUAGE NegativeLiterals #-}



{-# LINE 4 "Graphics\\Win32\\Window.hsc" #-}

{-# LANGUAGE Trustworthy #-}



{-# LINE 6 "Graphics\\Win32\\Window.hsc" #-}

-----------------------------------------------------------------------------

-- |

-- Module      :  Graphics.Win32.Window

-- Copyright   :  (c) Alastair Reid, 1997-2003

-- License     :  BSD-style (see the file libraries/base/LICENSE)

--

-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>

-- Stability   :  provisional

-- Portability :  portable

--

-- A collection of FFI declarations for interfacing with Win32.

--

-----------------------------------------------------------------------------



module Graphics.Win32.Window where



import Control.Monad (liftM)

import Data.Maybe (fromMaybe)

import Data.Int (Int32)

import Foreign.ForeignPtr (withForeignPtr)

import Foreign.Marshal.Utils (maybeWith)

import Foreign.Marshal.Alloc (allocaBytes)

import Foreign.Ptr (FunPtr, Ptr, castFunPtrToPtr, castPtr, nullPtr)

import Foreign.Storable (pokeByteOff)

import Foreign.C.Types (CIntPtr(..))

import Graphics.Win32.GDI.Types (HBITMAP, HCURSOR, HDC, HDWP, HRGN, HWND, PRGN)

import Graphics.Win32.GDI.Types (HBRUSH, HICON, HMENU, prim_ChildWindowFromPoint)

import Graphics.Win32.GDI.Types (LPRECT, RECT, allocaRECT, peekRECT, withRECT)

import Graphics.Win32.GDI.Types (POINT, allocaPOINT, peekPOINT, withPOINT)

import Graphics.Win32.GDI.Types (prim_ChildWindowFromPointEx)

import Graphics.Win32.Message (WindowMessage)

import System.IO.Unsafe (unsafePerformIO)

import System.Win32.Types (ATOM, maybePtr, newTString, ptrToMaybe, numToMaybe)

import System.Win32.Types (Addr, BOOL, DWORD, INT, LONG, LRESULT, UINT, WPARAM)

import System.Win32.Types (HINSTANCE, LPARAM, LPCTSTR, LPVOID, withTString)

import System.Win32.Types (failIf, failIf_, failIfFalse_, failIfNull, maybeNum)



#include "windows_cconv.h"







----------------------------------------------------------------

-- Window Class

----------------------------------------------------------------



-- The classname must not be deallocated until the corresponding class

-- is deallocated.  For this reason, we represent classnames by pointers

-- and explicitly allocate the className.



type ClassName   = LPCTSTR



-- Note: this is one of those rare functions which doesnt free all

-- its String arguments.



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



{-# LINE 78 "Graphics\\Win32\\Window.hsc" #-}



type WNDCLASS =

 (ClassStyle,    -- style

  HINSTANCE,     -- hInstance

  Maybe HICON,   -- hIcon

  Maybe HCURSOR, -- hCursor

  Maybe HBRUSH,  -- hbrBackground

  Maybe LPCTSTR, -- lpszMenuName

  ClassName)     -- lpszClassName



--ToDo!

--To avoid confusion with NULL, WNDCLASS requires you to add 1 to a SystemColor

--(which can be NULL)

-- %fun mkMbHBRUSH :: SystemColor -> MbHBRUSH

-- %code

-- %result ((HBRUSH)($0+1));



withWNDCLASS :: WNDCLASS -> (Ptr WNDCLASS -> IO a) -> IO a

withWNDCLASS (style, inst, mb_icon, mb_cursor, mb_bg, mb_menu, cls) f =

  allocaBytes (72) $ \ p -> do

{-# LINE 98 "Graphics\\Win32\\Window.hsc" #-}

  (\hsc_ptr -> pokeByteOff hsc_ptr 0) p style

{-# LINE 99 "Graphics\\Win32\\Window.hsc" #-}

  (\hsc_ptr -> pokeByteOff hsc_ptr 8) p genericWndProc_p

{-# LINE 100 "Graphics\\Win32\\Window.hsc" #-}

  (\hsc_ptr -> pokeByteOff hsc_ptr 16) p (0::INT)

{-# LINE 101 "Graphics\\Win32\\Window.hsc" #-}

  (\hsc_ptr -> pokeByteOff hsc_ptr 20) p (0::INT)

{-# LINE 102 "Graphics\\Win32\\Window.hsc" #-}

  (\hsc_ptr -> pokeByteOff hsc_ptr 24) p inst

{-# LINE 103 "Graphics\\Win32\\Window.hsc" #-}

  (\hsc_ptr -> pokeByteOff hsc_ptr 32) p (maybePtr mb_icon)

{-# LINE 104 "Graphics\\Win32\\Window.hsc" #-}

  (\hsc_ptr -> pokeByteOff hsc_ptr 40) p (maybePtr mb_cursor)

{-# LINE 105 "Graphics\\Win32\\Window.hsc" #-}

  (\hsc_ptr -> pokeByteOff hsc_ptr 48) p (maybePtr mb_bg)

{-# LINE 106 "Graphics\\Win32\\Window.hsc" #-}

  (\hsc_ptr -> pokeByteOff hsc_ptr 56) p (maybePtr mb_menu)

{-# LINE 107 "Graphics\\Win32\\Window.hsc" #-}

  (\hsc_ptr -> pokeByteOff hsc_ptr 64) p cls

{-# LINE 108 "Graphics\\Win32\\Window.hsc" #-}

  f p



foreign import WINDOWS_CCONV unsafe "WndProc.h &genericWndProc"

  genericWndProc_p :: FunPtr WindowClosure



{-# CFILES cbits/WndProc.c #-}



registerClass :: WNDCLASS -> IO (Maybe ATOM)

registerClass cls =

  withWNDCLASS cls $ \ p ->

  liftM numToMaybe $ c_RegisterClass p

foreign import WINDOWS_CCONV unsafe "windows.h RegisterClassW"

  c_RegisterClass :: Ptr WNDCLASS -> IO ATOM



foreign import WINDOWS_CCONV unsafe "windows.h UnregisterClassW"

  unregisterClass :: ClassName -> HINSTANCE -> IO ()



----------------------------------------------------------------

-- Window Style

----------------------------------------------------------------



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



{-# LINE 160 "Graphics\\Win32\\Window.hsc" #-}



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



{-# LINE 186 "Graphics\\Win32\\Window.hsc" #-}





cW_USEDEFAULT :: Pos

-- See Note [Overflow checking and fromIntegral] in Graphics/Win32/GDI/HDC.hs

-- Weird way to essentially get a value with the top bit set. But GHC 7.8.4 was

-- rejecting all other sane attempts.

cW_USEDEFAULT = let val = negate (-2147483648) :: Integer

{-# LINE 193 "Graphics\\Win32\\Window.hsc" #-}

                in fromIntegral (fromIntegral val :: Int32) :: Pos



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 WINDOWS_CCONV "wrapper"

  mkWindowClosure :: WindowClosure -> IO (FunPtr WindowClosure)



setWindowClosure :: HWND -> WindowClosure -> IO ()

setWindowClosure wnd closure = do

  fp <- mkWindowClosure closure

  _ <- c_SetWindowLongPtr wnd (-21)

{-# LINE 211 "Graphics\\Win32\\Window.hsc" #-}

                              (castPtr (castFunPtrToPtr fp))

  return ()



{- Note [SetWindowLongPtrW]

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~



Windows.h defines SetWindowLongPtrW as SetWindowLongW for 32-bit platforms

(i386_HOST_ARCH for our mingw32 environment). Unfortunately since the foreign

import name is given inside of a string, the macro will not be expanded.



Until a better solution is presented each version is provided explicitly here.



-}



{-# LINE 227 "Graphics\\Win32\\Window.hsc" #-}

foreign import WINDOWS_CCONV unsafe "windows.h SetWindowLongPtrW"



{-# LINE 231 "Graphics\\Win32\\Window.hsc" #-}

  c_SetWindowLongPtr :: HWND -> INT -> Ptr LONG -> IO (Ptr LONG)



createWindow

  :: ClassName -> String -> WindowStyle ->

     Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos ->

     Maybe HWND -> Maybe HMENU -> HINSTANCE -> WindowClosure ->

     IO HWND

createWindow = createWindowEx 0

-- apparently CreateWindowA/W are just macros for CreateWindowExA/W



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

  -- Freeing the title/window name has been reported

  -- to cause a crash, so let's not do it.

  -- withTString wname $ \ c_wname -> 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 WINDOWS_CCONV "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 WINDOWS_CCONV "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 WINDOWS_CCONV 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 WINDOWS_CCONV unsafe "windows.h GetWindowRect"

  c_GetWindowRect :: HWND -> Ptr RECT -> IO Bool



-- Should it be Maybe RECT instead?



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 WINDOWS_CCONV "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 WINDOWS_CCONV 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 WINDOWS_CCONV unsafe "windows.h ClientToScreen"

  c_ClientToScreen :: HWND -> Ptr POINT -> IO Bool



----------------------------------------------------------------

-- Setting window text/label

----------------------------------------------------------------

-- For setting the title bar text.  But inconvenient to make the LPCTSTR



setWindowText :: HWND -> String -> IO ()

setWindowText wnd text =

  withTString text $ \ c_text ->

  failIfFalse_ "SetWindowText" $ c_SetWindowText wnd c_text

foreign import WINDOWS_CCONV "windows.h SetWindowTextW"

  c_SetWindowText :: HWND -> LPCTSTR -> IO Bool



----------------------------------------------------------------

-- Paint struct

----------------------------------------------------------------



type PAINTSTRUCT =

 ( HDC   -- hdc

 , Bool  -- fErase

 , RECT  -- rcPaint

 )



type LPPAINTSTRUCT   = Addr



sizeofPAINTSTRUCT :: DWORD

sizeofPAINTSTRUCT = (72)

{-# LINE 341 "Graphics\\Win32\\Window.hsc" #-}



allocaPAINTSTRUCT :: (LPPAINTSTRUCT -> IO a) -> IO a

allocaPAINTSTRUCT = allocaBytes (72)

{-# LINE 344 "Graphics\\Win32\\Window.hsc" #-}



beginPaint :: HWND -> LPPAINTSTRUCT -> IO HDC

beginPaint wnd paint =

  failIfNull "BeginPaint" $ c_BeginPaint wnd paint

foreign import WINDOWS_CCONV "windows.h BeginPaint"

  c_BeginPaint :: HWND -> LPPAINTSTRUCT -> IO HDC



foreign import WINDOWS_CCONV "windows.h EndPaint"

  endPaint :: HWND -> LPPAINTSTRUCT -> IO ()

-- Apparently always succeeds (return non-zero)



----------------------------------------------------------------

-- ShowWindow

----------------------------------------------------------------



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



{-# LINE 374 "Graphics\\Win32\\Window.hsc" #-}



foreign import WINDOWS_CCONV "windows.h ShowWindow"

  showWindow :: HWND  -> ShowWindowControl  -> IO Bool



----------------------------------------------------------------

-- Misc

----------------------------------------------------------------



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 WINDOWS_CCONV 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 WINDOWS_CCONV unsafe "windows.h AdjustWindowRectEx"

  c_AdjustWindowRectEx :: Ptr RECT -> WindowStyle -> Bool -> WindowStyleEx -> IO Bool



-- Win2K and later:

-- %fun AllowSetForegroundWindow :: DWORD -> IO ()



-- %

-- %dis animateWindowType x = dWORD x

-- type AnimateWindowType   = DWORD



-- %const AnimateWindowType

--        [ AW_SLIDE

--        , AW_ACTIVATE

--        , AW_BLEND

--        , AW_HIDE

--        , AW_CENTER

--        , AW_HOR_POSITIVE

--        , AW_HOR_NEGATIVE

--        , AW_VER_POSITIVE

--        , AW_VER_NEGATIVE

--        ]



-- Win98 or Win2K:

-- %fun AnimateWindow :: HWND -> DWORD -> AnimateWindowType -> IO ()

-- %code BOOL success = AnimateWindow(arg1,arg2,arg3)

-- %fail { !success } { ErrorWin("AnimateWindow") }



foreign import WINDOWS_CCONV unsafe "windows.h AnyPopup"

  anyPopup :: IO Bool



arrangeIconicWindows :: HWND -> IO ()

arrangeIconicWindows wnd =

  failIfFalse_ "ArrangeIconicWindows" $ c_ArrangeIconicWindows wnd

foreign import WINDOWS_CCONV unsafe "windows.h ArrangeIconicWindows"

  c_ArrangeIconicWindows :: HWND -> IO Bool



beginDeferWindowPos :: Int -> IO HDWP

beginDeferWindowPos n =

  failIfNull "BeginDeferWindowPos" $ c_BeginDeferWindowPos n

foreign import WINDOWS_CCONV unsafe "windows.h BeginDeferWindowPos"

  c_BeginDeferWindowPos :: Int -> IO HDWP



bringWindowToTop :: HWND -> IO ()

bringWindowToTop wnd =

  failIfFalse_ "BringWindowToTop" $ c_BringWindowToTop wnd

foreign import WINDOWS_CCONV "windows.h BringWindowToTop"

  c_BringWindowToTop :: HWND -> IO Bool



-- Can't pass structs with current FFI, so use a C wrapper (in Types)

childWindowFromPoint :: HWND -> POINT -> IO (Maybe HWND)

childWindowFromPoint wnd pt =

  withPOINT pt $ \ p_pt ->

  liftM ptrToMaybe $ prim_ChildWindowFromPoint wnd p_pt



-- Can't pass structs with current FFI, so use a C wrapper (in Types)

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 WINDOWS_CCONV 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 WINDOWS_CCONV "windows.h DestroyWindow"

  c_DestroyWindow :: HWND -> IO Bool



endDeferWindowPos :: HDWP -> IO ()

endDeferWindowPos pos =

  failIfFalse_ "EndDeferWindowPos" $ c_EndDeferWindowPos pos

foreign import WINDOWS_CCONV unsafe "windows.h EndDeferWindowPos"

  c_EndDeferWindowPos :: HDWP -> IO Bool



findWindow :: Maybe String -> Maybe String -> IO (Maybe HWND)

findWindow cname wname =

  maybeWith withTString cname $ \ c_cname ->

  maybeWith withTString wname $ \ c_wname ->

  liftM ptrToMaybe $ c_FindWindow c_cname c_wname



{-# DEPRECATED findWindowByName "Use 'findWindow Nothing' instead." #-}

findWindowByName :: String -> IO (Maybe HWND)

findWindowByName wname = findWindow Nothing $ Just wname



foreign import WINDOWS_CCONV unsafe "windows.h FindWindowW"

  c_FindWindow :: LPCTSTR -> LPCTSTR -> IO HWND



findWindowEx :: Maybe HWND -> Maybe HWND -> Maybe String -> Maybe String -> IO (Maybe HWND)

findWindowEx parent after cname wname =

  maybeWith withTString cname $ \ c_cname ->

  maybeWith withTString wname $ \ c_wname ->

  liftM ptrToMaybe $ c_FindWindowEx (maybePtr parent) (maybePtr after) c_cname c_wname

foreign import WINDOWS_CCONV unsafe "windows.h FindWindowExW"

  c_FindWindowEx :: HWND -> HWND -> LPCTSTR -> LPCTSTR -> IO HWND



foreign import WINDOWS_CCONV unsafe "windows.h FlashWindow"

  flashWindow :: HWND -> Bool -> IO Bool

-- No error code



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 WINDOWS_CCONV "windows.h MoveWindow"

  c_MoveWindow :: HWND -> Int -> Int -> Int -> Int -> Bool -> IO Bool



foreign import WINDOWS_CCONV unsafe "windows.h GetDesktopWindow"

  getDesktopWindow :: IO HWND



foreign import WINDOWS_CCONV unsafe "windows.h GetForegroundWindow"

  getForegroundWindow :: IO HWND



getParent :: HWND -> IO HWND

getParent wnd =

  failIfNull "GetParent" $ c_GetParent wnd

foreign import WINDOWS_CCONV unsafe "windows.h GetParent"

  c_GetParent :: HWND -> IO HWND



getTopWindow :: HWND -> IO HWND

getTopWindow wnd =

  failIfNull "GetTopWindow" $ c_GetTopWindow wnd

foreign import WINDOWS_CCONV 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



{-# LINE 545 "Graphics\\Win32\\Window.hsc" #-}



----------------------------------------------------------------

-- HDCs

----------------------------------------------------------------



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



{-# LINE 562 "Graphics\\Win32\\Window.hsc" #-}



-- apparently mostly fails if you use invalid hwnds



getDCEx :: HWND -> HRGN -> GetDCExFlags -> IO HDC

getDCEx wnd rgn flags =

  withForeignPtr rgn $ \ p_rgn ->

  failIfNull "GetDCEx" $ c_GetDCEx wnd p_rgn flags

foreign import WINDOWS_CCONV 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 WINDOWS_CCONV 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 WINDOWS_CCONV 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 WINDOWS_CCONV 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 WINDOWS_CCONV unsafe "windows.h GetDCOrgEx"

  c_GetDCOrgEx :: HDC -> Ptr POINT -> IO Bool



----------------------------------------------------------------

-- Caret

----------------------------------------------------------------



hideCaret :: HWND -> IO ()

hideCaret wnd =

  failIfFalse_ "HideCaret" $ c_HideCaret wnd

foreign import WINDOWS_CCONV unsafe "windows.h HideCaret"

  c_HideCaret :: HWND -> IO Bool



showCaret :: HWND -> IO ()

showCaret wnd =

  failIfFalse_ "ShowCaret" $ c_ShowCaret wnd

foreign import WINDOWS_CCONV unsafe "windows.h ShowCaret"

  c_ShowCaret :: HWND -> IO Bool



-- ToDo: allow arg2 to be NULL or {(HBITMAP)1}



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 WINDOWS_CCONV unsafe "windows.h CreateCaret"

  c_CreateCaret :: HWND -> HBITMAP -> INT -> INT -> IO Bool



destroyCaret :: IO ()

destroyCaret =

  failIfFalse_ "DestroyCaret" $ c_DestroyCaret

foreign import WINDOWS_CCONV 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 WINDOWS_CCONV unsafe "windows.h GetCaretPos"

  c_GetCaretPos :: Ptr POINT -> IO Bool



setCaretPos :: POINT -> IO ()

setCaretPos (x,y) =

  failIfFalse_ "SetCaretPos" $ c_SetCaretPos x y

foreign import WINDOWS_CCONV unsafe "windows.h SetCaretPos"

  c_SetCaretPos :: LONG -> LONG -> IO Bool



-- The remarks on SetCaretBlinkTime are either highly risible or very sad -

-- depending on whether you plan to use this function.



----------------------------------------------------------------

-- MSGs and event loops

--

-- Note that the following functions have to be reentrant:

--

--   DispatchMessage

--   SendMessage

--   UpdateWindow   (I think)

--   RedrawWindow   (I think)

--

-- The following dont have to be reentrant (according to documentation)

--

--   GetMessage

--   PeekMessage

--   TranslateMessage

--

-- For Hugs (and possibly NHC too?) this is no big deal.

-- For GHC, you have to use casm_GC instead of casm.

-- (It might be simpler to just put all this code in another

-- file and build it with the appropriate command line option...)

----------------------------------------------------------------



-- type MSG =

--   ( HWND   -- hwnd;

--   , UINT   -- message;

--   , WPARAM -- wParam;

--   , LPARAM -- lParam;

--   , DWORD  -- time;

--   , POINT  -- pt;

--   )



type LPMSG   = Addr



allocaMessage :: (LPMSG -> IO a) -> IO a

allocaMessage = allocaBytes (48)

{-# LINE 681 "Graphics\\Win32\\Window.hsc" #-}



-- A NULL window requests messages for any window belonging to this thread.

-- a "success" value of 0 indicates that WM_QUIT was received



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 WINDOWS_CCONV "windows.h GetMessageW"

  c_GetMessage :: LPMSG -> HWND -> UINT -> UINT -> IO LONG



-- A NULL window requests messages for any window belonging to this thread.

-- Arguably the code block shouldn't be a 'safe' one, but it shouldn't really

-- hurt.



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 WINDOWS_CCONV "windows.h PeekMessageW"

  c_PeekMessage :: LPMSG -> HWND -> UINT -> UINT -> UINT -> IO LONG



-- Note: you're not supposed to call this if you're using accelerators



foreign import WINDOWS_CCONV "windows.h TranslateMessage"

  translateMessage :: LPMSG -> IO BOOL



updateWindow :: HWND -> IO ()

updateWindow wnd =

  failIfFalse_ "UpdateWindow" $ c_UpdateWindow wnd

foreign import WINDOWS_CCONV "windows.h UpdateWindow"

  c_UpdateWindow :: HWND -> IO Bool



-- Return value of DispatchMessage is usually ignored



foreign import WINDOWS_CCONV "windows.h DispatchMessageW"

  dispatchMessage :: LPMSG -> IO LONG



foreign import WINDOWS_CCONV "windows.h SendMessageW"

  sendMessage :: HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT



----------------------------------------------------------------



-- ToDo: figure out reentrancy stuff

-- ToDo: catch error codes

--

-- ToDo: how to send HWND_BROADCAST to PostMessage

-- %fun PostMessage       :: MbHWND -> WindowMessage -> WPARAM -> LPARAM -> IO ()

-- %fun PostQuitMessage   :: Int -> IO ()

-- %fun PostThreadMessage :: DWORD -> WindowMessage -> WPARAM -> LPARAM -> IO ()

-- %fun InSendMessage     :: IO Bool



----------------------------------------------------------------

-- End

----------------------------------------------------------------