dist-install\build\Graphics\Win32\Window.hs

    {-# LINE 1 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
    {-# LANGUAGE CApiFFI #-}
    {-# LANGUAGE NegativeLiterals #-}

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

    {-# LINE 6 "libraries\\Win32\\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.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"

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

    ----------------------------------------------------------------
    -- 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 77 "libraries\\Win32\\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 97 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 0) p style
    {-# LINE 98 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 8) p genericWndProc_p
    {-# LINE 99 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 16) p (0::INT)
    {-# LINE 100 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 20) p (0::INT)
    {-# LINE 101 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 24) p inst
    {-# LINE 102 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 32) p (maybePtr mb_icon)
    {-# LINE 103 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 40) p (maybePtr mb_cursor)
    {-# LINE 104 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 48) p (maybePtr mb_bg)
    {-# LINE 105 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 56) p (maybePtr mb_menu)
    {-# LINE 106 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 64) p cls
    {-# LINE 107 "libraries\\Win32\\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 159 "libraries\\Win32\\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 185 "libraries\\Win32\\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 192 "libraries\\Win32\\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 210 "libraries\\Win32\\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 226 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
    foreign import WINDOWS_CCONV unsafe "windows.h SetWindowLongPtrW"

    {-# LINE 230 "libraries\\Win32\\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 340 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}

    allocaPAINTSTRUCT :: (LPPAINTSTRUCT -> IO a) -> IO a
    allocaPAINTSTRUCT = allocaBytes (72)
    {-# LINE 343 "libraries\\Win32\\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 373 "libraries\\Win32\\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 :: String -> String -> IO (Maybe HWND)
    findWindow cname wname =
      withTString cname $ \ c_cname ->
      withTString wname $ \ c_wname ->
      liftM ptrToMaybe $ c_FindWindow c_cname c_wname

    findWindowByName :: String -> IO (Maybe HWND)
    findWindowByName wname = withTString wname $ \ c_wname ->
      liftM ptrToMaybe $ c_FindWindow nullPtr c_wname

    foreign import WINDOWS_CCONV 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 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 544 "libraries\\Win32\\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 561 "libraries\\Win32\\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 680 "libraries\\Win32\\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
    ----------------------------------------------------------------