gd 3000.4.0 → 3000.5.0

raw patch · 6 files changed

+1002/−88 lines, 6 filesdep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, bytestring

API changes (from Hackage documentation)

Files

• Graphics/GD.hsc +110/−78
• Graphics/GD/ByteString.hs +244/−0
• Graphics/GD/ByteString/Lazy.hs +248/−0
• Graphics/GD/Internal.hsc +392/−0
• LICENSE +0/−0
• gd.cabal +8/−10

@@ -40,14 +40,15 @@                     rgb, rgba                    ) where -import Control.Exception (bracket)-import Control.Monad (liftM, unless)+import           Control.Exception        (bracket)+import           Control.Monad            (liftM, unless) import qualified Data.ByteString.Internal as B-import Foreign-import Foreign.C-import Foreign.ForeignPtr-import Foreign.Marshal.Error-import System.IO.Error+import           Foreign                  (Ptr,FunPtr,ForeignPtr)+import           Foreign                  (peekByteOff)+import qualified Foreign                  as F+import           Foreign                  ((.|.))+import           Foreign.C                (CInt,CString,CDouble)+import qualified Foreign.C                as C  data CFILE = CFILE @@ -58,11 +59,11 @@  fopen :: FilePath -> String -> IO (Ptr CFILE) fopen file mode = -    throwErrnoIfNull file $ withCString file $ -                         \f -> withCString mode $ \m -> c_fopen f m+    C.throwErrnoIfNull file $ C.withCString file $ +                         \f -> C.withCString mode $ \m -> c_fopen f m  fclose :: Ptr CFILE -> IO ()-fclose p = throwErrnoIf_ (== #{const EOF}) "fclose" $ c_fclose p+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@@ -122,7 +123,8 @@ foreign import ccall "gd.h gdImageDestroy" gdImageDestroy     :: Ptr GDImage -> IO () -foreign import ccall "gd-extras.h &gdImagePtrDestroyIfNotNull" ptr_gdImagePtrDestroyIfNotNull +foreign import ccall "gd-extras.h &gdImagePtrDestroyIfNotNull"+        ptr_gdImagePtrDestroyIfNotNull      :: FunPtr (Ptr (Ptr GDImage) -> IO ())  @@ -178,10 +180,12 @@     :: CInt -> IO CInt  foreign import ccall "gd.h gdImageStringFT" gdImageStringFT-    :: Ptr GDImage -> Ptr CInt -> CInt -> CString -> CDouble -> CDouble -> CInt -> CInt -> CString -> IO CString+    :: 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+    :: Ptr GDImage -> CInt -> CInt -> CDouble -> CDouble -> CDouble -> CString+       -> CDouble -> CString -> CString -> CInt -> IO CString  -- Miscellaneous functions @@ -200,20 +204,21 @@ type Color = CInt  mkImage :: Ptr GDImage -> IO Image-mkImage img = do fp <- mallocForeignPtr-                 withForeignPtr fp $ \p -> poke p img-                 addForeignPtrFinalizer ptr_gdImagePtrDestroyIfNotNull fp+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.+-- 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@@ -223,21 +228,22 @@ -- 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+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 = withForeignPtr fp $-  \pp -> peek pp >>= \p -> if p == nullPtr then fail "Image has been freed." else f p+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 <- throwIfNull "gdImageCreateTrueColor" $+newImage_ w h = do p <- F.throwIfNull "gdImageCreateTrueColor" $                         gdImageCreateTrueColor w h                    mkImage p @@ -252,8 +258,8 @@                  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+copyRegion :: Point    -- ^ Source upper left-hand corner+              -> Size  -- ^ Size of copied region               -> Image -- ^ Source image               -> Point -- ^ Destination upper left-hand corner               -> Image -- ^ Destination image@@ -261,20 +267,23 @@ 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)+      \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+                 -> Size  -- ^ Size of source region                  -> Image -- ^ Source image                  -> Point -- ^ Destination upper left-hand corner-                 -> Size -- ^ Size of destination region+                 -> Size  -- ^ Size of destination region                  -> Image -- ^ Destination image                  -> IO ()-copyRegionScaled (srcX, srcY) (srcW, srcH) srcIPtr (dstX, dstY) (dstW, dstH) dstIPtr+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)+      \srcImg -> gdImageCopyResampled dstImg srcImg+                   (int dstX) (int dstY) (int srcX) (int srcY)+                   (int dstW) (int dstH) (int srcW) (int srcH)  -- -- * Loading images@@ -285,7 +294,7 @@ loadJpegFile = loadImageFile gdImageCreateFromJpeg  -- | Load a JPEG image from a buffer.-loadJpegData :: Int -- ^ Buffer size.+loadJpegData :: Int   -- ^ Buffer size.              -> Ptr a -- ^ Buffer with image data.              -> IO Image loadJpegData = loadImageData gdImageCreateFromJpegPtr@@ -300,7 +309,7 @@ loadPngFile = loadImageFile gdImageCreateFromPng  -- | Load a PNG image from a buffer.-loadPngData :: Int -- ^ Buffer size.+loadPngData :: Int   -- ^ Buffer size.             -> Ptr a -- ^ Buffer with image data.             -> IO Image loadPngData = loadImageData gdImageCreateFromPngPtr@@ -314,7 +323,7 @@ loadGifFile = loadImageFile gdImageCreateFromGif  -- | Load a GIF image from a buffer.-loadGifData :: Int -- ^ Buffer size.+loadGifData :: Int   -- ^ Buffer size.             -> Ptr a -- ^ Buffer with image data.             -> IO Image loadGifData = loadImageData gdImageCreateFromGifPtr@@ -325,19 +334,20 @@   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+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 <- throwIfNull ("Loading image") $ f (fromIntegral sz) buf-       mkImage p+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) -> withForeignPtr fptr (\ptr -> f sz (plusPtr ptr start))+onByteStringData f bstr =+    case B.toForeignPtr bstr of+      (fptr, start, sz) -> F.withForeignPtr fptr $+                           \ptr -> f sz (F.plusPtr ptr start)  -- -- * Saving images@@ -350,7 +360,8 @@  -- | Write a JPEG format ByteString of an image. saveJpegByteString :: Int -> Image -> IO B.ByteString-saveJpegByteString q = saveImageByteString (\p h -> gdImageJpegPtr p h (fromIntegral q))+saveJpegByteString q =+  saveImageByteString (\p h -> gdImageJpegPtr p h (fromIntegral q))   -- | Save an image as a PNG file.@@ -370,15 +381,18 @@ saveGifByteString :: Image -> IO B.ByteString saveGifByteString = saveImageByteString gdImageGifPtr -saveImageFile :: (Ptr GDImage -> Ptr CFILE -> IO ()) -> FilePath -> Image -> IO ()+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 :: (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)+dataByteString f = F.alloca $ \szPtr -> do+    datPtr <- f szPtr >>= F.newForeignPtr gdFree . F.castPtr+    liftM (B.fromForeignPtr datPtr 0 . fromIntegral) (F.peek szPtr)                                         -- -- * Getting information about images.@@ -491,9 +505,13 @@            -> 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+           -> 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+    = 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@@ -503,22 +521,31 @@               -> Double -- ^ Angle in counterclockwise radians               -> Point -- ^ Origin               -> String -- ^ Text, including HTML entities-              -> Color -> IO (Point, Point, Point, Point) -- ^ Bounding box of the drawn text+              -> 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 fontName ptSize angle (oriX, oriY) txt F.nullPtr -drawStringImagePtr :: Color -> String -> Double -> Double -> Point -> String -> Ptr GDImage -> IO (Point, Point, Point, Point)+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+    = 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@@ -531,13 +558,18 @@                  -> 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 $ +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 == nullPtr) (peekCAString res >>= ioError . userError)+      \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)  -- -- * Colors@@ -555,9 +587,9 @@           -> 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 a `F.shiftL` 24) .|.+    (int r `F.shiftL` 16) .|.+    (int g `F.shiftL` 8)  .|.     int b  

@@ -0,0 +1,244 @@+module 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+                   ) 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)

@@ -0,0 +1,248 @@+module 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+                   ) 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)

@@ -0,0 +1,392 @@+module Graphics.GD.Internal where++import           Control.Exception (bracket)+import           Control.Monad     (liftM, unless)+import           Foreign           (Ptr,FunPtr,ForeignPtr)+import qualified Foreign           as F+import           Foreign           (peek,peekByteOff,(.|.))+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 <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 <- 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++--+-- * 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,9 +1,11 @@ Name: gd-Version: 3000.4.0+Category: Graphics+License-File: LICENSE+Version: 3000.5.0 Cabal-version: >= 1.2 Build-type: Simple Copyright: Bjorn Bringert-Maintainer: bjorn@bringert.net+Maintainer: Chris Done <chrisdone@gmail.com> Author: Bjorn Bringert License: BSD3 Synopsis: A Haskell binding to a subset of the GD graphics library@@ -15,17 +17,13 @@ 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+  Build-depends: base >= 4 && < 5, bytestring >= 0.9.1.6   Extensions: ForeignFunctionInterface-  Exposed-Modules: Graphics.GD+  Exposed-Modules: Graphics.GD, Graphics.GD.ByteString, Graphics.GD.ByteString.Lazy   Ghc-options: -Wall-  Extra-libraries: gd, png, z, jpeg, m, fontconfig, freetype, pthread, expat+  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