{-# LINE 1 "libraries\\Win32\\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 "libraries\\Win32\\Graphics\\Win32\\GDI\\AlphaBlend.hsc" #-} aC_SRC_ALPHA :: BYTE aC_SRC_ALPHA = 1 {-# LINE 48 "libraries\\Win32\\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 "libraries\\Win32\\Graphics\\Win32\\GDI\\AlphaBlend.hsc" #-} alignment _ = 1 {-# LINE 62 "libraries\\Win32\\Graphics\\Win32\\GDI\\AlphaBlend.hsc" #-} poke buf func = do ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf (blendOp func) {-# LINE 64 "libraries\\Win32\\Graphics\\Win32\\GDI\\AlphaBlend.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 1)) buf (blendFlags func) {-# LINE 65 "libraries\\Win32\\Graphics\\Win32\\GDI\\AlphaBlend.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) buf (sourceConstantAlpha func) {-# LINE 66 "libraries\\Win32\\Graphics\\Win32\\GDI\\AlphaBlend.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 3)) buf (alphaFormat func) {-# LINE 67 "libraries\\Win32\\Graphics\\Win32\\GDI\\AlphaBlend.hsc" #-} peek buf = do blendOp' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) buf {-# LINE 70 "libraries\\Win32\\Graphics\\Win32\\GDI\\AlphaBlend.hsc" #-} blendFlags' <- ((\hsc_ptr -> peekByteOff hsc_ptr 1)) buf {-# LINE 71 "libraries\\Win32\\Graphics\\Win32\\GDI\\AlphaBlend.hsc" #-} sourceConstantAlpha' <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) buf {-# LINE 73 "libraries\\Win32\\Graphics\\Win32\\GDI\\AlphaBlend.hsc" #-} alphaFormat' <- ((\hsc_ptr -> peekByteOff hsc_ptr 3)) buf {-# LINE 74 "libraries\\Win32\\Graphics\\Win32\\GDI\\AlphaBlend.hsc" #-} return $ BLENDFUNCTION blendOp' blendFlags' sourceConstantAlpha' alphaFormat'