packages feed

gd (empty) → 1000.0

raw patch · 9 files changed

+1184/−0 lines, 9 filesdep +basedep +bytestringsetup-changed

Dependencies added: base, bytestring

Files

+ Graphics/GD.hs view
@@ -0,0 +1,216 @@+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)
+ Graphics/GD/ByteString.hs view
@@ -0,0 +1,217 @@+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)
+ Graphics/GD/ByteString/Lazy.hs view
@@ -0,0 +1,224 @@+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
+ Graphics/GD/Internal.hsc view
@@ -0,0 +1,382 @@+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
+ LICENSE view
+ Setup.hs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runghc++import Distribution.Simple+main = defaultMain
+ cbits/gd-extras.c view
@@ -0,0 +1,83 @@+#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,+					int dstX, int dstY,+					int srcX, int srcY,+					int srcW, int srcH, int quadrants)+{+  int dx, dy;  +  /* make sure it's 0-3 */+  int q = (4 + quadrants % 4) % 4;+  int even = q % 2 == 0;+  int cos_q = even ? 1 - q :     0;+  int sin_q = even ?     0 : 2 - q;++  /* hack for figuring out destination width */+  int dstW = even ? srcW : srcH;+  int dstH = even ? srcH : srcW;++  int cmap[gdMaxColors];+  int i;+  for (i = 0; (i < gdMaxColors); i++)+    {+      cmap[i] = (-1);+    }++  for (dy = 0; (dy < dstH); dy++)+    {+      for (dx = 0; (dx < dstW); dx++)+	{+	  int sx = srcX + cos_q * dx - sin_q * dy;+	  int sy = srcY + sin_q * dx + cos_q * dy;+	  if ((sx >= 0) && (sx < srcW) &&+	      (sy >= 0) && (sy < srcH))+	    {+	      int c = gdImageGetPixel (src, sx, sy);++	      if (!src->trueColor)+		{+		  /* Use a table to avoid an expensive+		     lookup on every single pixel */+		  if (cmap[c] == -1)+		    {+		      cmap[c] = gdImageColorResolveAlpha (dst,+							  gdImageRed (src, c),+							  gdImageGreen (src,+									c),+							  gdImageBlue (src,+								       c),+							  gdImageAlpha (src,+									c));+		    }+		  gdImageSetPixel (dst, dstX + dx, dstY + dy, cmap[c]);+		}+	      else+		{+		  gdImageSetPixel (dst,+				   dstX + dx, dstY + dy,+				   gdImageColorResolveAlpha (dst,+							     gdImageRed (src,+									 c),+							     gdImageGreen+							     (src, c),+							     gdImageBlue (src,+									  c),+							     gdImageAlpha+							     (src, c)));+		}++	    }+	}+    }++}
+ cbits/gd-extras.h view
@@ -0,0 +1,24 @@+#ifdef __cplusplus+extern "C" {+#endif++#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,+					int dstX, int dstY,+					int srcX, int srcY,+					int srcW, int srcH, int quadrants);++++#endif++#ifdef __cplusplus+}+#endif
+ gd.cabal view
@@ -0,0 +1,34 @@+Name: gd+Category: Graphics+License-File: LICENSE+Version: 1000.0+Cabal-version: >= 1.2+Build-type: Simple+Copyright: Bjorn Bringert+Maintainer: chrisdone@gmail.com+Author: Bjorn Bringert+License: BSD3+Synopsis: A Haskell binding to a subset of the GD graphics library+Description:+  This is a binding to a (currently very small) subset of+  the GD graphics library.+Extra-source-files:  cbits/gd-extras.h++Flag bytestring-in-base++Library+  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