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

{-# LANGUAGE CPP #-}

{- |

   Module      :  Graphics.Win32.GDI.AlphaBlend

   Copyright   :  2013 shelarcy

   License     :  BSD-style



   Maintainer  :  shelarcy@gmail.com

   Stability   :  Provisional

   Portability :  Non-portable (Win32 API)



   Provides alpha blending  functionality.

-}

module Graphics.Win32.GDI.AlphaBlend where

import Foreign.Storable         ( Storable(..) )

import Foreign.Ptr              ( Ptr )

import Graphics.Win32.GDI.Types ( HDC )

import System.Win32.Types       ( BOOL, BYTE, UINT )







#include "windows_cconv.h"



foreign import ccall unsafe "alphablend.h"

  c_AlphaBlend :: HDC -> Int -> Int -> Int -> Int -> HDC -> Int -> Int -> Int -> Int -> PBLENDFUNCTION -> IO BOOL

{-

We use C wrapper function to call this API.

Because foreign stacall/ccall/capi doesn't work with non-pointer user defined type.



We think that capi should support that when user defined type has Storable class instance

and using CTYPE pragma in the scope.



{-# LANGUAGE CApiFFI #-}



data {-# CTYPE "windows.h" "BLENDFUNCTION" #-} BLENDFUNCTION =



foreign import capi unsafe "windows.h AlphaBlend"

  c_AlphaBlend :: HDC -> Int -> Int -> Int -> Int -> HDC -> Int -> Int -> Int -> Int -> BLENDFUNCTION -> IO BOOL

-}



foreign import WINDOWS_CCONV unsafe "windows.h TransparentBlt"

  c_TransparentBlt :: HDC -> Int -> Int -> Int -> Int -> HDC -> Int -> Int -> Int -> Int -> UINT -> IO BOOL



aC_SRC_OVER :: BYTE

aC_SRC_OVER = 0

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



aC_SRC_ALPHA :: BYTE

aC_SRC_ALPHA = 1

{-# LINE 48 "Graphics\\Win32\\GDI\\AlphaBlend.hsc" #-}



type PBLENDFUNCTION  = Ptr BLENDFUNCTION

type LPBLENDFUNCTION = Ptr BLENDFUNCTION



data BLENDFUNCTION = BLENDFUNCTION

    { blendOp     :: BYTE

    , blendFlags  :: BYTE

    , sourceConstantAlpha :: BYTE

    , alphaFormat :: BYTE

    } deriving (Show)



instance Storable BLENDFUNCTION where

    sizeOf = const (4)

{-# LINE 61 "Graphics\\Win32\\GDI\\AlphaBlend.hsc" #-}

    alignment _ = 1

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

    poke buf func = do

        ((\hsc_ptr -> pokeByteOff hsc_ptr 0))     buf (blendOp func)

{-# LINE 64 "Graphics\\Win32\\GDI\\AlphaBlend.hsc" #-}

        ((\hsc_ptr -> pokeByteOff hsc_ptr 1))  buf (blendFlags func)

{-# LINE 65 "Graphics\\Win32\\GDI\\AlphaBlend.hsc" #-}

        ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) buf (sourceConstantAlpha func)

{-# LINE 66 "Graphics\\Win32\\GDI\\AlphaBlend.hsc" #-}

        ((\hsc_ptr -> pokeByteOff hsc_ptr 3)) buf (alphaFormat func)

{-# LINE 67 "Graphics\\Win32\\GDI\\AlphaBlend.hsc" #-}



    peek buf = do

        blendOp'     <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) buf

{-# LINE 70 "Graphics\\Win32\\GDI\\AlphaBlend.hsc" #-}

        blendFlags'  <- ((\hsc_ptr -> peekByteOff hsc_ptr 1)) buf

{-# LINE 71 "Graphics\\Win32\\GDI\\AlphaBlend.hsc" #-}

        sourceConstantAlpha' <-

            ((\hsc_ptr -> peekByteOff hsc_ptr 2)) buf

{-# LINE 73 "Graphics\\Win32\\GDI\\AlphaBlend.hsc" #-}

        alphaFormat' <- ((\hsc_ptr -> peekByteOff hsc_ptr 3)) buf

{-# LINE 74 "Graphics\\Win32\\GDI\\AlphaBlend.hsc" #-}

        return $ BLENDFUNCTION blendOp' blendFlags' sourceConstantAlpha' alphaFormat'