----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.GDI.Bitmap -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- 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 "Win32Aux.h" #include ---------------------------------------------------------------- -- Resources ---------------------------------------------------------------- -- Yoiks - name clash -- %dis bitmap x = ptr ({LPTSTR} x) -- -- type Bitmap = LPCTSTR -- -- intToBitmap :: Int -> Bitmap -- intToBitmap i = makeIntResource (toWord i) -- -- %fun LoadBitmap :: MbHINSTANCE -> Bitmap -> IO HBITMAP -- %fail { res1 == 0 } { ErrorString("LoadBitmap") } -- -- %const Bitmap -- % [ OBM_CLOSE = { MAKEINTRESOURCE(OBM_CLOSE) } -- % , OBM_UPARROW = { MAKEINTRESOURCE(OBM_UPARROW) } -- % , OBM_DNARROW = { MAKEINTRESOURCE(OBM_DNARROW) } -- % , OBM_RGARROW = { MAKEINTRESOURCE(OBM_RGARROW) } -- % , OBM_LFARROW = { MAKEINTRESOURCE(OBM_LFARROW) } -- % , OBM_REDUCE = { MAKEINTRESOURCE(OBM_REDUCE) } -- % , OBM_ZOOM = { MAKEINTRESOURCE(OBM_ZOOM) } -- % , OBM_RESTORE = { MAKEINTRESOURCE(OBM_RESTORE) } -- % , OBM_REDUCED = { MAKEINTRESOURCE(OBM_REDUCED) } -- % , OBM_ZOOMD = { MAKEINTRESOURCE(OBM_ZOOMD) } -- % , OBM_RESTORED = { MAKEINTRESOURCE(OBM_RESTORED) } -- % , OBM_UPARROWD = { MAKEINTRESOURCE(OBM_UPARROWD) } -- % , OBM_DNARROWD = { MAKEINTRESOURCE(OBM_DNARROWD) } -- % , OBM_RGARROWD = { MAKEINTRESOURCE(OBM_RGARROWD) } -- % , OBM_LFARROWD = { MAKEINTRESOURCE(OBM_LFARROWD) } -- % , OBM_MNARROW = { MAKEINTRESOURCE(OBM_MNARROW) } -- % , OBM_COMBO = { MAKEINTRESOURCE(OBM_COMBO) } -- % , OBM_UPARROWI = { MAKEINTRESOURCE(OBM_UPARROWI) } -- % , OBM_DNARROWI = { MAKEINTRESOURCE(OBM_DNARROWI) } -- % , OBM_RGARROWI = { MAKEINTRESOURCE(OBM_RGARROWI) } -- % , OBM_LFARROWI = { MAKEINTRESOURCE(OBM_LFARROWI) } -- % , OBM_OLD_CLOSE = { MAKEINTRESOURCE(OBM_OLD_CLOSE) } -- % , OBM_SIZE = { MAKEINTRESOURCE(OBM_SIZE) } -- % , OBM_OLD_UPARROW = { MAKEINTRESOURCE(OBM_OLD_UPARROW) } -- % , OBM_OLD_DNARROW = { MAKEINTRESOURCE(OBM_OLD_DNARROW) } -- % , OBM_OLD_RGARROW = { MAKEINTRESOURCE(OBM_OLD_RGARROW) } -- % , OBM_OLD_LFARROW = { MAKEINTRESOURCE(OBM_OLD_LFARROW) } -- % , OBM_BTSIZE = { MAKEINTRESOURCE(OBM_BTSIZE) } -- % , OBM_CHECK = { MAKEINTRESOURCE(OBM_CHECK) } -- % , OBM_CHECKBOXES = { MAKEINTRESOURCE(OBM_CHECKBOXES) } -- % , OBM_BTNCORNERS = { MAKEINTRESOURCE(OBM_BTNCORNERS) } -- % , OBM_OLD_REDUCE = { MAKEINTRESOURCE(OBM_OLD_REDUCE) } -- % , OBM_OLD_ZOOM = { MAKEINTRESOURCE(OBM_OLD_ZOOM) } -- % , OBM_OLD_RESTORE = { MAKEINTRESOURCE(OBM_OLD_RESTORE) } -- % ] ---------------------------------------------------------------- -- Raster Ops ---------------------------------------------------------------- #{enum RasterOp3, , sRCCOPY = SRCCOPY , sRCPAINT = SRCPAINT , sRCAND = SRCAND , sRCINVERT = SRCINVERT , sRCERASE = SRCERASE , nOTSRCCOPY = NOTSRCCOPY , nOTSRCERASE = NOTSRCERASE , mERGECOPY = MERGECOPY , mERGEPAINT = MERGEPAINT , pATCOPY = PATCOPY , pATPAINT = PATPAINT , pATINVERT = PATINVERT , dSTINVERT = DSTINVERT , bLACKNESS = BLACKNESS , wHITENESS = WHITENESS } ---------------------------------------------------------------- -- BITMAP ---------------------------------------------------------------- type BITMAP = ( INT -- bmType , INT -- bmWidth , INT -- bmHeight , INT -- bmWidthBytes , WORD -- bmPlanes , WORD -- bmBitsPixel , LPVOID -- bmBits ) peekBITMAP :: Ptr BITMAP -> IO BITMAP peekBITMAP p = do ty <- #{peek BITMAP,bmType} p width <- #{peek BITMAP,bmWidth} p height <- #{peek BITMAP,bmHeight} p wbytes <- #{peek BITMAP,bmWidthBytes} p planes <- #{peek BITMAP,bmPlanes} p pixel <- #{peek BITMAP,bmBitsPixel} p bits <- #{peek BITMAP,bmBits} p return (ty, width, height, wbytes, planes, pixel, bits) pokeBITMAP :: Ptr BITMAP -> BITMAP -> IO () pokeBITMAP p (ty, width, height, wbytes, planes, pixel, bits) = do #{poke BITMAP,bmType} p ty #{poke BITMAP,bmWidth} p width #{poke BITMAP,bmHeight} p height #{poke BITMAP,bmWidthBytes} p wbytes #{poke BITMAP,bmPlanes} p planes #{poke BITMAP,bmBitsPixel} p pixel #{poke BITMAP,bmBits} p bits type LPBITMAP = Ptr BITMAP setBITMAP :: LPBITMAP -> BITMAP -> IO () setBITMAP = pokeBITMAP ---------------------------------------------------------------- -- Misc ---------------------------------------------------------------- deleteBitmap :: HBITMAP -> IO () deleteBitmap bitmap = failIfFalse_ "DeleteBitmap" $ c_DeleteBitmap bitmap foreign import stdcall 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 stdcall 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 stdcall 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 stdcall 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 stdcall unsafe "windows.h CreateDIBPatternBrushPt" c_CreateDIBPatternBrushPt :: LPVOID -> ColorFormat -> IO HBRUSH ---------------------------------------------------------------- -- Querying ---------------------------------------------------------------- getBitmapDimensionEx :: HBITMAP -> IO SIZE getBitmapDimensionEx bm = allocaSIZE $ \ p_size -> do failIfFalse_ "GetBitmapDimensionEx" $ c_GetBitmapDimensionEx bm p_size peekSIZE p_size foreign import stdcall 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 stdcall 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 stdcall unsafe "windows.h GetObjectW" c_GetBitmapInfo :: HBITMAP -> DWORD -> LPBITMAP -> IO Bool ---------------------------------------------------------------- -- ---------------------------------------------------------------- type BitmapCompression = DWORD #{enum BitmapCompression, , bI_RGB = BI_RGB , bI_RLE8 = BI_RLE8 , bI_RLE4 = BI_RLE4 , bI_BITFIELDS = BI_BITFIELDS } type ColorFormat = DWORD #{enum ColorFormat, , dIB_PAL_COLORS = DIB_PAL_COLORS , dIB_RGB_COLORS = DIB_RGB_COLORS } ---------------------------------------------------------------- -- BITMAPINFO ---------------------------------------------------------------- type LPBITMAPINFO = Ptr () ---------------------------------------------------------------- -- BITMAPINFOHEADER ---------------------------------------------------------------- type BITMAPINFOHEADER = ( DWORD -- biSize -- sizeof(BITMAPINFOHEADER) , LONG -- biWidth , LONG -- biHeight , WORD -- biPlanes , WORD -- biBitCount -- 1, 4, 8, 16, 24 or 32 , BitmapCompression -- biCompression , DWORD -- biSizeImage , LONG -- biXPelsPerMeter , LONG -- biYPelsPerMeter , Maybe DWORD -- biClrUsed , Maybe DWORD -- biClrImportant ) peekBITMAPINFOHEADER :: Ptr BITMAPINFOHEADER -> IO BITMAPINFOHEADER peekBITMAPINFOHEADER p = do size <- #{peek BITMAPINFOHEADER,biSize} p width <- #{peek BITMAPINFOHEADER,biWidth} p height <- #{peek BITMAPINFOHEADER,biHeight} p planes <- #{peek BITMAPINFOHEADER,biPlanes} p nbits <- #{peek BITMAPINFOHEADER,biBitCount} p comp <- #{peek BITMAPINFOHEADER,biCompression} p imsize <- #{peek BITMAPINFOHEADER,biSizeImage} p xDensity <- #{peek BITMAPINFOHEADER,biXPelsPerMeter} p yDensity <- #{peek BITMAPINFOHEADER,biYPelsPerMeter} p clrUsed <- liftM numToMaybe $ #{peek BITMAPINFOHEADER,biClrUsed} p clrImp <- liftM numToMaybe $ #{peek BITMAPINFOHEADER,biClrImportant} p return (size, width, height, planes, nbits, comp, imsize, xDensity, yDensity, clrUsed, clrImp) type LPBITMAPINFOHEADER = Ptr BITMAPINFOHEADER getBITMAPINFOHEADER_ :: LPBITMAPINFOHEADER -> IO BITMAPINFOHEADER getBITMAPINFOHEADER_ = peekBITMAPINFOHEADER ---------------------------------------------------------------- -- BITMAPFILEHEADER ---------------------------------------------------------------- type BITMAPFILEHEADER = ( WORD -- bfType -- "BM" == 0x4d42 , DWORD -- bfSize -- number of bytes in file , WORD -- bfReserved1 -- == 0 , WORD -- bfReserved2 -- == 0 , DWORD -- bfOffBits -- == (char*) bits - (char*) filehdr ) peekBITMAPFILEHEADER :: Ptr BITMAPFILEHEADER -> IO BITMAPFILEHEADER peekBITMAPFILEHEADER p = do ty <- #{peek BITMAPFILEHEADER,bfType} p size <- #{peek BITMAPFILEHEADER,bfSize} p res1 <- #{peek BITMAPFILEHEADER,bfReserved1} p res2 <- #{peek BITMAPFILEHEADER,bfReserved2} p offset <- #{peek BITMAPFILEHEADER,bfOffBits} p return (ty, size, res1, res2, offset) type LPBITMAPFILEHEADER = Ptr BITMAPFILEHEADER getBITMAPFILEHEADER :: LPBITMAPFILEHEADER -> IO BITMAPFILEHEADER getBITMAPFILEHEADER = peekBITMAPFILEHEADER sizeofBITMAP :: Word32 sizeofBITMAP = #{size BITMAP} sizeofBITMAPINFO :: Word32 sizeofBITMAPINFO = #{size BITMAPINFO} sizeofBITMAPINFOHEADER :: Word32 sizeofBITMAPINFOHEADER = #{size BITMAPINFOHEADER} sizeofBITMAPFILEHEADER :: Word32 sizeofBITMAPFILEHEADER = #{size BITMAPFILEHEADER} sizeofLPBITMAPFILEHEADER :: Word32 sizeofLPBITMAPFILEHEADER = #{size BITMAPFILEHEADER} ---------------------------------------------------------------- -- CreateBMPFile ---------------------------------------------------------------- -- A (large) helper function - courtesy of Microsoft 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 () {-# CFILES cbits/dumpBMP.c #-} ---------------------------------------------------------------- -- Device Independent Bitmaps ---------------------------------------------------------------- #{enum DWORD, , cBM_INIT = CBM_INIT } 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 stdcall 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 stdcall 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 stdcall unsafe "windows.h CreateDIBitmap" c_CreateDIBitmap :: HDC -> LPBITMAPINFOHEADER -> DWORD -> LPVOID -> LPBITMAPINFO -> ColorFormat -> IO HBITMAP ---------------------------------------------------------------- -- End ----------------------------------------------------------------