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