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

-- |

-- 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, when, unless)
import Data.Maybe (fromMaybe)
import Data.Int (Int32)
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Marshal.Utils (maybeWith)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Array (allocaArray)
import Foreign.Ptr (FunPtr, Ptr, castFunPtrToPtr, nullPtr)
import Foreign.Ptr (intPtrToPtr, castPtrToFunPtr, freeHaskellFunPtr,ptrToIntPtr)
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, wM_NCDESTROY)
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 (HANDLE, HINSTANCE, LONG_PTR, LPARAM, LPCTSTR)
import System.Win32.Types (LPTSTR, LPVOID, withTString, peekTString)
import System.Win32.Types (failIf, failIf_, failIfFalse_, failIfNull, maybeNum, failUnlessSuccess, getLastError, errorWin)

#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 doesn't free all

-- its String arguments.


mkClassName :: String -> ClassName
mkClassName name = unsafePerformIO (newTString name)

type ClassStyle   = UINT

cS_VREDRAW            :: ClassStyle
cS_VREDRAW            =  1
cS_VREDRAW :: UINT
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_PARENTDC :: UINT
cS_SAVEBITS           :: ClassStyle
cS_SAVEBITS           =  2048
cS_DBLCLKS            :: ClassStyle
cS_DBLCLKS            =  8
cS_BYTEALIGNCLIENT    :: ClassStyle
cS_BYTEALIGNCLIENT    =  4096
cS_BYTEALIGNCLIENT :: UINT
cS_BYTEALIGNWINDOW    :: ClassStyle
cS_BYTEALIGNWINDOW    =  8192
cS_NOCLOSE            :: ClassStyle
cS_NOCLOSE            =  512
cS_GLOBALCLASS        :: ClassStyle
cS_GLOBALCLASS        =  16384

{-# LINE 78 "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 98 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
  (\hsc_ptr -> pokeByteOff hsc_ptr 0) p style
{-# LINE 99 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
  (\hsc_ptr -> pokeByteOff hsc_ptr 8) p genericWndProc_p
{-# LINE 100 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
  (\hsc_ptr -> pokeByteOff hsc_ptr 16) p (0::INT)
{-# LINE 101 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
  (\hsc_ptr -> pokeByteOff hsc_ptr 20) p (0::INT)
{-# LINE 102 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
  (\hsc_ptr -> pokeByteOff hsc_ptr 24) p inst
{-# LINE 103 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
  (\hsc_ptr -> pokeByteOff hsc_ptr 32) p (maybePtr mb_icon)
{-# LINE 104 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
  (\hsc_ptr -> pokeByteOff hsc_ptr 40) p (maybePtr mb_cursor)
{-# LINE 105 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
  (\hsc_ptr -> pokeByteOff hsc_ptr 48) p (maybePtr mb_bg)
{-# LINE 106 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
  (\hsc_ptr -> pokeByteOff hsc_ptr 56) p (maybePtr mb_menu)
{-# LINE 107 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
  (\hsc_ptr -> pokeByteOff hsc_ptr 64) p cls
{-# LINE 108 "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 160 "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 186 "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 193 "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)

mkCIntPtr :: FunPtr a -> CIntPtr
mkCIntPtr = fromIntegral . ptrToIntPtr . castFunPtrToPtr

-- | The standard C wndproc for every window class registered by

-- 'registerClass' is a C function pointer provided with this library. It in

-- turn delegates to a Haskell function pointer stored in 'gWLP_USERDATA'.

-- This action creates that function pointer. All Haskell function pointers

-- must be freed in order to allow the objects they close over to be garbage

-- collected. Consequently, if you are replacing a window closure previously

-- set via this method or indirectly with 'createWindow' or 'createWindowEx'

-- you must free it. This action returns a function pointer to the old window

-- closure for you to free. The current window closure is freed automatically

-- by 'defWindowProc' when it receives 'wM_NCDESTROY'.

setWindowClosure :: HWND -> WindowClosure -> IO (Maybe (FunPtr WindowClosure))
setWindowClosure wnd closure = do
  fp <- mkWindowClosure closure
  fpOld <- c_SetWindowLongPtr wnd (-21)
{-# LINE 224 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
                              (mkCIntPtr fp)
  if fpOld == 0
     then return Nothing
     else return $ Just $ castPtrToFunPtr $ intPtrToPtr $ fromIntegral fpOld

{- 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 242 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
foreign import WINDOWS_CCONV unsafe "windows.h SetWindowLongPtrW"

{-# LINE 246 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
  c_SetWindowLongPtr :: HWND -> INT -> LONG_PTR -> IO (LONG_PTR)


{-# LINE 251 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
foreign import WINDOWS_CCONV unsafe "windows.h GetWindowLongPtrW"

{-# LINE 255 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
  c_GetWindowLongPtr :: HANDLE -> INT -> IO LONG_PTR


-- | Creates a window with a default extended window style. If you create many

-- windows over the life of your program, WindowClosure may leak memory. Be

-- sure to delegate to 'defWindowProc' for 'wM_NCDESTROY' and see

-- 'defWindowProc' and 'setWindowClosure' for details.

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


-- | Creates a window and allows your to specify the  extended window style. If

-- you create many windows over the life of your program, WindowClosure may

-- leak memory. Be sure to delegate to 'defWindowProc' for 'wM_NCDESTROY' and see

-- 'defWindowProc' and 'setWindowClosure' for details.

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

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


-- | Delegates to the Win32 default window procedure. If you are using a

-- window created by 'createWindow', 'createWindowEx' or on which you have

-- called 'setWindowClosure', please note that the window will leak memory once

-- it is destroyed unless you call 'freeWindowProc' when it receives

-- 'wM_NCDESTROY'. If you wish to do this, instead of using this function

-- directly, you can delegate to 'defWindowProcSafe' which will handle it for

-- you. As an alternative, you can manually retrieve the window closure

-- function pointer and free it after the window has been destroyed. Check the

-- implementation of 'freeWindowProc' for a guide.

defWindowProc :: Maybe HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT
defWindowProc mb_wnd msg w l =
  c_DefWindowProc (maybePtr mb_wnd) msg w l

-- | Delegates to the standard default window procedure, but if it receives the

-- 'wM_NCDESTROY' message it first frees the window closure to allow the

-- closure and any objects it closes over to be garbage collected. 'wM_NCDESTROY' is

-- the last message a window receives prior to being deleted.

defWindowProcSafe :: Maybe HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT
defWindowProcSafe mb_wnd msg w l = do
  when (msg == wM_NCDESTROY) (maybe (return ()) freeWindowProc mb_wnd)
  defWindowProc mb_wnd msg w l

foreign import WINDOWS_CCONV "windows.h DefWindowProcW"
  c_DefWindowProc :: HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT

-- | Frees a function pointer to the window closure which has been set

-- directly by 'setWindowClosure' or indirectly by 'createWindowEx'. You

-- should call this function in your window closure's 'wM_NCDESTROY' case

-- unless you delegate that case to 'defWindowProc' (e.g. as part of the

-- default).

freeWindowProc :: HWND -> IO ()
freeWindowProc hwnd = do
   fp <- c_GetWindowLongPtr hwnd (-21)
{-# LINE 332 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}
   unless (fp == 0) $ 
      freeHaskellFunPtr $ castPtrToFunPtr . intPtrToPtr . fromIntegral $ fp


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


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

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

-- Getting window text/label

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

-- For getting the title bar text. 

-- If the window has no title bar or text, if the title bar is empty,

-- or if the window or control handle is invalid, the return value is zero.

-- If invalid handle throws exception.

-- If size <= 0 throws exception.


getWindowText :: HWND -> Int -> IO String
getWindowText wnd size 
  | size <= 0 = errorWin "GetWindowTextW"
  | otherwise  = do
      allocaArray size $ \ p_buf -> do
      _ <- c_GetWindowText wnd p_buf size
      failUnlessSuccess "GetWindowTextW" getLastError
      peekTString p_buf
foreign import WINDOWS_CCONV "windows.h GetWindowTextW"
  c_GetWindowText :: HWND -> LPTSTR -> Int -> IO Int

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

-- Getting window text length

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

-- For getting the title bar text length. 

-- If the window has no text, the return value is zero.

-- If invalid handle throws exception.

  
getWindowTextLength :: HWND -> IO Int
getWindowTextLength wnd = do
  size' <- c_GetWindowTextLength wnd
  failUnlessSuccess "GetWindowTextLengthW" getLastError
  return size'
foreign import WINDOWS_CCONV "windows.h GetWindowTextLengthW"
  c_GetWindowTextLength :: HWND -> IO Int
  
----------------------------------------------------------------

-- Paint struct

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


type PAINTSTRUCT =
 ( HDC   -- hdc

 , Bool  -- fErase

 , RECT  -- rcPaint

 )

type LPPAINTSTRUCT   = Addr

sizeofPAINTSTRUCT :: DWORD
sizeofPAINTSTRUCT = (72)
{-# LINE 440 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}

allocaPAINTSTRUCT :: (LPPAINTSTRUCT -> IO a) -> IO a
allocaPAINTSTRUCT = allocaBytes (72)
{-# LINE 443 "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 473 "libraries\\Win32\\Graphics\\Win32\\Window.hsc" #-}

foreign import WINDOWS_CCONV "windows.h ShowWindow"
  showWindow :: HWND  -> ShowWindowControl  -> IO Bool

foreign import WINDOWS_CCONV "windows.h IsWindowVisible"
  isWindowVisible :: HWND -> 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 647 "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 664 "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 don't 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 783 "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

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