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

{-# LANGUAGE CPP #-}

{- |

   Module      :  Graphics.Win32.LayeredWindow

   Copyright   :  2012-2013 shelarcy

   License     :  BSD-style



   Maintainer  :  shelarcy@gmail.com

   Stability   :  Provisional

   Portability :  Non-portable (Win32 API)



   Provides LayeredWindow functionality.

-}

module Graphics.Win32.LayeredWindow where

import Control.Monad   ( void )

import Data.Bits       ( (.|.) )

import Foreign.Ptr     ( Ptr )

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

import Foreign.Marshal.Utils ( with )

import Graphics.Win32.GDI.AlphaBlend ( BLENDFUNCTION )

import Graphics.Win32.GDI.Types      ( COLORREF, HDC, SIZE, SIZE, POINT )

import Graphics.Win32.Window         ( WindowStyleEx, c_SetWindowLongPtr,  )

import System.Win32.Types ( DWORD, HANDLE, BYTE, BOOL,

                            LONG_PTR, INT )





#include "windows_cconv.h"





toLayeredWindow :: HANDLE -> IO ()

toLayeredWindow w = do

  flg <- c_GetWindowLongPtr w gWL_EXSTYLE

  void $ with (fromIntegral $ flg .|. (fromIntegral wS_EX_LAYERED)) $ c_SetWindowLongPtr w gWL_EXSTYLE



-- test w =  c_SetLayeredWindowAttributes w 0 128 lWA_ALPHA



gWL_EXSTYLE :: INT

gWL_EXSTYLE = -20

{-# LINE 38 "Graphics\\Win32\\LayeredWindow.hsc" #-}



wS_EX_LAYERED :: WindowStyleEx

wS_EX_LAYERED = 524288

{-# LINE 41 "Graphics\\Win32\\LayeredWindow.hsc" #-}



lWA_COLORKEY, lWA_ALPHA :: DWORD

lWA_COLORKEY = 1

{-# LINE 44 "Graphics\\Win32\\LayeredWindow.hsc" #-}

lWA_ALPHA    = 2

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



foreign import WINDOWS_CCONV unsafe "windows.h SetLayeredWindowAttributes"

  c_SetLayeredWindowAttributes :: HANDLE -> COLORREF -> BYTE -> DWORD -> IO BOOL



foreign import WINDOWS_CCONV unsafe "windows.h GetLayeredWindowAttributes"

  c_GetLayeredWindowAttributes :: HANDLE -> COLORREF -> Ptr BYTE -> Ptr DWORD -> IO BOOL



foreign import WINDOWS_CCONV unsafe "windows.h UpdateLayeredWindow"

  c_UpdateLayeredWindow :: HANDLE -> HDC -> Ptr POINT -> Ptr SIZE ->  HDC -> Ptr POINT -> COLORREF -> Ptr BLENDFUNCTION -> DWORD -> IO BOOL





{-# LINE 56 "Graphics\\Win32\\LayeredWindow.hsc" #-}

foreign import WINDOWS_CCONV "windows.h GetWindowLongPtrW"

  c_GetWindowLongPtr :: HANDLE -> INT -> IO LONG_PTR



{-# LINE 62 "Graphics\\Win32\\LayeredWindow.hsc" #-}



uLW_ALPHA     :: DWORD

uLW_ALPHA     =  2

uLW_COLORKEY  :: DWORD

uLW_COLORKEY  =  1

uLW_OPAQUE    :: DWORD

uLW_OPAQUE    =  4



{-# LINE 68 "Graphics\\Win32\\LayeredWindow.hsc" #-}