1{-# LANGUAGE CPP #-}
2{- |
3   Module      :  Graphics.Win32.GDI.AlphaBlend
4   Copyright   :  2013 shelarcy
5   License     :  BSD-style
6
7   Maintainer  :  shelarcy@gmail.com
8   Stability   :  Provisional
9   Portability :  Non-portable (Win32 API)
10
11   Provides alpha blending  functionality.
12-}
13module Graphics.Win32.GDI.AlphaBlend where
14import Foreign.Storable         ( Storable(..) )
15import Foreign.Ptr              ( Ptr )
16import Graphics.Win32.GDI.Types ( HDC )
17import System.Win32.Types       ( BOOL, BYTE, UINT )
18
19#include <windows.h>
20#include "alignment.h"
21##include "windows_cconv.h"
22
23foreign import ccall unsafe "alphablend.h"
24  c_AlphaBlend :: HDC -> Int -> Int -> Int -> Int -> HDC -> Int -> Int -> Int -> Int -> PBLENDFUNCTION -> IO BOOL
25{-
26We use C wrapper function to call this API.
27Because foreign stacall/ccall/capi doesn't work with non-pointer user defined type.
28
29We think that capi should support that when user defined type has Storable class instance
30and using CTYPE pragma in the scope.
31
32{-# LANGUAGE CApiFFI #-}
33
34data {-# CTYPE "windows.h" "BLENDFUNCTION" #-} BLENDFUNCTION =
35
36foreign import capi unsafe "windows.h AlphaBlend"
37  c_AlphaBlend :: HDC -> Int -> Int -> Int -> Int -> HDC -> Int -> Int -> Int -> Int -> BLENDFUNCTION -> IO BOOL
38-}
39
40foreign import WINDOWS_CCONV unsafe "windows.h TransparentBlt"
41  c_TransparentBlt :: HDC -> Int -> Int -> Int -> Int -> HDC -> Int -> Int -> Int -> Int -> UINT -> IO BOOL
42
43aC_SRC_OVER :: BYTE
44aC_SRC_OVER = #const AC_SRC_OVER
45
46aC_SRC_ALPHA :: BYTE
47aC_SRC_ALPHA = #const AC_SRC_ALPHA
48
49type PBLENDFUNCTION  = Ptr BLENDFUNCTION
50type LPBLENDFUNCTION = Ptr BLENDFUNCTION
51
52data BLENDFUNCTION = BLENDFUNCTION
53    { blendOp     :: BYTE
54    , blendFlags  :: BYTE
55    , sourceConstantAlpha :: BYTE
56    , alphaFormat :: BYTE
57    } deriving (Show)
58
59instance Storable BLENDFUNCTION where
60    sizeOf = const #size BLENDFUNCTION
61    alignment _ = #alignment BLENDFUNCTION
62    poke buf func = do
63        (#poke BLENDFUNCTION, BlendOp)     buf (blendOp func)
64        (#poke BLENDFUNCTION, BlendFlags)  buf (blendFlags func)
65        (#poke BLENDFUNCTION, SourceConstantAlpha) buf (sourceConstantAlpha func)
66        (#poke BLENDFUNCTION, AlphaFormat) buf (alphaFormat func)
67
68    peek buf = do
69        blendOp'     <- (#peek BLENDFUNCTION, BlendOp) buf
70        blendFlags'  <- (#peek BLENDFUNCTION, BlendFlags) buf
71        sourceConstantAlpha' <-
72            (#peek BLENDFUNCTION, SourceConstantAlpha) buf
73        alphaFormat' <- (#peek BLENDFUNCTION, AlphaFormat) buf
74        return $ BLENDFUNCTION blendOp' blendFlags' sourceConstantAlpha' alphaFormat'
75