{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}
module Graphics.Win32Extras where

import Graphics.Win32
import System.Win32.DLL
import Data.Int
import Data.Word
import Data.Bits
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Alloc
import Foreign.C.Types
import Data.IORef
import System.IO.Unsafe
import Control.Monad
import Control.Monad.Loops
import Codec.BMP

foreign import stdcall "windows.h GetWindowTextW" c_GetWindowText :: HWND -> LPTSTR -> Int32 -> IO LRESULT

-- | A wrapper for 'c_GetWindowText' which fails if the string is too long.
getWindowText wnd = do
	fp <- mallocForeignPtrBytes 1024
	withForeignPtr fp $ \p -> do
		pokeByteOff p 1021 '\0'
		failIfZero "GetWindowText" $ c_GetWindowText wnd p 1024
		ch :: Word8 <- peekByteOff p 1021
		failIf_ id "GetWindowText" $ return $ ch /= 0 -- Test if string was truncated
		peekTString p

foreign import stdcall "windows.h GetClassNameW" c_GetClassName :: HWND -> LPTSTR -> Int32 -> IO LRESULT

getClassName wnd = do
	fp <- mallocForeignPtrBytes 1024
	withForeignPtr fp $ \p -> do
		pokeByteOff p 1021 '\0'
		failIfZero "GetClassName" $ c_GetClassName wnd p 1024
		ch :: Word8 <- peekByteOff p 1021
		failIf_ id "GetClassName" $ return $ ch /= 0 -- Test if string was truncated
		peekTString p

foreign import stdcall "windows.h SetFocus" setFocus :: HWND -> IO HWND

------------------------------
-- Drawing

foreign import stdcall unsafe "windows.h SetPixel" set :: HDC -> Int32 -> Int32 -> COLORREF -> IO COLORREF

dT_TOP :: Word32
dT_TOP = 0

dT_LEFT :: Word32
dT_LEFT = 0

dT_CENTER :: Word32
dT_CENTER = 1

dT_RIGHT :: Word32
dT_RIGHT = 2

dT_VCENTER :: Word32
dT_VCENTER = 4

dT_BOTTOM :: Word32
dT_BOTTOM = 8

dT_WORDBREAK :: Word32
dT_WORDBREAK = 16

dT_SINGLELINE :: Word32
dT_SINGLELINE = 32

dT_EXPANDTABS :: Word32
dT_EXPANDTABS = 64

dT_TABSTOP :: Word32
dT_TABSTOP = 128

dT_NOCLIP :: Word32
dT_NOCLIP = 256

dT_EXTERNALLEADING :: Word32
dT_EXTERNALLEADING = 512

dT_CALCRECT :: Word32
dT_CALCRECT = 1024

dT_NOPREFIX :: Word32
dT_NOPREFIX = 2048

dT_INTERNAL :: Word32
dT_INTERNAL = 4096

dT_EDITCONTROL :: Word32
dT_EDITCONTROL = 8192

dT_PATH_ELLIPSIS :: Word32
dT_PATH_ELLIPSIS = 16384

dT_END_ELLIPSIS :: Word32
dT_END_ELLIPSIS = 32768

dT_MODIFYSTRING :: Word32
dT_MODIFYSTRING = 65536

dT_RTLREADING :: Word32
dT_RTLREADING = 131072

dT_WORD_ELLIPSIS :: Word32
dT_WORD_ELLIPSIS = 262144

dT_NOFULLWIDTHCHARBREAK :: Word32
dT_NOFULLWIDTHCHARBREAK = 524288

dT_HIDEPREFIX :: Word32
dT_HIDEPREFIX = 1048576

dT_PREFIXONLY :: Word32
dT_PREFIXONLY = 2097152

foreign import stdcall "windows.h DrawTextW" c_DrawText :: HDC -> LPTSTR -> Int32 -> LPRECT -> UINT -> IO Int32

drawText dc s rt format = withTString s $ \ps ->
	withRECT rt $ \pr ->
	failIfZero "DrawText" $ c_DrawText dc ps (-1) pr format

foreign import stdcall "windows.h SetDIBitsToDevice"
	c_SetDIBitsToDevice :: HDC -> Int32 -> Int32 -> Word32 -> Word32 -> Int32 -> Int32 -> Word32 -> Word32 -> Ptr CChar -> LPBITMAPINFO -> Word32 -> IO Int32

withBITMAP :: BitmapInfo -> (Ptr () -> IO a) -> IO a
withBITMAP (InfoV3 bi) f = do
	fp <- mallocForeignPtrBytes 40
	withForeignPtr fp $ \p -> do
		pokeByteOff p 0 (dib3Size bi)
		pokeByteOff p 4 (dib3Width bi)
		pokeByteOff p 8 (dib3Height bi)
		pokeByteOff p 12 (dib3Planes bi)
		pokeByteOff p 14 (dib3BitCount bi)
		pokeByteOff p 16 bI_RGB
		pokeByteOff p 20 (dib3ImageSize bi)
		pokeByteOff p 24 (dib3PelsPerMeterX bi)
		pokeByteOff p 28 (dib3PelsPerMeterY bi)
		pokeByteOff p 32 (dib3ColorsUsed bi)
		pokeByteOff p 36 (dib3ColorsImportant bi)
		f p

type XFORM = Ptr ()

foreign import stdcall "windows.h SetWorldTransform" setWorldTransform :: HDC -> XFORM -> IO Bool

withXFORM :: (Float, Float, Float, Float, Float, Float) -> (XFORM -> IO t) -> IO t
withXFORM (eM11, eM12, eM21, eM22, eDx, eDy) f = do
	fp <- mallocForeignPtrBytes 24
	withForeignPtr fp $ \p -> do
		pokeByteOff p 0 eM11
		pokeByteOff p 4 eM12
		pokeByteOff p 8 eM21
		pokeByteOff p 12 eM22
		pokeByteOff p 16 eDx
		pokeByteOff p 20 eDy
		f p

oDT_BUTTON :: Word32
oDT_BUTTON = 4

oDA_DRAWENTIRE :: Word32
oDA_DRAWENTIRE = 1

oDA_SELECT :: Word32
oDA_SELECT = 2

oDA_FOCUS :: Word32
oDA_FOCUS = 4

oDS_SELECTED :: Word32
oDS_SELECTED = 1

oDS_DISABLED :: Word32
oDS_DISABLED = 4

oDS_FOCUS :: Word32
oDS_FOCUS = 16

foreign import stdcall "windows.h DrawFocusRect" c_DrawFocusRect :: HDC -> LPRECT -> IO Bool

drawFocusRect dc rt = withRECT rt $ c_DrawFocusRect dc

foreign import stdcall "windows.h SetWindowPos" c_SetWindowPos :: HWND -> HWND -> LONG -> LONG -> LONG -> LONG -> Word32 -> IO Bool

setWindowPos hwnd hwndAfter x y wd ht flags = failIfFalse_ "SetWindowPos" $ c_SetWindowPos hwnd hwndAfter x y wd ht flags

foreign import stdcall "windows.h SetWindowLongW" setWindowLong :: HWND -> LONG -> LONG -> IO LONG

------------------------------
-- Scroll bars

foreign import stdcall "windows.h SetScrollInfo" c_SetScrollInfo :: HWND -> Int32 -> Ptr SCROLLINFO -> BOOL -> IO BOOL

foreign import stdcall "windows.h GetScrollInfo" c_GetScrollInfo :: HWND -> Int32 -> Ptr SCROLLINFO -> IO Int32

setScrollInfo wnd bar si = withSCROLLINFO si $ \p -> c_SetScrollInfo wnd bar p True

getScrollInfo wnd bar = withSCROLLINFO (SCROLLINFO sIF_ALL 0 0 0 0 0) $ \p -> do
	c_GetScrollInfo wnd bar p
	readSCROLLINFO p

data SCROLLINFO = SCROLLINFO { fMask :: Word32, nMin :: Int32, nMax :: Int32, nPage :: Word32, nPos :: Int32, nTrackPos :: Int32 } deriving (Eq, Show)

withSCROLLINFO :: SCROLLINFO -> (Ptr SCROLLINFO -> IO t) -> IO t
withSCROLLINFO si f = do
	fp <- mallocForeignPtrBytes 28
	withForeignPtr fp $ \p -> do 
		pokeByteOff p 0 (28 :: Word32)
		pokeByteOff p 4 (fMask si)
		pokeByteOff p 8 (nMin si)
		pokeByteOff p 12 (nMax si)
		pokeByteOff p 16 (nPage si)
		pokeByteOff p 20 (nPos si)
		pokeByteOff p 24 (nTrackPos si)
		f p

readSCROLLINFO :: Ptr SCROLLINFO -> IO SCROLLINFO
readSCROLLINFO p = do
	fMask <- peekByteOff p 4
	nMin <- peekByteOff p 8
	nMax <- peekByteOff p 12
	nPage <- peekByteOff p 16
	nPos <- peekByteOff p 20
	nTrackPos <- peekByteOff p 24
	return (SCROLLINFO fMask nMin nMax nPage nPos nTrackPos)

sB_HORZ :: Int32
sB_HORZ = 0

sB_VERT :: Int32
sB_VERT = 1

sB_CTL :: Word32
sB_CTL = 2

sIF_ALL :: Word32
sIF_ALL = 31

sB_PAGEDOWN :: Word32
sB_PAGEDOWN = 3

sB_PAGEUP :: Word32 
sB_PAGEUP = 2

sB_LINEUP :: Word32
sB_LINEUP = 0

sB_LINEDOWN :: Word32
sB_LINEDOWN = 1

sB_BOTTOM :: Word32
sB_BOTTOM = 7

sB_TOP :: Word32
sB_TOP = 6

sB_THUMBPOSITION :: Word32
sB_THUMBPOSITION = 4

sB_THUMBTRACK :: Word32
sB_THUMBTRACK = 5

loWord x = x .&. 65535

hiWord x = shiftR x 16

foreign import stdcall "windows.h CallWindowProcW" callWindowProc :: FunPtr WindowClosure -> HWND -> UINT -> WPARAM -> LPARAM -> IO LRESULT

gWLP_WNDPROC :: Int32
gWLP_WNDPROC = -4

gWLP_WNDPARENT :: Int32
gWLP_WNDPARENT = -8

gWLP_ID :: Int32
gWLP_ID = -12

gWLP_USERDATA :: Int32
gWLP_USERDATA = -21

gWLP_STYLE :: Int32
gWLP_STYLE = -16

cB_ADDSTRING :: Word32
cB_ADDSTRING = 323

cB_GETCURSEL :: Word32
cB_GETCURSEL = 327

cB_SETCURSEL :: Word32
cB_SETCURSEL = 334

-- ...

sIF_RANGE :: Word32
sIF_RANGE = 1

sIF_POS :: Word32
sIF_POS = 2

sIF_PAGE :: Word32
sIF_PAGE = 4

--------------------------------
-- System colors

foreign import stdcall "windows.h GetSysColorBrush" getSysColorBrush :: Word32 -> IO HBRUSH

foreign import stdcall "windows.h GetSysColor" getSysColor :: Word32 -> IO Word32

foreign import stdcall "windows.h GetDeviceCaps" getDeviceCaps :: HDC -> Int32 -> IO Int32

lOGPIXELSX :: Int32
lOGPIXELSX = 88

lOGPIXELSY :: Int32
lOGPIXELSY = 90

dLGC_WANTCHARS :: Int32
dLGC_WANTCHARS = 128

dLGC_WANTARROWS :: Int32
dLGC_WANTARROWS = 1

dLGC_DEFPUSHBUTTON :: Int32
dLGC_DEFPUSHBUTTON = 16

wM_CTLCOLORBTN :: Word32
wM_CTLCOLORBTN = 309

wM_CTLCOLORSTATIC :: Word32
wM_CTLCOLORSTATIC = 312

------------------------------
-- Threads

foreign import stdcall "windows.h GetCurrentThreadId" getCurrentThreadId :: IO DWORD

foreign import stdcall "windows.h PostThreadMessageW" postThreadMessage :: DWORD -> UINT -> WPARAM -> LPARAM -> IO Bool

foreign import stdcall "windows.h MsgWaitForMultipleObjects" c_MsgWaitForMultipleObjects :: DWORD -> Ptr HANDLE -> Bool -> DWORD -> DWORD -> IO DWORD

msgWaitForMultipleObjects :: [HANDLE] -> Bool -> DWORD -> DWORD -> IO DWORD
msgWaitForMultipleObjects handles b n1 n2 = do
	fp <- mallocForeignPtrBytes (4 * length handles)
	withForeignPtr fp $ \p -> do
		mapM_ (\(n, hdl) -> pokeByteOff p n hdl) (zip [0,4..] handles)
		c_MsgWaitForMultipleObjects (fromIntegral $ length handles) p b n1 n2

wAIT_TIMEOUT :: DWORD
wAIT_TIMEOUT = 258

pM_NOREMOVE :: DWORD
pM_NOREMOVE = 0

pM_REMOVE :: DWORD
pM_REMOVE = 1

pM_NOYIELD :: DWORD
pM_NOYIELD = 2

qS_ALLEVENTS :: DWORD
qS_ALLEVENTS = 1215

------------------------------
-- Common dialog boxes

foreign import stdcall "windows.h ChooseColorW" c_ChooseColor :: Ptr () -> IO Bool

cC_ANYCOLOR :: Word32
cC_ANYCOLOR = 256

cC_FULLOPEN :: Word32
cC_FULLOPEN = 2

cC_PREVENTFULLOPEN :: Word32
cC_PREVENTFULLOPEN = 4

cC_RGBINIT :: Word32
cC_RGBINIT = 1

cC_SHOWHELP :: Word32
cC_SHOWHELP = 8

cC_SOLIDCOLOR :: Word32
cC_SOLIDCOLOR = 128

type CHOOSECOLOR = ()

foreign import ccall "wrapper" mkFinalizer :: (Ptr a -> IO ()) -> IO (FinalizerPtr a)

allocaChooseColor :: Word32 -> Word32 -> IO (ForeignPtr CHOOSECOLOR)
allocaChooseColor clr flags = do
	hdl <- getModuleHandle Nothing
	cc <- mallocForeignPtrBytes 36
	p2 <- mallocBytes 64
	withForeignPtr cc $ \p -> do
		pokeByteOff p 0 (36 :: Word32)
		pokeByteOff p 4 (0 :: Word32)
		pokeByteOff p 8 hdl
		pokeByteOff p 12 clr
		pokeByteOff p 16 p2
		pokeByteOff p 20 flags
		pokeByteOff p 24 (0 :: Word32)
		pokeByteOff p 28 (0 :: Word32)
		pokeByteOff p 32 (0 :: Word32)
	fin <- mkFinalizer (\_ -> free p2)
	addForeignPtrFinalizer fin cc
	return cc

-- | Open a choose colour dialog. Use 'allocaChooseColor' to create the parameter structure.
chooseColor :: HWND -> ForeignPtr CHOOSECOLOR -> IO (Maybe COLORREF)
chooseColor wnd fp = do
	withForeignPtr fp $ \p -> do
		b <- c_ChooseColor p
		if b then do
				clr <- peekByteOff p 12
				return (Just clr)
			else
				return Nothing

type OPENFILENAME = ()

foreign import stdcall "windows.h GetOpenFileNameW" getOpenFileName :: Ptr OPENFILENAME -> IO Bool

foreign import stdcall "windows.h GetSaveFileNameW" getSaveFileName :: Ptr OPENFILENAME -> IO Bool

oFN_ALLOWMULTISELECT :: Word32
oFN_ALLOWMULTISELECT = 512

oFN_CREATEPROMPT :: Word32
oFN_CREATEPROMPT = 8192

oFN_DONTADDTORECENT :: Word32
oFN_DONTADDTORECENT =  33554432

oFN_EXPLORER :: Word32
oFN_EXPLORER = 524288

oFN_FILEMUSTEXIST :: Word32
oFN_FILEMUSTEXIST = 4096

oFN_HIDEREADONLY :: Word32
oFN_HIDEREADONLY = 4

oFN_OVERWRITEPROMPT :: Word32
oFN_OVERWRITEPROMPT = 2
--etc..

data Action = Open | Save deriving Eq

-- | Open or save a file.
fileOpenOrSave :: Action -> HWND -> String -> String -> IO (Maybe String)
fileOpenOrSave action wnd filter extension = do
	hdl <- getModuleHandle Nothing
	fp <- mallocForeignPtrBytes 76
	fp2 <- mallocForeignPtrBytes 1000
	withForeignPtr fp $ \p ->
		withForeignPtr fp2 $ \p2 ->
		withTString filter $ \flt ->
		withTString extension $ \ext -> do
		pokeByteOff p2 0 (0 :: Word16)
		pokeByteOff p 0 (76 :: Word32)
		pokeByteOff p 4 wnd
		pokeByteOff p 8 hdl
		pokeByteOff p 12 flt
		pokeByteOff p 16 nullPtr
		pokeByteOff p 24 (1 :: Word32)
		pokeByteOff p 28 p2
		pokeByteOff p 32 (1000 :: Word32)
		pokeByteOff p 36 nullPtr
		pokeByteOff p 44 nullPtr
		pokeByteOff p 48 nullPtr
		pokeByteOff p 52 (oFN_EXPLORER .|. if action == Open then oFN_FILEMUSTEXIST else oFN_OVERWRITEPROMPT)
		pokeByteOff p 60 ext
		b <- (if action == Open then getOpenFileName else getSaveFileName) p
		if b then do
				liftM Just (peekTString p2)
			else
				return Nothing

fileOpen = fileOpenOrSave Open

fileSave = fileOpenOrSave Save

-- | Display a message box. This fixes the Win32 package MessageBox.
messageBox' :: HWND -> String -> String -> MBStyle -> IO MBStatus
messageBox' wnd text caption style =
  withTString text $ \ c_text ->
  withTString caption $ \ c_caption ->
  failIfZero "MessageBox" $ c_MessageBox' wnd c_text c_caption style
foreign import stdcall safe "windows.h MessageBoxW"
  c_MessageBox' :: HWND -> LPCTSTR -> LPCTSTR -> MBStyle -> IO MBStatus

------------------------------
-- Printing

foreign import stdcall "windows.h GlobalUnlock" globalUnlock' :: HANDLE -> IO Bool

foreign import stdcall "windows.h OpenPrinterW" openPrinter :: LPTSTR -> Ptr HANDLE -> Ptr () -> IO Bool

foreign import stdcall "windows.h DocumentPropertiesW" documentProperties :: HWND -> HANDLE -> LPTSTR -> Ptr () -> Ptr () -> Word32 -> IO LONG

foreign import stdcall "windows.h CreateDCW" createDC :: LPCTSTR -> LPCTSTR -> LPCSTR -> Ptr () -> IO HDC

foreign import stdcall "windows.h StartDocW" startDoc :: HDC -> Ptr () -> IO Int32

foreign import stdcall "windows.h EndDoc" endDoc :: HDC -> IO Int32

foreign import stdcall "windows.h StartPage" startPage :: HDC -> IO Int32

foreign import stdcall "windows.h EndPage" endPage :: HDC -> IO Int32

foreign import stdcall "windows.h ClosePrinter" closePrinter :: HANDLE -> IO Bool

foreign import stdcall "windows.h GetDefaultPrinterW" getDefaultPrinter :: LPTSTR -> Ptr DWORD -> IO Bool

dM_OUT_BUFFER :: Word32
dM_OUT_BUFFER = 2

dM_IN_PROMPT :: Word32
dM_IN_PROMPT = 4
-- etc..

foreign import stdcall "windows.h PostMessageW" postMessage :: HWND -> WindowMessage -> WPARAM -> LPARAM -> IO Bool

eN_GETSEL :: Word32
eN_GETSEL = 176

eN_SETSEL :: Word32
eN_SETSEL = 177

eN_UPDATE :: Word32
eN_UPDATE = 1024

cBN_EDITUPDATE :: Word32
cBN_EDITUPDATE = 6

cBN_SELENDOK :: Word32
cBN_SELENDOK = 9

lBN_SELCHANGE :: Word32
lBN_SELCHANGE = 1

bN_PUSHED :: Word32
bN_PUSHED = 2

bN_CLICKED :: Word32
bN_CLICKED = 0

hTBOTTOM :: Word32
hTBOTTOM = 15

hTBOTTOMLEFT :: Word32
hTBOTTOMLEFT = 16

hTBOTTOMRIGHT :: Word32
hTBOTTOMRIGHT = 17

hTCAPTION :: Word32
hTCAPTION = 2

hTLEFT :: Word32
hTLEFT = 10

hTRIGHT :: Word32
hTRIGHT = 11

hTTOP :: Word32
hTTOP = 12

hTTOPLEFT :: Word32
hTTOPLEFT = 13

hTTOPRIGHT :: Word32
hTTOPRIGHT = 14

hTCLOSE :: Word32
hTCLOSE = 20

hTMAXBUTTON :: Word32
hTMAXBUTTON = 9

hTMINBUTTON :: Word32
hTMINBUTTON = 8

foreign import stdcall "windows.h SetCapture" setCapture :: HWND -> IO HWND

foreign import stdcall "windows.h ReleaseCapture" releaseCapture :: IO Bool

sS_OWNERDRAW :: Word32
sS_OWNERDRAW = 13

foreign import stdcall "windows.h EnableWindow"
  enableWindow' :: HWND -> Bool -> IO Bool

------------------------------
-- Menus

-- | Fixes TrackPopupMenu to supply the selection as a return value.
foreign import stdcall "windows.h TrackPopupMenu" trackPopupMenu' :: HMENU -> UINT -> LONG -> LONG -> LONG -> HWND -> Ptr RECT -> IO LONG

------------------------------
-- Common controls

wC_LISTVIEW = "SysListView32"

lVS_REPORT :: Word32
lVS_REPORT = 1

lVS_SINGLESEL :: Word32
lVS_SINGLESEL = 4

wC_TREEVIEW = "SysTreeView32"

lVM_FIRST :: Word32
lVM_FIRST = 4096

lVM_GETITEMCOUNT = lVM_FIRST + 4

lVM_DELETEITEM = lVM_FIRST + 8

lVM_INSERTITEM = lVM_FIRST + 77

lVM_GETITEMSTATE = lVM_FIRST + 44

lVM_GETITEMTEXT = lVM_FIRST + 45

lVM_SETITEMTEXT = lVM_FIRST + 116

lVM_GETCOLUMN = lVM_FIRST + 95

lVM_DELETECOLUMN = lVM_FIRST + 28

lVM_INSERTCOLUMN = lVM_FIRST + 97

lVM_SETCOLUMN = lVM_FIRST + 26

lVIF_STATE :: Word32
lVIF_STATE = 8

lVIF_TEXT :: Word32
lVIF_TEXT = 1

lVCF_TEXT :: Word32
lVCF_TEXT = 4

lVCF_WIDTH :: Word32
lVCF_WIDTH = 2

lVIS_SELECTED :: Word32
lVIS_SELECTED = 2

tVM_FIRST :: Word32
tVM_FIRST = 4352

tVM_INSERTITEM = tVM_FIRST + 50

tVM_DELETEITEM = tVM_FIRST + 1

tVM_GETNEXTITEM = tVM_FIRST + 10

tVM_GETITEM = tVM_FIRST + 62

tVM_SETITEM = tVM_FIRST + 63

tVGN_NEXT :: Word32
tVGN_NEXT = 1

tVGN_CHILD :: Word32
tVGN_CHILD = 4

tVIF_TEXT :: Word32
tVIF_TEXT = 1

tVIF_HANDLE :: Word32
tVIF_HANDLE = 16

tVS_HASLINES :: Word32
tVS_HASLINES = 2

foreign import stdcall "windows.h InitCommonControls" initCommonControls :: IO ()

foreign import stdcall "windows.h TranslateAccelerator" translateAccelerator :: HGLOBAL -> HWND -> LPMSG -> IO Bool

foreign import stdcall "windows.h GetWindowLongW" c_GetWindowLong :: HWND -> LONG -> IO LONG

type LPCTBBUTTON = Ptr ()

tb_addbuttons_size :: UINT
tb_addbuttons_size = 20

tB_ADDBITMAP :: UINT
tB_ADDBITMAP = wM_USER + 19

tB_ADDBUTTONSA :: UINT
tB_ADDBUTTONSA = wM_USER + 20

tB_INSERTBUTTONA :: UINT
tB_INSERTBUTTONA = wM_USER + 21

tB_DELETEBUTTON :: UINT
tB_DELETEBUTTON = wM_USER + 22

tB_REPLACEBITMAP :: UINT
tB_REPLACEBITMAP = wM_USER + 46

tB_BUTTONSTRUCTSIZE :: UINT
tB_BUTTONSTRUCTSIZE = wM_USER + 30

tB_SETBUTTONSIZE :: UINT
tB_SETBUTTONSIZE = wM_USER + 31

tB_SETBITMAPSIZE  :: UINT
tB_SETBITMAPSIZE = wM_USER + 32

tB_AUTOSIZE :: UINT
tB_AUTOSIZE = wM_USER + 33

tB_BUTTONCOUNT :: UINT
tB_BUTTONCOUNT = wM_USER + 24

tB_SETIMAGELIST :: UINT
tB_SETIMAGELIST = wM_USER + 48

tB_GETTOOLTIPS :: UINT
tB_GETTOOLTIPS = wM_USER + 35

tB_SETTOOLTIPS :: UINT
tB_SETTOOLTIPS = wM_USER + 36

foreign import stdcall "mmsystem.h timeBeginPeriod" timeBeginPeriod :: UINT -> IO UINT

foreign import stdcall "mmsystem.h timeEndPeriod" timeEndPeriod :: UINT -> IO UINT

foreign import stdcall "mmsystem.h timeSetEvent" timeSetEvent :: UINT -> UINT -> LPVOID -> UINT -> UINT -> IO UINT

foreign import stdcall "windows.h CreateEventW" createEvent :: LPVOID -> BOOL -> BOOL -> LPTSTR -> IO HANDLE

tIMER_ONESHOT :: UINT
tIMER_ONESHOT = 1

tIMER_PERIODIC :: UINT
tIMER_PERIODIC = 64

tIME_CALLBACK_FUNCTION :: UINT
tIME_CALLBACK_FUNCTION = 0

tIME_CALLBACK_EVENT_SET :: UINT
tIME_CALLBACK_EVENT_SET = 16

tIME_CALLBACK_EVENT_PULSE :: UINT
tIME_CALLBACK_EVENT_PULSE = 32

--- The following functions are utilities, not part of the Win32 API.

-- | Helper to add buttons from a bitmap already present.
{-
addExistingBitmaps :: HWND -> [(LONG, UINT, BYTE)] -> IO ()
addExistingBitmaps toolbar whichbuttons = do
	let nButtons = length whichbuttons
	fp <- mallocForeignPtrBytes (8 `max` (nButtons * tb_addbuttons_size))
	withForeignPtr fp $ \p -> do
		mapM_ (\(i, (n, id, state)) -> do
			pokeByteOff p i n
			pokeByteOff p (i + 4) id
			pokeByteOff p (i + 8) 0
			pokeByteOff (castPtr p) (i + 8) state
			pokeByteOff p (i + 16) 0)
			whichbuttons
		sendMessage toolbar tB_ADDBUTTONSA nButtons (toLPARAM p)
		sendMessage toolbar tB_AUTOSIZE 0 0

addButtonsFromModule :: HINSTANCE -> HWND -> HRESOURCE -> [(LONG, UINT, BYTE)] -> IO ()
addButtonsFromModule mod toolbar bitmap whichbuttons = do
	sendMessage toolbar tB_BUTTONSTRUCTSIZE tb_addbuttons_size 0
	fp <- mallocForeignPtrBytes 8
	withForeignPtr fp $ \p => do
		pokeByteOff p 0 mod
		pokeByteoff p 4 bitmap
		sendMessage toolbar tB_ADDBITMAP (maximum whichbuttons + 1) (toLPARAM p)
	addExistingButtons toolbar whichbuttons	clearToolbar

-- | Add buttons to a toolbar directly out of a resource. The elements of the third
--   parameter indicate for each button, its position in the bitmap, its control ID,
--   and its button state respectively.
addButtons :: HWND -> HRESOURCE -> [(LONG, UINT, BYTE)] -> IO ()
addButtons toolbar bitmap whichbuttons = do
	mod <- getModuleHandle nullPtr
	addButtonsFromModule mod toolbar bitmap whichbuttons

-- | Remove all buttons from a toolbar.
clearToolbar toolbar = whileM_ (return ()) (liftM (/=0) $ sendMessage toolbar tB_DELETEBUTTON 0 0)

-- | Add toolbar buttons from an imagelist. Returns the former imagelist.
setImageList :: HWND -> HIMAGELIST -> [(LONG, UINT, BYTE)] -> IO HIMAGELIST
setImageList toolbar imagelist whichbuttons = do
	sendMessage toolbar tB_BUTTONSTRUCTSIZE tb_addbuttons_size 0
	clearToolbar toolbar
	oldlist <- sendMessage toolbar tS_SETIMAGELIST 0 imagelist
	addExistingButtons toolbar whichbuttons
	return oldlist-}

-- | Create a frame window with reasonable defaults. A null background brush is used to prevent flicker.
frameWindow icon menu parent title closure = do
 	hdl <- getModuleHandle Nothing
	cursor <- loadCursor Nothing iDC_ARROW
	null <- getStockBrush nULL_BRUSH
	let name = mkClassName "Frame"
	registerClass (0, hdl, icon, Just cursor, Just null, Nothing, name)
	createWindowEx 0 name title (wS_OVERLAPPEDWINDOW .|. wS_VISIBLE .|. wS_CLIPCHILDREN) Nothing Nothing Nothing Nothing Nothing menu parent closure