module Graphics.GD.ByteString.Lazy (
Image, Size, Point, Color,
GD.newImage, GD.copyImage,
GD.copyRegion, GD.copyRegionScaled,
GD.withImage,
loadJpegFile, loadJpegData, loadJpegByteString,
loadPngFile, loadPngData, loadPngByteString,
loadGifFile, loadGifData, loadGifByteString,
saveJpegFile, saveJpegByteString,
savePngFile, savePngByteString,
saveGifFile, saveGifByteString,
GD.imageSize,
GD.getPixel,
GD.resizeImage, GD.rotateImage,
GD.fillImage,
GD.drawFilledRectangle,
GD.drawFilledEllipse,
GD.drawLine,
GD.drawArc,
GD.antiAliased,
GD.setPixel,
GD.useFontConfig,
drawString,
measureString,
drawStringCircle,
GD.rgb, GD.rgba, GD.toRGBA
) where
import Graphics.GD.Internal (Point,Color,Image,GDImage,CFILE,Size)
import qualified Graphics.GD.Internal as GD
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Internal as BI
import Control.Monad (liftM,unless)
import Foreign (Ptr)
import qualified Foreign as F
import Foreign (peek)
import Foreign.C (CInt)
import Foreign.C (peekCAString,peekCAString)
loadJpegFile :: FilePath -> IO Image
loadJpegFile = loadImageFile GD.gdImageCreateFromJpeg
loadJpegData :: Int
-> Ptr a
-> IO Image
loadJpegData = loadImageData GD.gdImageCreateFromJpegPtr
loadJpegByteString :: L.ByteString -> IO Image
loadJpegByteString = onByteStringData loadJpegData
loadPngFile :: FilePath -> IO Image
loadPngFile = loadImageFile GD.gdImageCreateFromPng
loadPngData :: Int
-> Ptr a
-> IO Image
loadPngData = loadImageData GD.gdImageCreateFromPngPtr
loadPngByteString :: L.ByteString -> IO Image
loadPngByteString = onByteStringData loadPngData
loadGifFile :: FilePath -> IO Image
loadGifFile = loadImageFile GD.gdImageCreateFromGif
loadGifData :: Int
-> Ptr a
-> IO Image
loadGifData = loadImageData GD.gdImageCreateFromGifPtr
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
saveJpegFile :: Int
-> FilePath -> Image -> IO ()
saveJpegFile q = saveImageFile (\p h -> GD.gdImageJpeg p h (fromIntegral q))
saveJpegByteString :: Int -> Image -> IO L.ByteString
saveJpegByteString q =
saveImageByteString (\p h -> GD.gdImageJpegPtr p h (fromIntegral q))
savePngFile :: FilePath -> Image -> IO ()
savePngFile = saveImageFile GD.gdImagePng
savePngByteString :: Image -> IO L.ByteString
savePngByteString = saveImageByteString GD.gdImagePngPtr
saveGifFile :: FilePath -> Image -> IO ()
saveGifFile = saveImageFile GD.gdImageGif
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)
drawString :: B.ByteString
-> Double
-> Double
-> Point
-> B.ByteString
-> Color -> Image
-> IO (Point, Point, Point, Point)
drawString fontName ptSize angle (oriX, oriY) txt color img =
GD.withImagePtr img $ drawStringImagePtr color fontName ptSize angle
(oriX, oriY) txt
measureString :: B.ByteString
-> Double
-> Double
-> Point
-> B.ByteString
-> Color
-> IO (Point, Point, Point, Point)
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
drawStringCircle :: Point
-> Double
-> Double
-> Double
-> B.ByteString
-> Double
-> B.ByteString
-> B.ByteString
-> 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)