module Graphics.Win32.GDI.Bitmap(
RasterOp3,
RasterOp4,
sRCCOPY,
sRCPAINT,
sRCAND,
sRCINVERT,
sRCERASE,
nOTSRCCOPY,
nOTSRCERASE,
mERGECOPY,
mERGEPAINT,
pATCOPY,
pATPAINT,
pATINVERT,
dSTINVERT,
bLACKNESS,
wHITENESS,
mAKEROP4,
BITMAP,
LPBITMAP,
setBITMAP,
deleteBitmap,
createCompatibleBitmap,
createBitmap,
createBitmapIndirect,
createDIBPatternBrushPt,
getBitmapDimensionEx,
setBitmapDimensionEx,
getBitmapInfo,
BitmapCompression,
bI_RGB,
bI_RLE8,
bI_RLE4,
bI_BITFIELDS,
ColorFormat,
dIB_PAL_COLORS,
dIB_RGB_COLORS,
LPBITMAPINFO,
BITMAPINFOHEADER,
LPBITMAPINFOHEADER,
getBITMAPINFOHEADER_,
BITMAPFILEHEADER,
LPBITMAPFILEHEADER,
getBITMAPFILEHEADER,
sizeofBITMAP,
sizeofBITMAPINFO,
sizeofBITMAPINFOHEADER,
sizeofBITMAPFILEHEADER,
sizeofLPBITMAPFILEHEADER,
createBMPFile,
cBM_INIT,
getDIBits,
setDIBits,
createDIBitmap
) where
import System.Win32.Types
import Graphics.Win32.GDI.Types
import Control.Monad (liftM)
import Foreign
import Foreign.C
#include "windows_cconv.h"
sRCCOPY :: RasterOp3
sRCCOPY = 13369376
sRCPAINT :: RasterOp3
sRCPAINT = 15597702
sRCAND :: RasterOp3
sRCAND = 8913094
sRCINVERT :: RasterOp3
sRCINVERT = 6684742
sRCERASE :: RasterOp3
sRCERASE = 4457256
nOTSRCCOPY :: RasterOp3
nOTSRCCOPY = 3342344
nOTSRCERASE :: RasterOp3
nOTSRCERASE = 1114278
mERGECOPY :: RasterOp3
mERGECOPY = 12583114
mERGEPAINT :: RasterOp3
mERGEPAINT = 12255782
pATCOPY :: RasterOp3
pATCOPY = 15728673
pATPAINT :: RasterOp3
pATPAINT = 16452105
pATINVERT :: RasterOp3
pATINVERT = 5898313
dSTINVERT :: RasterOp3
dSTINVERT = 5570569
bLACKNESS :: RasterOp3
bLACKNESS = 66
wHITENESS :: RasterOp3
wHITENESS = 16711778
type BITMAP =
( INT
, INT
, INT
, INT
, WORD
, WORD
, LPVOID
)
peekBITMAP :: Ptr BITMAP -> IO BITMAP
peekBITMAP p = do
ty <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
width <- (\hsc_ptr -> peekByteOff hsc_ptr 4) p
height <- (\hsc_ptr -> peekByteOff hsc_ptr 8) p
wbytes <- (\hsc_ptr -> peekByteOff hsc_ptr 12) p
planes <- (\hsc_ptr -> peekByteOff hsc_ptr 16) p
pixel <- (\hsc_ptr -> peekByteOff hsc_ptr 18) p
bits <- (\hsc_ptr -> peekByteOff hsc_ptr 20) p
return (ty, width, height, wbytes, planes, pixel, bits)
pokeBITMAP :: Ptr BITMAP -> BITMAP -> IO ()
pokeBITMAP p (ty, width, height, wbytes, planes, pixel, bits) = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) p ty
(\hsc_ptr -> pokeByteOff hsc_ptr 4) p width
(\hsc_ptr -> pokeByteOff hsc_ptr 8) p height
(\hsc_ptr -> pokeByteOff hsc_ptr 12) p wbytes
(\hsc_ptr -> pokeByteOff hsc_ptr 16) p planes
(\hsc_ptr -> pokeByteOff hsc_ptr 18) p pixel
(\hsc_ptr -> pokeByteOff hsc_ptr 20) p bits
type LPBITMAP = Ptr BITMAP
setBITMAP :: LPBITMAP -> BITMAP -> IO ()
setBITMAP = pokeBITMAP
deleteBitmap :: HBITMAP -> IO ()
deleteBitmap bitmap =
failIfFalse_ "DeleteBitmap" $ c_DeleteBitmap bitmap
foreign import WINDOWS_CCONV unsafe "windows.h DeleteObject"
c_DeleteBitmap :: HBITMAP -> IO Bool
createBitmap :: INT -> INT -> UINT -> UINT -> Maybe LPVOID -> IO HBITMAP
createBitmap w h planes bits mb_color_data =
failIfNull "CreateBitmap" $
c_CreateBitmap w h planes bits (maybePtr mb_color_data)
foreign import WINDOWS_CCONV unsafe "windows.h CreateBitmap"
c_CreateBitmap :: INT -> INT -> UINT -> UINT -> LPVOID -> IO HBITMAP
createBitmapIndirect :: LPBITMAP -> IO HBITMAP
createBitmapIndirect p_bm =
failIfNull "CreateBitmapIndirect" $ c_CreateBitmapIndirect p_bm
foreign import WINDOWS_CCONV unsafe "windows.h CreateBitmapIndirect"
c_CreateBitmapIndirect :: LPBITMAP -> IO HBITMAP
createCompatibleBitmap :: HDC -> Int32 -> Int32 -> IO HBITMAP
createCompatibleBitmap dc w h =
failIfNull "CreateCompatibleBitmap" $ c_CreateCompatibleBitmap dc w h
foreign import WINDOWS_CCONV unsafe "windows.h CreateCompatibleBitmap"
c_CreateCompatibleBitmap :: HDC -> Int32 -> Int32 -> IO HBITMAP
createDIBPatternBrushPt :: LPVOID -> ColorFormat -> IO HBRUSH
createDIBPatternBrushPt bm usage =
failIfNull "CreateDIBPatternBrushPt" $ c_CreateDIBPatternBrushPt bm usage
foreign import WINDOWS_CCONV unsafe "windows.h CreateDIBPatternBrushPt"
c_CreateDIBPatternBrushPt :: LPVOID -> ColorFormat -> IO HBRUSH
getBitmapDimensionEx :: HBITMAP -> IO SIZE
getBitmapDimensionEx bm =
allocaSIZE $ \ p_size -> do
failIfFalse_ "GetBitmapDimensionEx" $ c_GetBitmapDimensionEx bm p_size
peekSIZE p_size
foreign import WINDOWS_CCONV unsafe "windows.h GetBitmapDimensionEx"
c_GetBitmapDimensionEx :: HBITMAP -> Ptr SIZE -> IO Bool
setBitmapDimensionEx :: HBITMAP -> SIZE -> IO SIZE
setBitmapDimensionEx bm (cx,cy) =
allocaSIZE $ \ p_size -> do
failIfFalse_ "SetBitmapDimensionEx" $ do
c_SetBitmapDimensionEx bm cx cy p_size
peekSIZE p_size
foreign import WINDOWS_CCONV unsafe "windows.h SetBitmapDimensionEx"
c_SetBitmapDimensionEx :: HBITMAP -> LONG -> LONG -> Ptr SIZE -> IO Bool
getBitmapInfo :: HBITMAP -> IO BITMAP
getBitmapInfo bm =
allocaBytes (fromIntegral sizeofBITMAP) $ \ p_bm -> do
failIfFalse_ "GetBitmapInfo" $ c_GetBitmapInfo bm sizeofBITMAP p_bm
peekBITMAP p_bm
foreign import WINDOWS_CCONV unsafe "windows.h GetObjectW"
c_GetBitmapInfo :: HBITMAP -> DWORD -> LPBITMAP -> IO Bool
type BitmapCompression = DWORD
bI_RGB :: BitmapCompression
bI_RGB = 0
bI_RLE8 :: BitmapCompression
bI_RLE8 = 1
bI_RLE4 :: BitmapCompression
bI_RLE4 = 2
bI_BITFIELDS :: BitmapCompression
bI_BITFIELDS = 3
type ColorFormat = DWORD
dIB_PAL_COLORS :: ColorFormat
dIB_PAL_COLORS = 1
dIB_RGB_COLORS :: ColorFormat
dIB_RGB_COLORS = 0
type LPBITMAPINFO = Ptr ()
type BITMAPINFOHEADER =
( DWORD
, LONG
, LONG
, WORD
, WORD
, BitmapCompression
, DWORD
, LONG
, LONG
, Maybe DWORD
, Maybe DWORD
)
peekBITMAPINFOHEADER :: Ptr BITMAPINFOHEADER -> IO BITMAPINFOHEADER
peekBITMAPINFOHEADER p = do
size <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
width <- (\hsc_ptr -> peekByteOff hsc_ptr 4) p
height <- (\hsc_ptr -> peekByteOff hsc_ptr 8) p
planes <- (\hsc_ptr -> peekByteOff hsc_ptr 12) p
nbits <- (\hsc_ptr -> peekByteOff hsc_ptr 14) p
comp <- (\hsc_ptr -> peekByteOff hsc_ptr 16) p
imsize <- (\hsc_ptr -> peekByteOff hsc_ptr 20) p
xDensity <- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
yDensity <- (\hsc_ptr -> peekByteOff hsc_ptr 28) p
clrUsed <- liftM numToMaybe $ (\hsc_ptr -> peekByteOff hsc_ptr 32) p
clrImp <- liftM numToMaybe $ (\hsc_ptr -> peekByteOff hsc_ptr 36) p
return (size, width, height, planes, nbits, comp, imsize,
xDensity, yDensity, clrUsed, clrImp)
type LPBITMAPINFOHEADER = Ptr BITMAPINFOHEADER
getBITMAPINFOHEADER_ :: LPBITMAPINFOHEADER -> IO BITMAPINFOHEADER
getBITMAPINFOHEADER_ = peekBITMAPINFOHEADER
type BITMAPFILEHEADER =
( WORD
, DWORD
, WORD
, WORD
, DWORD
)
peekBITMAPFILEHEADER :: Ptr BITMAPFILEHEADER -> IO BITMAPFILEHEADER
peekBITMAPFILEHEADER p = do
ty <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
size <- (\hsc_ptr -> peekByteOff hsc_ptr 2) p
res1 <- (\hsc_ptr -> peekByteOff hsc_ptr 6) p
res2 <- (\hsc_ptr -> peekByteOff hsc_ptr 8) p
offset <- (\hsc_ptr -> peekByteOff hsc_ptr 10) p
return (ty, size, res1, res2, offset)
type LPBITMAPFILEHEADER = Ptr BITMAPFILEHEADER
getBITMAPFILEHEADER :: LPBITMAPFILEHEADER -> IO BITMAPFILEHEADER
getBITMAPFILEHEADER = peekBITMAPFILEHEADER
sizeofBITMAP :: Word32
sizeofBITMAP = (24)
sizeofBITMAPINFO :: Word32
sizeofBITMAPINFO = (44)
sizeofBITMAPINFOHEADER :: Word32
sizeofBITMAPINFOHEADER = (40)
sizeofBITMAPFILEHEADER :: Word32
sizeofBITMAPFILEHEADER = (14)
sizeofLPBITMAPFILEHEADER :: Word32
sizeofLPBITMAPFILEHEADER = (14)
createBMPFile :: String -> HBITMAP -> HDC -> IO ()
createBMPFile name bm dc =
withCWString name $ \ c_name ->
c_CreateBMPFile c_name bm dc
foreign import ccall unsafe "dumpBMP.h CreateBMPFile"
c_CreateBMPFile :: LPCTSTR -> HBITMAP -> HDC -> IO ()
cBM_INIT :: DWORD
cBM_INIT = 4
getDIBits :: HDC -> HBITMAP -> INT -> INT -> Maybe LPVOID -> LPBITMAPINFO -> ColorFormat -> IO INT
getDIBits dc bm start nlines mb_bits info usage =
failIfZero "GetDIBits" $
c_GetDIBits dc bm start nlines (maybePtr mb_bits) info usage
foreign import WINDOWS_CCONV unsafe "windows.h GetDIBits"
c_GetDIBits :: HDC -> HBITMAP -> INT -> INT -> LPVOID -> LPBITMAPINFO -> ColorFormat -> IO INT
setDIBits :: HDC -> HBITMAP -> INT -> INT -> LPVOID -> LPBITMAPINFO -> ColorFormat -> IO INT
setDIBits dc bm start nlines bits info use =
failIfZero "SetDIBits" $ c_SetDIBits dc bm start nlines bits info use
foreign import WINDOWS_CCONV unsafe "windows.h SetDIBits"
c_SetDIBits :: HDC -> HBITMAP -> INT -> INT -> LPVOID -> LPBITMAPINFO -> ColorFormat -> IO INT
createDIBitmap :: HDC -> LPBITMAPINFOHEADER -> DWORD -> LPVOID -> LPBITMAPINFO -> ColorFormat -> IO HBITMAP
createDIBitmap dc hdr option init_val info usage =
failIfNull "CreateDIBitmap" $
c_CreateDIBitmap dc hdr option init_val info usage
foreign import WINDOWS_CCONV unsafe "windows.h CreateDIBitmap"
c_CreateDIBitmap :: HDC -> LPBITMAPINFOHEADER -> DWORD -> LPVOID -> LPBITMAPINFO -> ColorFormat -> IO HBITMAP