gd 1000.0 → 3000.0.0

raw patch · 9 files changed

+368/−1075 lines, 9 filesdep −bytestringdep ~basebuild-type:Customnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies removed: bytestring

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Graphics/GD.hs +0/−216
• Graphics/GD.hsc +354/−0
• Graphics/GD/ByteString.hs +0/−217
• Graphics/GD/ByteString/Lazy.hs +0/−224
• Graphics/GD/Internal.hsc +0/−382
• LICENSE +0/−0
• cbits/gd-extras.c +1/−7
• cbits/gd-extras.h +0/−3
• gd.cabal +13/−26

@@ -1,216 +0,0 @@-module Graphics.GD (-                    -- * Types-                    Image, Size, Point, Color,-                    -- * 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-                    fillImage,-                    drawFilledRectangle,-                    drawFilledEllipse,-                    drawLine,-                    drawArc,-                    antiAliased,-                    setPixel,-                    -- * Text-                    useFontConfig,-                    drawString,-                    measureString,-                    drawStringCircle,-                    -- * Colors-                    rgb, rgba-                   ) where--import Graphics.GD.Internal--import qualified Data.ByteString.Internal as B-import Control.Monad (liftM,unless)-import Foreign-import Foreign.C-import Foreign.ForeignPtr-import Foreign.Marshal.Error-import System.IO.Error------- * 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 <- 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 <- 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) -> withForeignPtr fptr (\ptr -> f sz (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 = alloca $ \szPtr -> do datPtr <- f szPtr >>= newForeignPtr gdFree . castPtr-                                         liftM (B.fromForeignPtr datPtr 0 . fromIntegral) (peek szPtr)------- * Text------- | 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 nullPtr--drawStringImagePtr :: Color -> String -> Double -> Double -> Point -> String -> Ptr GDImage -> IO (Point, Point, Point, Point)-drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt imgPtr-    = allocaArray 8 $-      \bboxPtr -> withCAString fontName $-      \cFontName -> withCAString txt $-      \cTxt -> do res <- gdImageStringFT imgPtr bboxPtr color cFontName (double ptSize) (double angle) (int oriX) (int oriY) cTxt-                  if res == nullPtr-                     then peekArray 8 bboxPtr >>= parseBBox-                     else 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-    = withCAString fontName $ -      \cFontName -> withCAString topTxt $-      \cTopTxt -> 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 == nullPtr) (peekCAString res >>= ioError . userError)

@@ -0,0 +1,354 @@+module Graphics.GD (+                    -- * Types+                    Image, Size, Point, Color,+                    -- * Creating and copying images+                    newImage, copyImage,+                    -- * Loading images+                    -- ** JPEG+                    loadJpegFile, loadJpegData, +                    -- ** PNG+                    loadPngFile, loadPngData, +                    -- ** GIF+                    loadGifFile, loadGifData, +                    -- * Saving images+                    -- ** JPEG+                    saveJpegFile,+                    -- ** PNG+                    savePngFile,+                    -- ** GIF+                    saveGifFile,+                    -- * Getting image information+                    imageSize,+                    -- * Manipulating images+                    resizeImage, rotateImage,+                    -- * Drawing+                    fillImage,+                    drawFilledRectangle,+                    drawFilledEllipse, +                    antiAliased,+                    -- * Colors+                    rgb, rgba+                   ) where++import Control.Exception (bracket)+import Control.Monad (liftM)+import Foreign+import Foreign.C+import Foreign.ForeignPtr+import Foreign.Marshal.Error++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 = +    throwErrnoIfNull file $ withCString file $ +                         \f -> withCString mode $ \m -> c_fopen f m++fclose :: Ptr CFILE -> IO ()+fclose p = 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 <gd.h>+#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 ()+++-- 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 ()+++-- 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 ()+++-- Creating and destroying images++foreign import ccall "gd.h gdImageCreateTrueColor" gdImageCreateTrueColor +    :: CInt -> CInt -> IO (Ptr GDImage)++foreign import ccall "gd.h &gdImageDestroy" ptr_gdImageDestroy +    :: FunPtr (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 ()+++-- 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 gdImageSetAntiAliased" gdImageSetAntiAliased+    :: Ptr GDImage -> CInt -> IO ()+++++type Image = ForeignPtr GDImage++type Size = (Int,Int)++type Point = (Int,Int)++type Color = CInt+++-- | Call gd_free_image when the image is garbage collected.+mkImage :: Ptr GDImage -> IO Image+mkImage p = newForeignPtr ptr_gdImageDestroy p+++withImage :: Image -> (Ptr GDImage -> IO a) -> IO a+withImage = withForeignPtr++-- | 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 <- 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 -> withImage i f >> return i++-- | Make a copy of an image.+copyImage :: Image -> IO Image+copyImage i = withImage i f+  where f p = do (w,h) <- imageSize_ p+                 onNewImage w h (\p' -> gdImageCopy p' p 0 0 0 0 w h)++++--+-- * 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 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 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+++loadImageFile :: (Ptr CFILE -> IO (Ptr GDImage)) -> FilePath -> IO Image+loadImageFile f file = +    do p <- 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 <- throwIfNull ("Loading image") $ f (fromIntegral sz) buf+       mkImage p++--+-- * 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))++-- | Save an image as a PNG file.+savePngFile :: FilePath -> Image -> IO ()+savePngFile = saveImageFile gdImagePng++-- | Save an image as a GIF file.+saveGifFile :: FilePath -> Image -> IO ()+saveGifFile = saveImageFile gdImageGif++saveImageFile :: (Ptr GDImage -> Ptr CFILE -> IO ()) -> FilePath -> Image -> IO ()+saveImageFile f file i = withImage i (\p -> withCFILE file "wb" (f p))++--+-- * Getting information about images.+--++-- | Get the size of an image.+imageSize :: Image -> IO (Int,Int) -- ^ (width, height)+imageSize i = liftM f $ withImage 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 = withImage 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 = withImage 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 =+    withImage 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 =+    withImage i $ \p -> +        gdImageFilledEllipse p (int cx) (int cy) (int w) (int h) 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 withImage i (\p -> gdImageSetAntiAliased p c)+       f (#{const gdAntiAliased}) i++--+-- * 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 `shiftL` 24) .|.+    (int r `shiftL` 16) .|.+    (int g `shiftL` 8)  .|.+    int b+++--+-- * Utilities+--++int :: (Integral a, Num b) => a -> b+int = fromIntegral

@@ -1,217 +0,0 @@-module Graphics.GD.ByteString (-                    -- * Types-                    Image, Size, Point, Color,-                    -- * 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-                    fillImage,-                    drawFilledRectangle,-                    drawFilledEllipse,-                    drawLine,-                    drawArc,-                    antiAliased,-                    setPixel,-                    -- * Text-                    useFontConfig,-                    drawString,-                    measureString,-                    drawStringCircle,-                    -- * Colors-                    rgb, rgba-                   ) where--import Graphics.GD.Internal--import qualified Data.ByteString as B-import qualified Data.ByteString.Internal as BI--import Control.Monad (liftM,unless)-import Foreign-import Foreign.C-import Foreign.ForeignPtr-import Foreign.Marshal.Error------- * 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 <- 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 <- throwIfNull ("Loading image") $ f (fromIntegral sz) buf-       mkImage p--onByteStringData :: (Int -> Ptr a -> IO b) -> B.ByteString -> IO b-onByteStringData f bstr -    = case BI.toForeignPtr bstr of-        (fptr, start, sz) -> withForeignPtr fptr (\ptr -> f sz (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 = alloca $ \szPtr -> do datPtr <- f szPtr >>= newForeignPtr gdFree . 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-    = 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 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-    = allocaArray 8 $-      \bboxPtr -> B.useAsCString fontName $-      \cFontName -> B.useAsCString txt $-      \cTxt -> do res <- gdImageStringFT imgPtr bboxPtr color cFontName (double ptSize) (double angle) (int oriX) (int oriY) cTxt-                  if res == nullPtr-                     then peekArray 8 bboxPtr >>= parseBBox-                     else 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-                 -> 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 -> 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 == nullPtr) (peekCAString res >>= ioError . userError)

@@ -1,224 +0,0 @@-module Graphics.GD.ByteString.Lazy (-                    -- * Types-                    Image, Size, Point, Color,-                    -- * 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-                    fillImage,-                    drawFilledRectangle,-                    drawFilledEllipse,-                    drawLine,-                    drawArc,-                    antiAliased,-                    setPixel,-                    -- * Text-                    useFontConfig,-                    drawString,-                    measureString,-                    drawStringCircle,-                    -- * Colors-                    rgb, rgba-                   ) where--import Graphics.GD.Internal--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-import Foreign.C-import Foreign.ForeignPtr-import Foreign.Marshal.Error------- * 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 :: L.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 :: L.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 :: L.ByteString -> IO Image-loadGifByteString = onByteStringData loadGifData---loadImageFile :: (Ptr CFILE -> IO (Ptr GDImage)) -> FilePath -> IO Image-loadImageFile f file = -    do p <- 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 <- throwIfNull ("Loading image") $ f (fromIntegral sz) buf-       mkImage p--onByteStringData :: (Int -> Ptr a -> IO b) -> L.ByteString -> IO b-onByteStringData f bstr -    = case BI.toForeignPtr (lazyToStrict bstr) of-        (fptr, start, sz) -> withForeignPtr fptr (\ptr -> f sz (plusPtr ptr start))--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 -> gdImageJpeg p h (fromIntegral q))---- | Write a JPEG format ByteString of an image.-saveJpegByteString :: Int -> Image -> IO L.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 L.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 L.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 (L.ByteString)-saveImageByteString f img = withImagePtr img (\p -> dataByteString (f p))--dataByteString :: (Ptr CInt -> IO (Ptr a)) -> IO L.ByteString-dataByteString f = alloca $ \szPtr -> do datPtr <- f szPtr >>= newForeignPtr gdFree . castPtr-                                         liftM (L.fromChunks . return . BI.fromForeignPtr datPtr 0 . fromIntegral) (peek szPtr)------- * Text------- | Draw a ByteString using the FreeType 2.x library-drawString :: L.ByteString -- ^ Font name-             -> Double       -- ^ Font point size-             -> Double       -- ^ Angle in counterclockwise radians-             -> Point        -- ^ Origin-             -> L.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-    = 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 :: L.ByteString -- ^ Font name-              -> Double -- ^ Font point size-              -> Double -- ^ Angle in counterclockwise radians-              -> Point -- ^ Origin-              -> L.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 nullPtr--drawStringImagePtr :: Color -> L.ByteString -> Double -> Double -> Point -> L.ByteString -> Ptr GDImage -> IO (Point, Point, Point, Point)-drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt imgPtr-    = allocaArray 8 $-      \bboxPtr -> toCStr fontName $-      \cFontName -> toCStr txt $-      \cTxt -> do res <- gdImageStringFT imgPtr bboxPtr color cFontName (double ptSize) (double angle) (int oriX) (int oriY) cTxt-                  if res == nullPtr-                     then peekArray 8 bboxPtr >>= parseBBox-                     else 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-                 -> L.ByteString -- ^ Font name-                 -> Double -- ^ Font size hint-                 -> L.ByteString -- ^ Text to write on the top of the circle-                 -> L.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-    = toCStr fontName $ -      \cFontName -> toCStr topTxt $-      \cTopTxt -> toCStr 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 == nullPtr) (peekCAString res >>= ioError . userError)--toCStr :: L.ByteString -> (CString -> IO a) -> IO a-toCStr = B.useAsCString . lazyToStrict

@@ -1,382 +0,0 @@-module Graphics.GD.Internal where--import Control.Exception (bracket)-import Control.Monad (liftM, unless)-import Foreign-import Foreign.C-import Foreign.ForeignPtr-import Foreign.Marshal.Error--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 = -    throwErrnoIfNull file $ withCString file $ -                         \f -> withCString mode $ \m -> c_fopen f m--fclose :: Ptr CFILE -> IO ()-fclose p = 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 <gd.h>-#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 <- mallocForeignPtr-                 withForeignPtr fp $ \p -> poke p img-                 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) = withForeignPtr fp $ -  \pp -> do p <- peek pp-            poke pp nullPtr-            unless (p == nullPtr) $ gdImageDestroy p--withImagePtr :: Image -> (Ptr GDImage -> IO a) -> IO a-withImagePtr (Image fp) f = withForeignPtr fp $-  \pp -> peek pp >>= \p -> if p == 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 <- 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 `shiftL` 24) .|.-    (int r `shiftL` 16) .|.-    (int g `shiftL` 8)  .|.-    int b------- * 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

@@ -1,13 +1,7 @@ #include <gd.h> #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,

@@ -5,9 +5,6 @@ #ifndef GD_EXTRAS_H #define G_DEXTRAS_H 1 -#include <gd.h>--BGD_DECLARE(void) gdImagePtrDestroyIfNotNull (gdImagePtr *im);  BGD_DECLARE(void) gdImageCopyRotated90 (gdImagePtr dst, 					gdImagePtr src,

@@ -1,34 +1,21 @@ Name: gd-Category: Graphics-License-File: LICENSE-Version: 1000.0-Cabal-version: >= 1.2-Build-type: Simple+Version: 3000.0.0 Copyright: Bjorn Bringert-Maintainer: chrisdone@gmail.com+Maintainer: bjorn@bringert.net Author: Bjorn Bringert License: BSD3+build-depends: base+Extensions: ForeignFunctionInterface 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-  if flag(bytestring-in-base)-    -- bytestring was in base-2.0 and 2.1.1-    Build-depends: base >= 2.0 && < 2.2-  else-    -- in base 1.0 and 3.0 bytestring is a separate package-    Build-depends: base < 2.0 || >= 3, bytestring >= 0.9-  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+Exposed-Modules: Graphics.GD+ghc-options: -O2 -Wall -fffi+extra-libraries: gd, jpeg, m, png+includes: gd.h+include-dirs:        cbits+install-includes: gd-extras.h+c-sources:           cbits/gd-extras.c+extra-source-files:  cbits/gd-extras.h+cc-options: -O2