gd 3000.2.0 → 3000.3.0
raw patch · 2 files changed
+163/−9 lines, 2 files
Files
- Graphics/GD.hsc +161/−7
- gd.cabal +2/−2
Graphics/GD.hsc view
@@ -2,23 +2,24 @@ -- * Types Image, Size, Point, Color, -- * Creating and copying images- newImage, copyImage,+ newImage, copyImage, + copyRegion, copyRegionScaled, -- * Memory management withImage, -- * Loading images -- ** JPEG- loadJpegFile, loadJpegData, + loadJpegFile, loadJpegData, loadJpegByteString, -- ** PNG- loadPngFile, loadPngData, + loadPngFile, loadPngData, loadPngByteString, -- ** GIF- loadGifFile, loadGifData, + loadGifFile, loadGifData, loadGifByteString, -- * Saving images -- ** JPEG- saveJpegFile,+ saveJpegFile, saveJpegByteString, -- ** PNG- savePngFile,+ savePngFile, savePngByteString, -- ** GIF- saveGifFile,+ saveGifFile, saveGifByteString, -- * Getting image information imageSize, -- * Manipulating images@@ -31,16 +32,22 @@ drawArc, antiAliased, setPixel,+ -- * Text+ useFontConfig,+ drawString, measureString,+ drawStringCircle, -- * Colors rgb, rgba ) where import Control.Exception (bracket) import Control.Monad (liftM, unless)+import qualified Data.ByteString.Base as B import Foreign import Foreign.C import Foreign.ForeignPtr import Foreign.Marshal.Error+import System.IO.Error data CFILE = CFILE @@ -76,6 +83,8 @@ 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 @@ -88,6 +97,8 @@ 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 @@ -100,6 +111,8 @@ 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 @@ -159,7 +172,22 @@ 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.@@ -223,7 +251,30 @@ where f p = do (w,h) <- imageSize_ p onNewImage w h (\p' -> gdImageCopy p' p 0 0 0 0 w h) +-- | Copy a region of one image into another+copyRegion :: Point -- ^ Source upper left-hand corner+ -> Size -- ^ Size of copied region+ -> Image -- ^ Source image+ -> Point -- ^ Destination upper left-hand corner+ -> Image -- ^ Destination image+ -> IO ()+copyRegion (srcX, srcY) (w, h) srcIPtr (dstX, dstY) dstIPtr+ = withImagePtr dstIPtr $+ \dstImg -> withImagePtr srcIPtr $+ \srcImg -> gdImageCopy dstImg srcImg (int dstX) (int dstY) (int srcX) (int srcY) (int w) (int h) +-- | Copy a region of one image into another, rescaling the region +copyRegionScaled :: Point -- ^ Source upper left-hand corner+ -> Size -- ^ Size of source region+ -> Image -- ^ Source image+ -> Point -- ^ Destination upper left-hand corner+ -> Size -- ^ Size of destination region+ -> Image -- ^ Destination image+ -> IO ()+copyRegionScaled (srcX, srcY) (srcW, srcH) srcIPtr (dstX, dstY) (dstW, dstH) dstIPtr+ = withImagePtr dstIPtr $+ \dstImg -> withImagePtr srcIPtr $+ \srcImg -> gdImageCopyResampled dstImg srcImg (int dstX) (int dstY) (int srcX) (int srcY) (int dstW) (int dstH) (int srcW) (int srcH) -- -- * Loading images@@ -239,7 +290,11 @@ -> 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@@ -250,6 +305,9 @@ -> 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@@ -261,7 +319,11 @@ -> 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@@ -272,6 +334,11 @@ 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 --@@ -281,17 +348,38 @@ -> 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 . fromIntegral) (peek szPtr)+ -- -- * Getting information about images. --@@ -389,6 +477,69 @@ gdImageSetPixel p (int x) (int y) c --+-- * Text+--++-- | Globally switch from using font file names to fontconfig paths+-- | for fonts in drawString (and measureString).+useFontConfig :: Bool -> IO Bool+useFontConfig use = liftM (/= 0) $ gdFTUseFontConfig $ if use then 1 else 0++-- | Draw a string using the FreeType 2.x library+drawString :: String -- ^ Font name+ -> Double -- ^ Font point size+ -> Double -- ^ Angle in counterclockwise radians+ -> Point -- ^ Origin+ -> String -- ^ Text, including HTML entities+ -> Color -> Image -> IO (Point, Point, Point, Point) -- ^ Bounding box of the drawn text+drawString fontName ptSize angle (oriX, oriY) txt color img+ = withImagePtr img $ drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt++-- | Measure a string using the FreeType 2.x library. This computes+-- the bounding box but does not actually draw the string to any+-- image.+measureString :: String -- ^ Font name+ -> Double -- ^ Font point size+ -> Double -- ^ Angle in counterclockwise radians+ -> Point -- ^ Origin+ -> String -- ^ Text, including HTML entities+ -> Color -> IO (Point, Point, Point, Point) -- ^ Bounding box of the drawn text+measureString fontName ptSize angle (oriX, oriY) txt color+ = drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt 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)++-- -- * Colors -- @@ -416,3 +567,6 @@ int :: (Integral a, Num b) => a -> b int = fromIntegral++double :: (Real a, Fractional b) => a -> b+double = realToFrac
gd.cabal view
@@ -1,5 +1,5 @@ Name: gd-Version: 3000.2.0+Version: 3000.3.0 Copyright: Bjorn Bringert Maintainer: bjorn@bringert.net Author: Bjorn Bringert@@ -12,7 +12,7 @@ the GD graphics library. Exposed-Modules: Graphics.GD ghc-options: -O2 -Wall -fffi-extra-libraries: gd, jpeg, m, png+extra-libraries: gd, png, z, jpeg, m, fontconfig, freetype, pthread, expat includes: gd.h include-dirs: cbits install-includes: gd-extras.h