gd-3000.7.3/0000755000000000000000000000000011731070661010526 5ustar0000000000000000gd-3000.7.3/LICENSE0000644000000000000000000000000011731070661011521 0ustar0000000000000000gd-3000.7.3/gd.cabal0000644000000000000000000000150411731070661012104 0ustar0000000000000000Name: gd Category: Graphics License-File: LICENSE Version: 3000.7.3 Cabal-version: >= 1.2 Build-type: Simple Copyright: Bjorn Bringert Author: Bjorn Bringert License: BSD3 Synopsis: A Haskell binding to a subset of the GD graphics library Description: This is a binding to a (currently very small) subset of the GD graphics library. Extra-source-files: cbits/gd-extras.h Flag bytestring-in-base Library Build-depends: base >= 4 && < 5, bytestring >= 0.9.1.6 Extensions: ForeignFunctionInterface Exposed-Modules: Graphics.GD, Graphics.GD.ByteString, Graphics.GD.ByteString.Lazy Ghc-options: -Wall Extra-libraries: gd, png, z, jpeg, m, fontconfig, freetype, expat Includes: gd.h Include-dirs: cbits Install-includes: gd-extras.h C-sources: cbits/gd-extras.c Other-modules: Graphics.GD.Internal gd-3000.7.3/Setup.hs0000644000000000000000000000010511731070661012156 0ustar0000000000000000#!/usr/bin/env runghc import Distribution.Simple main = defaultMain gd-3000.7.3/cbits/0000755000000000000000000000000011731070661011632 5ustar0000000000000000gd-3000.7.3/cbits/gd-extras.h0000644000000000000000000000056311731070661013705 0ustar0000000000000000#ifdef __cplusplus extern "C" { #endif #ifndef GD_EXTRAS_H #define G_DEXTRAS_H 1 #include BGD_DECLARE(void) gdImagePtrDestroyIfNotNull (gdImagePtr *im); BGD_DECLARE(void) gdImageCopyRotated90 (gdImagePtr dst, gdImagePtr src, int dstX, int dstY, int srcX, int srcY, int srcW, int srcH, int quadrants); #endif #ifdef __cplusplus } #endif gd-3000.7.3/cbits/gd-extras.c0000644000000000000000000000335011731070661013675 0ustar0000000000000000#include #include "gd-extras.h" BGD_DECLARE(void) gdImagePtrDestroyIfNotNull (gdImagePtr *imp) { gdImagePtr im = *imp; if (im) { gdImageDestroy(im); } } BGD_DECLARE(void) gdImageCopyRotated90 (gdImagePtr dst, gdImagePtr src, int dstX, int dstY, int srcX, int srcY, int srcW, int srcH, int quadrants) { int dx, dy; /* make sure it's 0-3 */ int q = (4 + quadrants % 4) % 4; int even = q % 2 == 0; int cos_q = even ? 1 - q : 0; int sin_q = even ? 0 : 2 - q; /* hack for figuring out destination width */ int dstW = even ? srcW : srcH; int dstH = even ? srcH : srcW; int cmap[gdMaxColors]; int i; for (i = 0; (i < gdMaxColors); i++) { cmap[i] = (-1); } for (dy = 0; (dy < dstH); dy++) { for (dx = 0; (dx < dstW); dx++) { int sx = srcX + cos_q * dx - sin_q * dy; int sy = srcY + sin_q * dx + cos_q * dy; if ((sx >= 0) && (sx < srcW) && (sy >= 0) && (sy < srcH)) { int c = gdImageGetPixel (src, sx, sy); if (!src->trueColor) { /* Use a table to avoid an expensive lookup on every single pixel */ if (cmap[c] == -1) { cmap[c] = gdImageColorResolveAlpha (dst, gdImageRed (src, c), gdImageGreen (src, c), gdImageBlue (src, c), gdImageAlpha (src, c)); } gdImageSetPixel (dst, dstX + dx, dstY + dy, cmap[c]); } else { gdImageSetPixel (dst, dstX + dx, dstY + dy, gdImageColorResolveAlpha (dst, gdImageRed (src, c), gdImageGreen (src, c), gdImageBlue (src, c), gdImageAlpha (src, c))); } } } } } gd-3000.7.3/Graphics/0000755000000000000000000000000011731070661012266 5ustar0000000000000000gd-3000.7.3/Graphics/GD.hsc0000644000000000000000000005723211731070661013270 0ustar0000000000000000{-# LANGUAGE EmptyDataDecls #-} module Graphics.GD ( -- * Types Image, Size, Point, Color, PCREOption(..), -- * Creating and copying images newImage, copyImage, copyRegion, copyRegionScaled, -- * Memory management withImage, -- * Loading images -- ** JPEG loadJpegFile, loadJpegData, loadJpegByteString, -- ** PNG loadPngFile, loadPngData, loadPngByteString, -- ** GIF loadGifFile, loadGifData, loadGifByteString, -- * Saving images -- ** JPEG saveJpegFile, saveJpegByteString, -- ** PNG savePngFile, savePngByteString, -- ** GIF saveGifFile, saveGifByteString, -- * Getting image information imageSize, -- * Querying getPixel, -- * Manipulating images resizeImage, rotateImage, -- * Drawing brushed, setBrush, fillImage, drawFilledRectangle, drawFilledEllipse, drawLine, drawArc, antiAliased, setPixel, colorAllocate, -- * Text useFontConfig, drawString, measureString, drawStringCircle, -- * Colors rgb, rgba, toRGBA, -- * Misc saveAlpha, alphaBlending, ) where import Control.Exception (bracket) import Control.Monad (liftM, unless) import Data.Bits import qualified Data.ByteString.Internal as B import Foreign (Ptr,FunPtr,ForeignPtr) import Foreign (peekByteOff) import qualified Foreign as F import Foreign.C (CString) import qualified Foreign.C as C import Foreign.C.Types data CFILE foreign import ccall "stdio.h fopen" c_fopen :: CString -> CString -> IO (Ptr CFILE) foreign import ccall "stdio.h fclose" c_fclose :: Ptr CFILE -> IO CInt fopen :: FilePath -> String -> IO (Ptr CFILE) fopen file mode = C.throwErrnoIfNull file $ C.withCString file $ \f -> C.withCString mode $ \m -> c_fopen f m fclose :: Ptr CFILE -> IO () fclose p = C.throwErrnoIf_ (== #{const EOF}) "fclose" $ c_fclose p withCFILE :: FilePath -> String -> (Ptr CFILE -> IO a) -> IO a withCFILE file mode = bracket (fopen file mode) fclose #include #include "gd-extras.h" data GDImage -- JPEG format foreign import ccall "gd.h gdImageCreateFromJpeg" gdImageCreateFromJpeg :: Ptr CFILE -> IO (Ptr GDImage) foreign import ccall "gd.h gdImageCreateFromJpegPtr" gdImageCreateFromJpegPtr :: CInt -> Ptr a -> IO (Ptr GDImage) foreign import ccall "gd.h gdImageJpeg" gdImageJpeg :: Ptr GDImage -> Ptr CFILE -> CInt -> IO () foreign import ccall "gd.h gdImageJpegPtr" gdImageJpegPtr :: Ptr GDImage -> Ptr CInt -> CInt -> IO (Ptr a) -- PNG format foreign import ccall "gd.h gdImageCreateFromPng" gdImageCreateFromPng :: Ptr CFILE -> IO (Ptr GDImage) foreign import ccall "gd.h gdImageCreateFromPngPtr" gdImageCreateFromPngPtr :: CInt -> Ptr a -> IO (Ptr GDImage) foreign import ccall "gd.h gdImagePng" gdImagePng :: Ptr GDImage -> Ptr CFILE -> IO () foreign import ccall "gd.h gdImagePngPtr" gdImagePngPtr :: Ptr GDImage -> Ptr CInt -> IO (Ptr a) -- GIF format foreign import ccall "gd.h gdImageCreateFromGif" gdImageCreateFromGif :: Ptr CFILE -> IO (Ptr GDImage) foreign import ccall "gd.h gdImageCreateFromGifPtr" gdImageCreateFromGifPtr :: CInt -> Ptr a -> IO (Ptr GDImage) foreign import ccall "gd.h gdImageGif" gdImageGif :: Ptr GDImage -> Ptr CFILE -> IO () foreign import ccall "gd.h gdImageGifPtr" gdImageGifPtr :: Ptr GDImage -> Ptr CInt -> IO (Ptr a) -- Creating and destroying images foreign import ccall "gd.h gdImageCreateTrueColor" gdImageCreateTrueColor :: CInt -> CInt -> IO (Ptr GDImage) foreign import ccall "gd.h gdImageDestroy" gdImageDestroy :: Ptr GDImage -> IO () foreign import ccall "gd-extras.h &gdImagePtrDestroyIfNotNull" ptr_gdImagePtrDestroyIfNotNull :: FunPtr (Ptr (Ptr GDImage) -> IO ()) -- Copying image parts foreign import ccall "gd.h gdImageCopy" gdImageCopy :: Ptr GDImage -> Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () foreign import ccall "gd.h gdImageCopyResampled" gdImageCopyResampled :: Ptr GDImage -> Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () {- foreign import ccall "gd.h gdImageCopyRotated" gdImageCopyRotated :: Ptr GDImage -> Ptr GDImage -> CDouble -> CDouble -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () -} foreign import ccall "gd-extras.h gdImageCopyRotated90" gdImageCopyRotated90 :: Ptr GDImage -> Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () foreign import ccall "gd.h gdImageGetPixel" gdImageGetPixel :: Ptr GDImage -> CInt -> CInt -> IO CInt -- Drawing functions foreign import ccall "gd.h gdImageSetBrush" gdImageSetBrush :: Ptr GDImage -> Ptr GDImage -> IO () foreign import ccall "gd.h gdImageFilledRectangle" gdImageFilledRectangle :: Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () foreign import ccall "gd.h gdImageFilledEllipse" gdImageFilledEllipse :: Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () foreign import ccall "gd.h gdImageLine" gdImageLine :: Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () foreign import ccall "gd.h gdImageArc" gdImageArc :: Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () foreign import ccall "gd.h gdImageSetAntiAliased" gdImageSetAntiAliased :: Ptr GDImage -> CInt -> IO () foreign import ccall "gd.h gdImageSetPixel" gdImageSetPixel :: Ptr GDImage -> CInt -> CInt -> CInt -> IO () foreign import ccall "gd.h gdImageColorAllocate" gdImageColorAllocate :: Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> IO CInt -- Text functions foreign import ccall "gd.h gdFTUseFontConfig" gdFTUseFontConfig :: CInt -> IO CInt foreign import ccall "gd.h gdImageStringFT" gdImageStringFT :: Ptr GDImage -> Ptr CInt -> CInt -> CString -> CDouble -> CDouble -> CInt -> CInt -> CString -> IO CString foreign import ccall "gd.h gdImageStringFTCircle" gdImageStringFTCircle :: Ptr GDImage -> CInt -> CInt -> CDouble -> CDouble -> CDouble -> CString -> CDouble -> CString -> CString -> CInt -> IO CString -- Miscellaneous functions foreign import ccall "gd.h &gdFree" gdFree :: FunPtr (Ptr a -> IO ()) toRGBA :: Color -> (Int, Int, Int, Int) toRGBA c = (fromIntegral r, fromIntegral g, fromIntegral b, fromIntegral a) where b = c `mod` byte g = shiftR c 8 `mod` byte r = shiftR c 16 `mod` byte a = shiftR c 24 `mod` byte byte = 2 ^ (8::Int) foreign import ccall "gd.h gdImageSaveAlpha" gdImageSaveAlpha :: Ptr GDImage -> CInt -> IO () foreign import ccall "gd.h gdImageAlphaBlending" gdImageAlphaBlending :: Ptr GDImage -> CInt -> IO () -- | To access the definition 'gdBrush' from GD newtype PCREOption = PCREOption { unPCREOption :: CInt } deriving (Eq,Show) -- We use a second level of indirection to allow storing a null pointer -- when the image has already been freed. This allows 'withImage' to -- free the @gdImage@ early. newtype Image = Image (ForeignPtr (Ptr GDImage)) type Size = (Int,Int) type Point = (Int,Int) type Color = CInt mkImage :: Ptr GDImage -> IO Image mkImage img = do fp <- F.mallocForeignPtr F.withForeignPtr fp $ \p -> F.poke p img F.addForeignPtrFinalizer ptr_gdImagePtrDestroyIfNotNull fp return $ Image fp -- | Creates an image, performs an operation on the image, and -- frees it. -- This function allows block scoped management of 'Image' -- objects. If you are handling large images, the delay before -- the finalizer which frees the image runs may cause significant -- temporary extra memory use. Use this function to force the -- image to be freed as soons as you are done with it. Note that -- it is unsafe to hold on to the 'Image' after the function is -- done. withImage :: IO Image -- ^ Image creation action. -> (Image -> IO b) -- ^ Some operation on the image. The result should -- not reference the 'Image'. -> IO b withImage ini f = bracket ini freeImage f -- | Overwrites the pointer with a null pointer, and frees the @gdImage@. -- Safe to call twice. Doesn't free the 'ForeignPtr', we rely on the -- GC to do that. freeImage :: Image -> IO () freeImage (Image fp) = F.withForeignPtr fp $ \pp -> do p <- F.peek pp F.poke pp F.nullPtr unless (p == F.nullPtr) $ gdImageDestroy p withImagePtr :: Image -> (Ptr GDImage -> IO a) -> IO a withImagePtr (Image fp) f = F.withForeignPtr fp $ \pp -> F.peek pp >>= \p -> if p == F.nullPtr then fail "Image has been freed." else f p -- | Create a new empty image. newImage :: Size -> IO Image newImage (w,h) = newImage_ (int w) (int h) newImage_ :: CInt -> CInt -> IO Image newImage_ w h = do p <- F.throwIfNull "gdImageCreateTrueColor" $ gdImageCreateTrueColor w h mkImage p -- | Create a new empty image and apply a function to it. onNewImage :: CInt -> CInt -> (Ptr GDImage -> IO a) -> IO Image onNewImage w h f = newImage_ w h >>= \i -> withImagePtr i f >> return i -- | Make a copy of an image. copyImage :: Image -> IO Image copyImage i = withImagePtr i f where f p = do (w,h) <- imageSize_ p onNewImage w h (\p' -> gdImageCopy p' p 0 0 0 0 w h) -- | Copy a region of one image into another copyRegion :: Point -- ^ Source upper left-hand corner -> Size -- ^ Size of copied region -> Image -- ^ Source image -> Point -- ^ Destination upper left-hand corner -> Image -- ^ Destination image -> IO () copyRegion (srcX, srcY) (w, h) srcIPtr (dstX, dstY) dstIPtr = withImagePtr dstIPtr $ \dstImg -> withImagePtr srcIPtr $ \srcImg -> gdImageCopy dstImg srcImg (int dstX) (int dstY) (int srcX) (int srcY) (int w) (int h) -- | Copy a region of one image into another, rescaling the region copyRegionScaled :: Point -- ^ Source upper left-hand corner -> Size -- ^ Size of source region -> Image -- ^ Source image -> Point -- ^ Destination upper left-hand corner -> Size -- ^ Size of destination region -> Image -- ^ Destination image -> IO () copyRegionScaled (srcX,srcY) (srcW,srcH) srcIPtr (dstX,dstY) (dstW,dstH) dstIPtr = withImagePtr dstIPtr $ \dstImg -> withImagePtr srcIPtr $ \srcImg -> gdImageCopyResampled dstImg srcImg (int dstX) (int dstY) (int srcX) (int srcY) (int dstW) (int dstH) (int srcW) (int srcH) -- -- * Loading images -- -- | Load a JPEG image from a file. loadJpegFile :: FilePath -> IO Image loadJpegFile = loadImageFile gdImageCreateFromJpeg -- | Load a JPEG image from a buffer. loadJpegData :: Int -- ^ Buffer size. -> Ptr a -- ^ Buffer with image data. -> IO Image loadJpegData = loadImageData gdImageCreateFromJpegPtr -- | Load a JPEG image from a ByteString loadJpegByteString :: B.ByteString -> IO Image loadJpegByteString = onByteStringData loadJpegData -- | Load a PNG image from a file. loadPngFile :: FilePath -> IO Image loadPngFile = loadImageFile gdImageCreateFromPng -- | Load a PNG image from a buffer. loadPngData :: Int -- ^ Buffer size. -> Ptr a -- ^ Buffer with image data. -> IO Image loadPngData = loadImageData gdImageCreateFromPngPtr -- | Load a PNG image from a ByteString loadPngByteString :: B.ByteString -> IO Image loadPngByteString = onByteStringData loadPngData -- | Load a GIF image from a file. loadGifFile :: FilePath -> IO Image loadGifFile = loadImageFile gdImageCreateFromGif -- | Load a GIF image from a buffer. loadGifData :: Int -- ^ Buffer size. -> Ptr a -- ^ Buffer with image data. -> IO Image loadGifData = loadImageData gdImageCreateFromGifPtr -- | Load a GIF image from a ByteString loadGifByteString :: B.ByteString -> IO Image loadGifByteString = onByteStringData loadGifData loadImageFile :: (Ptr CFILE -> IO (Ptr GDImage)) -> FilePath -> IO Image loadImageFile f file = do p <- F.throwIfNull ("Loading image from " ++ file) $ withCFILE file "rb" f mkImage p loadImageData :: (CInt -> Ptr a -> IO (Ptr GDImage)) -> Int -> Ptr a -> IO Image loadImageData f sz buf = do p <- F.throwIfNull ("Loading image") $ f (fromIntegral sz) buf mkImage p onByteStringData :: (Int -> Ptr a -> IO b) -> B.ByteString -> IO b onByteStringData f bstr = case B.toForeignPtr bstr of (fptr, start, sz) -> F.withForeignPtr fptr $ \ptr -> f sz (F.plusPtr ptr start) -- -- * Saving images -- -- | Save an image as a JPEG file. saveJpegFile :: Int -- ^ quality: 0-95, or negative for default quality. -> FilePath -> Image -> IO () saveJpegFile q = saveImageFile (\p h -> gdImageJpeg p h (fromIntegral q)) -- | Write a JPEG format ByteString of an image. saveJpegByteString :: Int -> Image -> IO B.ByteString saveJpegByteString q = saveImageByteString (\p h -> gdImageJpegPtr p h (fromIntegral q)) -- | Save an image as a PNG file. savePngFile :: FilePath -> Image -> IO () savePngFile = saveImageFile gdImagePng -- | Write a PNG format ByteString of an image. savePngByteString :: Image -> IO B.ByteString savePngByteString = saveImageByteString gdImagePngPtr -- | Save an image as a GIF file. saveGifFile :: FilePath -> Image -> IO () saveGifFile = saveImageFile gdImageGif -- | Write a GIF format ByteString of an image. saveGifByteString :: Image -> IO B.ByteString saveGifByteString = saveImageByteString gdImageGifPtr saveImageFile :: (Ptr GDImage -> Ptr CFILE -> IO ()) -> FilePath -> Image -> IO () saveImageFile f file i = withImagePtr i (\p -> withCFILE file "wb" (f p)) saveImageByteString :: (Ptr GDImage -> Ptr CInt -> IO (Ptr a)) -> Image -> IO (B.ByteString) saveImageByteString f img = withImagePtr img (\p -> dataByteString (f p)) dataByteString :: (Ptr CInt -> IO (Ptr a)) -> IO B.ByteString dataByteString f = F.alloca $ \szPtr -> do datPtr <- f szPtr >>= F.newForeignPtr gdFree . F.castPtr liftM (B.fromForeignPtr datPtr 0 . fromIntegral) (F.peek szPtr) -- -- * Querying -- -- | Retrieves the color index or the color values of a particular pixel. getPixel :: (Int,Int) -> Image -> IO Color getPixel (x,y) i = withImagePtr i f where f p' = gdImageGetPixel p' (int x) (int y) -- -- * Getting information about images. -- -- | Get the size of an image. imageSize :: Image -> IO (Int,Int) -- ^ (width, height) imageSize i = liftM f $ withImagePtr i imageSize_ where f = (\ (w,h) -> (fromIntegral w, fromIntegral h)) imageSize_ :: Ptr GDImage -> IO (CInt,CInt) imageSize_ p = do w <- #{peek gdImage, sx} p h <- #{peek gdImage, sy} p return (w, h) -- -- * Transforming images. -- -- | Resize an image to a give size. resizeImage :: Int -- ^ width in pixels of output image -> Int -- ^ height in pixels of output image -> Image -> IO Image resizeImage w h i = withImagePtr i f where f p = do let (outW,outH) = (fromIntegral w, fromIntegral h) (inW, inH) <- imageSize_ p onNewImage outW outH $ \p' -> gdImageCopyResampled p' p 0 0 0 0 outW outH inW inH -- | Rotate an image by a multiple of 90 degrees counter-clockwise. rotateImage :: Int -- ^ 1 for 90 degrees counter-clockwise, -- 2 for 180 degrees, etc. -> Image -> IO Image rotateImage r i = withImagePtr i f where f p = do (inW,inH) <- imageSize_ p let q = fromIntegral (r `mod` 4) (outW,outH) | r `mod` 2 == 0 = (inW,inH) | otherwise = (inH,inW) srcX = if q == 1 || q == 2 then inW-1 else 0; srcY = if q == 2 || q == 3 then inH-1 else 0; onNewImage outW outH (\p' -> gdImageCopyRotated90 p' p 0 0 srcX srcY inW inH q) -- -- * Drawing -- -- | Special character for gdBrushed brushed :: PCREOption brushed = PCREOption (#const gdBrushed) -- | Set an @Image@ as a brush for an @Image@ setBrush :: Image -- ^ Source image -> Image -- ^ Brush -> IO () setBrush i b = withImagePtr b $ \brushImg -> withImagePtr i $ \srcImg -> gdImageSetBrush srcImg brushImg -- | Fill the entire image with the given color. fillImage :: Color -> Image -> IO () fillImage c i = do sz <- imageSize i drawFilledRectangle (0,0) sz c i drawFilledRectangle :: Point -- ^ Upper left corner -> Point -- ^ Lower right corner -> Color -> Image -> IO () drawFilledRectangle (x1,y1) (x2,y2) c i = withImagePtr i $ \p -> gdImageFilledRectangle p (int x1) (int y1) (int x2) (int y2) c drawFilledEllipse :: Point -- ^ Center -> Size -- ^ Width and height -> Color -> Image -> IO () drawFilledEllipse (cx,cy) (w,h) c i = withImagePtr i $ \p -> gdImageFilledEllipse p (int cx) (int cy) (int w) (int h) c drawLine :: Point -- ^ Start -> Point -- ^ End -> Color -> Image -> IO () drawLine (x1,y1) (x2,y2) c i = withImagePtr i $ \p -> gdImageLine p (int x1) (int y1) (int x2) (int y2) c drawArc :: Point -- ^ Center -> Size -- ^ Width and height -> Int -- ^ Starting position (degrees) -> Int -- ^ Ending position (degrees) -> Color -> Image -> IO () drawArc (cx,cy) (w,h) sp ep c i = withImagePtr i $ \p -> gdImageArc p (int cx) (int cy) (int w) (int h) (int sp) (int ep) c -- | Use anti-aliasing when performing the given drawing function. -- This can cause a segault with some gd versions. antiAliased :: (Color -> Image -> IO a) -> Color -> Image -> IO a antiAliased f c i = do withImagePtr i (\p -> gdImageSetAntiAliased p c) f (#{const gdAntiAliased}) i setPixel :: Point -> Color -> Image -> IO () setPixel (x,y) c i = withImagePtr i $ \p -> gdImageSetPixel p (int x) (int y) c colorAllocate :: CInt -> CInt -> CInt -> CInt -> Image -> IO Color colorAllocate r g b a i = withImagePtr i $ \p -> gdImageColorAllocate p r g b a -- -- * Text -- -- | Globally switch from using font file names to fontconfig paths -- | for fonts in drawString (and measureString). useFontConfig :: Bool -> IO Bool useFontConfig use = liftM (/= 0) $ gdFTUseFontConfig $ if use then 1 else 0 -- | Draw a string using the FreeType 2.x library drawString :: String -- ^ Font name -> Double -- ^ Font point size -> Double -- ^ Angle in counterclockwise radians -> Point -- ^ Origin -> String -- ^ Text, including HTML entities -> Color -> Image -> IO (Point, Point, Point, Point) -- ^ Bounding box -- of the drawn -- text. drawString fontName ptSize angle (oriX, oriY) txt color img = withImagePtr img $ drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt -- | Measure a string using the FreeType 2.x library. This computes -- the bounding box but does not actually draw the string to any -- image. measureString :: String -- ^ Font name -> Double -- ^ Font point size -> Double -- ^ Angle in counterclockwise radians -> Point -- ^ Origin -> String -- ^ Text, including HTML entities -> Color -> IO (Point, Point, Point, Point) -- ^ Bounding -- box of the -- drawn text measureString fontName ptSize angle (oriX, oriY) txt color = drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt F.nullPtr drawStringImagePtr :: Color -> String -> Double -> Double -> Point -> String -> Ptr GDImage -> IO (Point, Point, Point, Point) drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt imgPtr = F.allocaArray 8 $ \bboxPtr -> C.withCAString fontName $ \cFontName -> C.withCAString txt $ \cTxt -> do res <- gdImageStringFT imgPtr bboxPtr color cFontName (double ptSize) (double angle) (int oriX) (int oriY) cTxt if res == F.nullPtr then F.peekArray 8 bboxPtr >>= parseBBox else C.peekCAString res >>= ioError . userError where parseBBox l = case map int l of [llx, lly, lrx, lry, urx, ury, ulx, uly] -> return ((llx, lly), (lrx, lry), (urx, ury), (ulx, uly)) _ -> ioError $ userError $ "parseBBox with /= 8 elements: " ++ show l -- | Draw strings around the top and bottom of a torus drawStringCircle :: Point -- ^ Center of text path circle -> Double -- ^ Outer radius of text -> Double -- ^ Fraction of radius occupied by text -> Double -- ^ Portion of circle arc filled by text -> String -- ^ Font name -> Double -- ^ Font size hint -> String -- ^ Text to write on the top of the circle -> String -- ^ Text to write on the bottom of the circle -> Color -- ^ Text color -> Image -> IO () drawStringCircle (ctrX, ctrY) rad textRad textFill fontName fontSize topTxt bottomTxt color img = C.withCAString fontName $ \cFontName -> C.withCAString topTxt $ \cTopTxt -> C.withCAString bottomTxt $ \cBottomTxt -> withImagePtr img $ \imgPtr -> do res <- gdImageStringFTCircle imgPtr (int ctrX) (int ctrY) (double rad) (double textRad) (double textFill) cFontName (double fontSize) cTopTxt cBottomTxt color unless (res == F.nullPtr) (C.peekCAString res >>= ioError . userError) saveAlpha :: Bool -> Image -> IO () saveAlpha b i = withImagePtr i $ \p -> gdImageSaveAlpha p $ if b then 1 else 0 alphaBlending :: Bool -> Image -> IO () alphaBlending b i = withImagePtr i $ \p -> gdImageAlphaBlending p $ if b then 1 else 0 -- -- * Colors -- rgb :: Int -- ^ Red (0-255) -> Int -- ^ Green (0-255) -> Int -- ^ Blue (0-255) -> Color rgb r g b = rgba r g b 0 rgba :: Int -- ^ Red (0-255) -> Int -- ^ Green (0-255) -> Int -- ^ Blue (0-255) -> Int -- ^ Alpha (0-127), 0 is opaque, 127 is transparent -> Color rgba r g b a = (int a `F.shiftL` 24) .|. (int r `F.shiftL` 16) .|. (int g `F.shiftL` 8) .|. int b -- -- * Utilities -- int :: (Integral a, Num b) => a -> b int = fromIntegral double :: (Real a, Fractional b) => a -> b double = realToFrac gd-3000.7.3/Graphics/GD/0000755000000000000000000000000011731070661012560 5ustar0000000000000000gd-3000.7.3/Graphics/GD/ByteString.hs0000644000000000000000000002331011731070661015205 0ustar0000000000000000module Graphics.GD.ByteString ( -- * Types Image, Size, Point, Color, -- * Creating and copying images GD.newImage, GD.copyImage, GD.copyRegion, GD.copyRegionScaled, -- * Memory management GD.withImage, -- * Loading images -- ** JPEG loadJpegFile, loadJpegData, loadJpegByteString, -- ** PNG loadPngFile, loadPngData, loadPngByteString, -- ** GIF loadGifFile, loadGifData, loadGifByteString, -- * Saving images -- ** JPEG saveJpegFile, saveJpegByteString, -- ** PNG savePngFile, savePngByteString, -- ** GIF saveGifFile, saveGifByteString, -- * Getting image information GD.imageSize, -- * Querying GD.getPixel, -- * Manipulating images GD.resizeImage, GD.rotateImage, -- * Drawing GD.fillImage, GD.drawFilledRectangle, GD.drawFilledEllipse, GD.drawLine, GD.drawArc, GD.antiAliased, GD.setPixel, -- * Text GD.useFontConfig, drawString, measureString, drawStringCircle, -- * Colors GD.rgb, GD.rgba, GD.toRGBA ) where import Graphics.GD.Internal (Point,Color,Image,GDImage,CFILE,Size) import qualified Graphics.GD.Internal as GD import qualified Data.ByteString as B import qualified Data.ByteString.Internal as BI import Control.Monad (liftM,unless) import Foreign (Ptr) import qualified Foreign as F import Foreign (peek) import Foreign.C (CInt) import Foreign.C (peekCAString,peekCAString) -- -- * Loading images -- -- | Load a JPEG image from a file. loadJpegFile :: FilePath -> IO Image loadJpegFile = loadImageFile GD.gdImageCreateFromJpeg -- | Load a JPEG image from a buffer. loadJpegData :: Int -- ^ Buffer size. -> Ptr a -- ^ Buffer with image data. -> IO Image loadJpegData = loadImageData GD.gdImageCreateFromJpegPtr -- | Load a JPEG image from a ByteString loadJpegByteString :: B.ByteString -> IO Image loadJpegByteString = onByteStringData loadJpegData -- | Load a PNG image from a file. loadPngFile :: FilePath -> IO Image loadPngFile = loadImageFile GD.gdImageCreateFromPng -- | Load a PNG image from a buffer. loadPngData :: Int -- ^ Buffer size. -> Ptr a -- ^ Buffer with image data. -> IO Image loadPngData = loadImageData GD.gdImageCreateFromPngPtr -- | Load a PNG image from a ByteString loadPngByteString :: B.ByteString -> IO Image loadPngByteString = onByteStringData loadPngData -- | Load a GIF image from a file. loadGifFile :: FilePath -> IO Image loadGifFile = loadImageFile GD.gdImageCreateFromGif -- | Load a GIF image from a buffer. loadGifData :: Int -- ^ Buffer size. -> Ptr a -- ^ Buffer with image data. -> IO Image loadGifData = loadImageData GD.gdImageCreateFromGifPtr -- | Load a GIF image from a ByteString loadGifByteString :: B.ByteString -> IO Image loadGifByteString = onByteStringData loadGifData loadImageFile :: (Ptr CFILE -> IO (Ptr GDImage)) -> FilePath -> IO Image loadImageFile f file = do p <- F.throwIfNull ("Loading image from " ++ file) $ GD.withCFILE file "rb" f GD.mkImage p loadImageData :: (CInt -> Ptr a -> IO (Ptr GDImage)) -> Int -> Ptr a -> IO Image loadImageData f sz buf = do p <- F.throwIfNull ("Loading image") $ f (fromIntegral sz) buf GD.mkImage p onByteStringData :: (Int -> Ptr a -> IO b) -> B.ByteString -> IO b onByteStringData f bstr = case BI.toForeignPtr bstr of (fptr, start, sz) -> F.withForeignPtr fptr $ \ptr -> f sz (F.plusPtr ptr start) -- -- * Saving images -- -- | Save an image as a JPEG file. saveJpegFile :: Int -- ^ quality: 0-95, or negative for default quality. -> FilePath -> Image -> IO () saveJpegFile q = saveImageFile (\p h -> GD.gdImageJpeg p h (fromIntegral q)) -- | Write a JPEG format ByteString of an image. saveJpegByteString :: Int -> Image -> IO B.ByteString saveJpegByteString q = saveImageByteString (\p h -> GD.gdImageJpegPtr p h (fromIntegral q)) -- | Save an image as a PNG file. savePngFile :: FilePath -> Image -> IO () savePngFile = saveImageFile GD.gdImagePng -- | Write a PNG format ByteString of an image. savePngByteString :: Image -> IO B.ByteString savePngByteString = saveImageByteString GD.gdImagePngPtr -- | Save an image as a GIF file. saveGifFile :: FilePath -> Image -> IO () saveGifFile = saveImageFile GD.gdImageGif -- | Write a GIF format ByteString of an image. saveGifByteString :: Image -> IO B.ByteString saveGifByteString = saveImageByteString GD.gdImageGifPtr saveImageFile :: (Ptr GDImage -> Ptr CFILE -> IO ()) -> FilePath -> Image -> IO () saveImageFile f file i = GD.withImagePtr i (\p -> GD.withCFILE file "wb" (f p)) saveImageByteString :: (Ptr GDImage -> Ptr CInt -> IO (Ptr a)) -> Image -> IO (B.ByteString) saveImageByteString f img = GD.withImagePtr img (\p -> dataByteString (f p)) dataByteString :: (Ptr CInt -> IO (Ptr a)) -> IO B.ByteString dataByteString f = F.alloca $ \szPtr -> do datPtr <- f szPtr >>= F.newForeignPtr GD.gdFree . F.castPtr liftM (BI.fromForeignPtr datPtr 0 . fromIntegral) (peek szPtr) -- -- * Text -- -- | Draw a string using the FreeType 2.x library drawString :: B.ByteString -- ^ Font name -> Double -- ^ Font point size -> Double -- ^ Angle in counterclockwise radians -> Point -- ^ Origin -> B.ByteString -- ^ Text, including HTML entities -> Color -> Image -> IO (Point, Point, Point, Point) -- ^ Bounding box -- of the drawn -- text drawString fontName ptSize angle (oriX, oriY) txt color img = GD.withImagePtr img $ drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt -- | Measure a string using the FreeType 2.x library. This computes -- the bounding box but does not actually draw the string to any -- image. measureString :: B.ByteString -- ^ Font name -> Double -- ^ Font point size -> Double -- ^ Angle in counterclockwise radians -> Point -- ^ Origin -> B.ByteString -- ^ Text, including HTML entities -> Color -> IO (Point, Point, Point, Point) -- ^ Bounding -- box of the -- drawn text measureString fontName ptSize angle (oriX, oriY) txt color = drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt F.nullPtr drawStringImagePtr :: Color -> B.ByteString -> Double -> Double -> Point -> B.ByteString -> Ptr GDImage -> IO (Point, Point, Point, Point) drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt imgPtr = F.allocaArray 8 $ \bboxPtr -> B.useAsCString fontName $ \cFontName -> B.useAsCString txt $ \cTxt -> do res <- GD.gdImageStringFT imgPtr bboxPtr color cFontName (GD.double ptSize) (GD.double angle) (GD.int oriX) (GD.int oriY) cTxt if res == F.nullPtr then F.peekArray 8 bboxPtr >>= parseBBox else peekCAString res >>= ioError . userError where parseBBox l = case map GD.int l of [llx, lly, lrx, lry, urx, ury, ulx, uly] -> return ((llx, lly), (lrx, lry), (urx, ury), (ulx, uly)) _ -> ioError $ userError $ "parseBBox with /= 8 elements: " ++ show l -- | Draw strings around the top and bottom of a torus drawStringCircle :: Point -- ^ Center of text path circle -> Double -- ^ Outer radius of text -> Double -- ^ Fraction of radius occupied by text -> Double -- ^ Portion of circle arc filled by text -> B.ByteString -- ^ Font name -> Double -- ^ Font size hint -> B.ByteString -- ^ Text to write on the top of the circle -> B.ByteString -- ^ Text to write on the bottom of the circle -> Color -- ^ Text color -> Image -> IO () drawStringCircle (ctrX, ctrY) rad textRad textFill fontName fontSize topTxt bottomTxt color img = B.useAsCString fontName $ \cFontName -> B.useAsCString topTxt $ \cTopTxt -> B.useAsCString bottomTxt $ \cBottomTxt -> GD.withImagePtr img $ \imgPtr -> do res <- GD.gdImageStringFTCircle imgPtr (GD.int ctrX) (GD.int ctrY) (GD.double rad) (GD.double textRad) (GD.double textFill) cFontName (GD.double fontSize) cTopTxt cBottomTxt color unless (res == F.nullPtr) (peekCAString res >>= ioError . userError) gd-3000.7.3/Graphics/GD/Internal.hsc0000644000000000000000000003247011731070661015041 0ustar0000000000000000module Graphics.GD.Internal where import Control.Exception (bracket) import Control.Monad (liftM, unless) import Data.Bits import Foreign (Ptr,FunPtr,ForeignPtr) import Foreign (peek,peekByteOff) import qualified Foreign as F import Foreign.C (CDouble,CInt,CString) import qualified Foreign.C as C data CFILE = CFILE foreign import ccall "stdio.h fopen" c_fopen :: CString -> CString -> IO (Ptr CFILE) foreign import ccall "stdio.h fclose" c_fclose :: Ptr CFILE -> IO CInt fopen :: FilePath -> String -> IO (Ptr CFILE) fopen file mode = C.throwErrnoIfNull file $ C.withCString file $ \f -> C.withCString mode $ \m -> c_fopen f m fclose :: Ptr CFILE -> IO () fclose p = C.throwErrnoIf_ (== #{const EOF}) "fclose" $ c_fclose p withCFILE :: FilePath -> String -> (Ptr CFILE -> IO a) -> IO a withCFILE file mode = bracket (fopen file mode) fclose #include #include "gd-extras.h" data GDImage = GDImage -- JPEG format foreign import ccall "gd.h gdImageCreateFromJpeg" gdImageCreateFromJpeg :: Ptr CFILE -> IO (Ptr GDImage) foreign import ccall "gd.h gdImageCreateFromJpegPtr" gdImageCreateFromJpegPtr :: CInt -> Ptr a -> IO (Ptr GDImage) foreign import ccall "gd.h gdImageJpeg" gdImageJpeg :: Ptr GDImage -> Ptr CFILE -> CInt -> IO () foreign import ccall "gd.h gdImageJpegPtr" gdImageJpegPtr :: Ptr GDImage -> Ptr CInt -> CInt -> IO (Ptr a) -- PNG format foreign import ccall "gd.h gdImageCreateFromPng" gdImageCreateFromPng :: Ptr CFILE -> IO (Ptr GDImage) foreign import ccall "gd.h gdImageCreateFromPngPtr" gdImageCreateFromPngPtr :: CInt -> Ptr a -> IO (Ptr GDImage) foreign import ccall "gd.h gdImagePng" gdImagePng :: Ptr GDImage -> Ptr CFILE -> IO () foreign import ccall "gd.h gdImagePngPtr" gdImagePngPtr :: Ptr GDImage -> Ptr CInt -> IO (Ptr a) -- GIF format foreign import ccall "gd.h gdImageCreateFromGif" gdImageCreateFromGif :: Ptr CFILE -> IO (Ptr GDImage) foreign import ccall "gd.h gdImageCreateFromGifPtr" gdImageCreateFromGifPtr :: CInt -> Ptr a -> IO (Ptr GDImage) foreign import ccall "gd.h gdImageGif" gdImageGif :: Ptr GDImage -> Ptr CFILE -> IO () foreign import ccall "gd.h gdImageGifPtr" gdImageGifPtr :: Ptr GDImage -> Ptr CInt -> IO (Ptr a) -- Creating and destroying images foreign import ccall "gd.h gdImageCreateTrueColor" gdImageCreateTrueColor :: CInt -> CInt -> IO (Ptr GDImage) foreign import ccall "gd.h gdImageDestroy" gdImageDestroy :: Ptr GDImage -> IO () foreign import ccall "gd-extras.h &gdImagePtrDestroyIfNotNull" ptr_gdImagePtrDestroyIfNotNull :: FunPtr (Ptr (Ptr GDImage) -> IO ()) -- Copying image parts foreign import ccall "gd.h gdImageCopy" gdImageCopy :: Ptr GDImage -> Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () foreign import ccall "gd.h gdImageCopyResampled" gdImageCopyResampled :: Ptr GDImage -> Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () {- foreign import ccall "gd.h gdImageCopyRotated" gdImageCopyRotated :: Ptr GDImage -> Ptr GDImage -> CDouble -> CDouble -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () -} foreign import ccall "gd-extras.h gdImageCopyRotated90" gdImageCopyRotated90 :: Ptr GDImage -> Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () foreign import ccall "gd.h gdImageGetPixel" gdImageGetPixel :: Ptr GDImage -> CInt -> CInt -> IO CInt -- Drawing functions foreign import ccall "gd.h gdImageFilledRectangle" gdImageFilledRectangle :: Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () foreign import ccall "gd.h gdImageFilledEllipse" gdImageFilledEllipse :: Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () foreign import ccall "gd.h gdImageLine" gdImageLine :: Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () foreign import ccall "gd.h gdImageArc" gdImageArc :: Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () foreign import ccall "gd.h gdImageSetAntiAliased" gdImageSetAntiAliased :: Ptr GDImage -> CInt -> IO () foreign import ccall "gd.h gdImageSetPixel" gdImageSetPixel :: Ptr GDImage -> CInt -> CInt -> CInt -> IO () -- Text functions foreign import ccall "gd.h gdFTUseFontConfig" gdFTUseFontConfig :: CInt -> IO CInt foreign import ccall "gd.h gdImageStringFT" gdImageStringFT :: Ptr GDImage -> Ptr CInt -> CInt -> CString -> CDouble -> CDouble -> CInt -> CInt -> CString -> IO CString foreign import ccall "gd.h gdImageStringFTCircle" gdImageStringFTCircle :: Ptr GDImage -> CInt -> CInt -> CDouble -> CDouble -> CDouble -> CString -> CDouble -> CString -> CString -> CInt -> IO CString -- Miscellaneous functions foreign import ccall "gd.h &gdFree" gdFree :: FunPtr (Ptr a -> IO ()) -- We use a second level of indirection to allow storing a null pointer -- when the image has already been freed. This allows 'withImage' to -- free the @gdImage@ early. newtype Image = Image (ForeignPtr (Ptr GDImage)) type Size = (Int,Int) type Point = (Int,Int) type Color = CInt mkImage :: Ptr GDImage -> IO Image mkImage img = do fp <- F.mallocForeignPtr F.withForeignPtr fp $ \p -> F.poke p img F.addForeignPtrFinalizer ptr_gdImagePtrDestroyIfNotNull fp return $ Image fp -- | Creates an image, performs an operation on the image, and -- frees it. -- This function allows block scoped management of 'Image' -- objects. If you are handling large images, the delay before -- the finalizer which frees the image runs may cause significant -- temporary extra memory use. Use this function to force the -- image to be freed as soons as you are done with it. Note that -- it is unsafe to hold on to the 'Image' after the function is -- done. withImage :: IO Image -- ^ Image creation action. -> (Image -> IO b) -- ^ Some operation on the image. The result should -- not reference the 'Image'. -> IO b withImage ini f = bracket ini freeImage f -- | Overwrites the pointer with a null pointer, and frees the @gdImage@. -- Safe to call twice. Doesn't free the 'ForeignPtr', we rely on the -- GC to do that. freeImage :: Image -> IO () freeImage (Image fp) = F.withForeignPtr fp $ \pp -> do p <- peek pp F.poke pp F.nullPtr unless (p == F.nullPtr) $ gdImageDestroy p withImagePtr :: Image -> (Ptr GDImage -> IO a) -> IO a withImagePtr (Image fp) f = F.withForeignPtr fp $ \pp -> peek pp >>= \p -> if p == F.nullPtr then fail "Image has been freed." else f p -- | Create a new empty image. newImage :: Size -> IO Image newImage (w,h) = newImage_ (int w) (int h) newImage_ :: CInt -> CInt -> IO Image newImage_ w h = do p <- F.throwIfNull "gdImageCreateTrueColor" $ gdImageCreateTrueColor w h mkImage p -- | Create a new empty image and apply a function to it. onNewImage :: CInt -> CInt -> (Ptr GDImage -> IO a) -> IO Image onNewImage w h f = newImage_ w h >>= \i -> withImagePtr i f >> return i -- | Make a copy of an image. copyImage :: Image -> IO Image copyImage i = withImagePtr i f where f p = do (w,h) <- imageSize_ p onNewImage w h (\p' -> gdImageCopy p' p 0 0 0 0 w h) -- | Copy a region of one image into another copyRegion :: Point -- ^ Source upper left-hand corner -> Size -- ^ Size of copied region -> Image -- ^ Source image -> Point -- ^ Destination upper left-hand corner -> Image -- ^ Destination image -> IO () copyRegion (srcX, srcY) (w, h) srcIPtr (dstX, dstY) dstIPtr = withImagePtr dstIPtr $ \dstImg -> withImagePtr srcIPtr $ \srcImg -> gdImageCopy dstImg srcImg (int dstX) (int dstY) (int srcX) (int srcY) (int w) (int h) -- | Copy a region of one image into another, rescaling the region copyRegionScaled :: Point -- ^ Source upper left-hand corner -> Size -- ^ Size of source region -> Image -- ^ Source image -> Point -- ^ Destination upper left-hand corner -> Size -- ^ Size of destination region -> Image -- ^ Destination image -> IO () copyRegionScaled (srcX, srcY) (srcW, srcH) srcIPtr (dstX, dstY) (dstW, dstH) dstIPtr = withImagePtr dstIPtr $ \dstImg -> withImagePtr srcIPtr $ \srcImg -> gdImageCopyResampled dstImg srcImg (int dstX) (int dstY) (int srcX) (int srcY) (int dstW) (int dstH) (int srcW) (int srcH) -- -- * Querying -- -- | Retrieves the color index or the color values of a particular pixel. getPixel :: (Int,Int) -> Image -> IO Color getPixel (x,y) i = withImagePtr i f where f p' = gdImageGetPixel p' (int x) (int y) -- -- * Getting information about images. -- -- | Get the size of an image. imageSize :: Image -> IO (Int,Int) -- ^ (width, height) imageSize i = liftM f $ withImagePtr i imageSize_ where f = (\ (w,h) -> (fromIntegral w, fromIntegral h)) imageSize_ :: Ptr GDImage -> IO (CInt,CInt) imageSize_ p = do w <- #{peek gdImage, sx} p h <- #{peek gdImage, sy} p return (w, h) -- -- * Transforming images. -- -- | Resize an image to a give size. resizeImage :: Int -- ^ width in pixels of output image -> Int -- ^ height in pixels of output image -> Image -> IO Image resizeImage w h i = withImagePtr i f where f p = do let (outW,outH) = (fromIntegral w, fromIntegral h) (inW, inH) <- imageSize_ p onNewImage outW outH $ \p' -> gdImageCopyResampled p' p 0 0 0 0 outW outH inW inH -- | Rotate an image by a multiple of 90 degrees counter-clockwise. rotateImage :: Int -- ^ 1 for 90 degrees counter-clockwise, -- 2 for 180 degrees, etc. -> Image -> IO Image rotateImage r i = withImagePtr i f where f p = do (inW,inH) <- imageSize_ p let q = fromIntegral (r `mod` 4) (outW,outH) | r `mod` 2 == 0 = (inW,inH) | otherwise = (inH,inW) srcX = if q == 1 || q == 2 then inW-1 else 0; srcY = if q == 2 || q == 3 then inH-1 else 0; onNewImage outW outH (\p' -> gdImageCopyRotated90 p' p 0 0 srcX srcY inW inH q) -- -- * Drawing -- -- | Fill the entire image with the given color. fillImage :: Color -> Image -> IO () fillImage c i = do sz <- imageSize i drawFilledRectangle (0,0) sz c i drawFilledRectangle :: Point -- ^ Upper left corner -> Point -- ^ Lower right corner -> Color -> Image -> IO () drawFilledRectangle (x1,y1) (x2,y2) c i = withImagePtr i $ \p -> gdImageFilledRectangle p (int x1) (int y1) (int x2) (int y2) c drawFilledEllipse :: Point -- ^ Center -> Size -- ^ Width and height -> Color -> Image -> IO () drawFilledEllipse (cx,cy) (w,h) c i = withImagePtr i $ \p -> gdImageFilledEllipse p (int cx) (int cy) (int w) (int h) c drawLine :: Point -- ^ Start -> Point -- ^ End -> Color -> Image -> IO () drawLine (x1,y1) (x2,y2) c i = withImagePtr i $ \p -> gdImageLine p (int x1) (int y1) (int x2) (int y2) c drawArc :: Point -- ^ Center -> Size -- ^ Width and height -> Int -- ^ Starting position (degrees) -> Int -- ^ Ending position (degrees) -> Color -> Image -> IO () drawArc (cx,cy) (w,h) sp ep c i = withImagePtr i $ \p -> gdImageArc p (int cx) (int cy) (int w) (int h) (int sp) (int ep) c -- | Use anti-aliasing when performing the given drawing function. -- This can cause a segault with some gd versions. antiAliased :: (Color -> Image -> IO a) -> Color -> Image -> IO a antiAliased f c i = do withImagePtr i (\p -> gdImageSetAntiAliased p c) f (#{const gdAntiAliased}) i setPixel :: Point -> Color -> Image -> IO () setPixel (x,y) c i = withImagePtr i $ \p -> gdImageSetPixel p (int x) (int y) c -- -- * Colors -- rgb :: Int -- ^ Red (0-255) -> Int -- ^ Green (0-255) -> Int -- ^ Blue (0-255) -> Color rgb r g b = rgba r g b 0 rgba :: Int -- ^ Red (0-255) -> Int -- ^ Green (0-255) -> Int -- ^ Blue (0-255) -> Int -- ^ Alpha (0-127), 0 is opaque, 127 is transparent -> Color rgba r g b a = (int a `F.shiftL` 24) .|. (int r `F.shiftL` 16) .|. (int g `F.shiftL` 8) .|. int b toRGBA :: Color -> (Int, Int, Int, Int) toRGBA c = (fromIntegral r, fromIntegral g, fromIntegral b, fromIntegral a) where b = c `mod` byte g = shiftR c 8 `mod` byte r = shiftR c 16 `mod` byte a = shiftR c 24 `mod` byte byte = 2 ^ (8::Int) -- -- * Text -- -- | Globally switch from using font file names to fontconfig paths -- | for fonts in drawString (and measureString). useFontConfig :: Bool -> IO Bool useFontConfig use = liftM (/= 0) $ gdFTUseFontConfig $ if use then 1 else 0 -- -- * Utilities -- int :: (Integral a, Num b) => a -> b int = fromIntegral double :: (Real a, Fractional b) => a -> b double = realToFrac gd-3000.7.3/Graphics/GD/ByteString/0000755000000000000000000000000011731070661014652 5ustar0000000000000000gd-3000.7.3/Graphics/GD/ByteString/Lazy.hs0000644000000000000000000002367311731070661016140 0ustar0000000000000000module Graphics.GD.ByteString.Lazy ( -- * Types Image, Size, Point, Color, -- * Creating and copying images GD.newImage, GD.copyImage, GD.copyRegion, GD.copyRegionScaled, -- * Memory management GD.withImage, -- * Loading images -- ** JPEG loadJpegFile, loadJpegData, loadJpegByteString, -- ** PNG loadPngFile, loadPngData, loadPngByteString, -- ** GIF loadGifFile, loadGifData, loadGifByteString, -- * Saving images -- ** JPEG saveJpegFile, saveJpegByteString, -- ** PNG savePngFile, savePngByteString, -- ** GIF saveGifFile, saveGifByteString, -- * Getting image information GD.imageSize, -- * Querying GD.getPixel, -- * Manipulating images GD.resizeImage, GD.rotateImage, -- * Drawing GD.fillImage, GD.drawFilledRectangle, GD.drawFilledEllipse, GD.drawLine, GD.drawArc, GD.antiAliased, GD.setPixel, -- * Text GD.useFontConfig, drawString, measureString, drawStringCircle, -- * Colors GD.rgb, GD.rgba, GD.toRGBA ) where import Graphics.GD.Internal (Point,Color,Image,GDImage,CFILE,Size) import qualified Graphics.GD.Internal as GD import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Internal as BI import Control.Monad (liftM,unless) import Foreign (Ptr) import qualified Foreign as F import Foreign (peek) import Foreign.C (CInt) import Foreign.C (peekCAString,peekCAString) -- -- * Loading images -- -- | Load a JPEG image from a file. loadJpegFile :: FilePath -> IO Image loadJpegFile = loadImageFile GD.gdImageCreateFromJpeg -- | Load a JPEG image from a buffer. loadJpegData :: Int -- ^ Buffer size. -> Ptr a -- ^ Buffer with image data. -> IO Image loadJpegData = loadImageData GD.gdImageCreateFromJpegPtr -- | Load a JPEG image from a ByteString loadJpegByteString :: L.ByteString -> IO Image loadJpegByteString = onByteStringData loadJpegData -- | Load a PNG image from a file. loadPngFile :: FilePath -> IO Image loadPngFile = loadImageFile GD.gdImageCreateFromPng -- | Load a PNG image from a buffer. loadPngData :: Int -- ^ Buffer size. -> Ptr a -- ^ Buffer with image data. -> IO Image loadPngData = loadImageData GD.gdImageCreateFromPngPtr -- | Load a PNG image from a ByteString loadPngByteString :: L.ByteString -> IO Image loadPngByteString = onByteStringData loadPngData -- | Load a GIF image from a file. loadGifFile :: FilePath -> IO Image loadGifFile = loadImageFile GD.gdImageCreateFromGif -- | Load a GIF image from a buffer. loadGifData :: Int -- ^ Buffer size. -> Ptr a -- ^ Buffer with image data. -> IO Image loadGifData = loadImageData GD.gdImageCreateFromGifPtr -- | Load a GIF image from a ByteString loadGifByteString :: L.ByteString -> IO Image loadGifByteString = onByteStringData loadGifData loadImageFile :: (Ptr CFILE -> IO (Ptr GDImage)) -> FilePath -> IO Image loadImageFile f file = do p <- F.throwIfNull ("Loading image from " ++ file) $ GD.withCFILE file "rb" f GD.mkImage p loadImageData :: (CInt -> Ptr a -> IO (Ptr GDImage)) -> Int -> Ptr a -> IO Image loadImageData f sz buf = do p <- F.throwIfNull ("Loading image") $ f (fromIntegral sz) buf GD.mkImage p onByteStringData :: (Int -> Ptr a -> IO b) -> L.ByteString -> IO b onByteStringData f bstr = case BI.toForeignPtr (lazyToStrict bstr) of (fptr, start, sz) -> F.withForeignPtr fptr $ \ptr -> f sz (F.plusPtr ptr start) where lazyToStrict :: L.ByteString -> B.ByteString lazyToStrict = foldr1 B.append . L.toChunks -- -- * Saving images -- -- | Save an image as a JPEG file. saveJpegFile :: Int -- ^ quality: 0-95, or negative for default quality. -> FilePath -> Image -> IO () saveJpegFile q = saveImageFile (\p h -> GD.gdImageJpeg p h (fromIntegral q)) -- | Write a JPEG format ByteString of an image. saveJpegByteString :: Int -> Image -> IO L.ByteString saveJpegByteString q = saveImageByteString (\p h -> GD.gdImageJpegPtr p h (fromIntegral q)) -- | Save an image as a PNG file. savePngFile :: FilePath -> Image -> IO () savePngFile = saveImageFile GD.gdImagePng -- | Write a PNG format ByteString of an image. savePngByteString :: Image -> IO L.ByteString savePngByteString = saveImageByteString GD.gdImagePngPtr -- | Save an image as a GIF file. saveGifFile :: FilePath -> Image -> IO () saveGifFile = saveImageFile GD.gdImageGif -- | Write a GIF format ByteString of an image. saveGifByteString :: Image -> IO L.ByteString saveGifByteString = saveImageByteString GD.gdImageGifPtr saveImageFile :: (Ptr GDImage -> Ptr CFILE -> IO ()) -> FilePath -> Image -> IO () saveImageFile f file i = GD.withImagePtr i (\p -> GD.withCFILE file "wb" (f p)) saveImageByteString :: (Ptr GDImage -> Ptr CInt -> IO (Ptr a)) -> Image -> IO (L.ByteString) saveImageByteString f img = GD.withImagePtr img (\p -> dataByteString (f p)) dataByteString :: (Ptr CInt -> IO (Ptr a)) -> IO L.ByteString dataByteString f = F.alloca $ \szPtr -> do datPtr <- f szPtr >>= F.newForeignPtr GD.gdFree . F.castPtr liftM (L.fromChunks . return . BI.fromForeignPtr datPtr 0 . fromIntegral) (peek szPtr) -- -- * Text -- -- | Draw a string using the FreeType 2.x library drawString :: B.ByteString -- ^ Font name -> Double -- ^ Font point size -> Double -- ^ Angle in counterclockwise radians -> Point -- ^ Origin -> B.ByteString -- ^ Text, including HTML entities -> Color -> Image -> IO (Point, Point, Point, Point) -- ^ Bounding box -- of the drawn -- text drawString fontName ptSize angle (oriX, oriY) txt color img = GD.withImagePtr img $ drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt -- | Measure a string using the FreeType 2.x library. This computes -- the bounding box but does not actually draw the string to any -- image. measureString :: B.ByteString -- ^ Font name -> Double -- ^ Font point size -> Double -- ^ Angle in counterclockwise radians -> Point -- ^ Origin -> B.ByteString -- ^ Text, including HTML entities -> Color -> IO (Point, Point, Point, Point) -- ^ Bounding -- box of the -- drawn text measureString fontName ptSize angle (oriX, oriY) txt color = drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt F.nullPtr drawStringImagePtr :: Color -> B.ByteString -> Double -> Double -> Point -> B.ByteString -> Ptr GDImage -> IO (Point, Point, Point, Point) drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt imgPtr = F.allocaArray 8 $ \bboxPtr -> B.useAsCString fontName $ \cFontName -> B.useAsCString txt $ \cTxt -> do res <- GD.gdImageStringFT imgPtr bboxPtr color cFontName (GD.double ptSize) (GD.double angle) (GD.int oriX) (GD.int oriY) cTxt if res == F.nullPtr then F.peekArray 8 bboxPtr >>= parseBBox else peekCAString res >>= ioError . userError where parseBBox l = case map GD.int l of [llx, lly, lrx, lry, urx, ury, ulx, uly] -> return ((llx, lly), (lrx, lry), (urx, ury), (ulx, uly)) _ -> ioError $ userError $ "parseBBox with /= 8 elements: " ++ show l -- | Draw strings around the top and bottom of a torus drawStringCircle :: Point -- ^ Center of text path circle -> Double -- ^ Outer radius of text -> Double -- ^ Fraction of radius occupied by text -> Double -- ^ Portion of circle arc filled by text -> B.ByteString -- ^ Font name -> Double -- ^ Font size hint -> B.ByteString -- ^ Text to write on the top of the circle -> B.ByteString -- ^ Text to write on the bottom of the circle -> Color -- ^ Text color -> Image -> IO () drawStringCircle (ctrX, ctrY) rad textRad textFill fontName fontSize topTxt bottomTxt color img = B.useAsCString fontName $ \cFontName -> B.useAsCString topTxt $ \cTopTxt -> B.useAsCString bottomTxt $ \cBottomTxt -> GD.withImagePtr img $ \imgPtr -> do res <- GD.gdImageStringFTCircle imgPtr (GD.int ctrX) (GD.int ctrY) (GD.double rad) (GD.double textRad) (GD.double textFill) cFontName (GD.double fontSize) cTopTxt cBottomTxt color unless (res == F.nullPtr) (peekCAString res >>= ioError . userError)