{-# LINE 1 "Graphics/GD.hsc" #-}
{-# LANGUAGE EmptyDataDecls #-}
module Graphics.GD (
Image, Size, Point, Color, PCREOption(..),
newImage, copyImage,
copyRegion, copyRegionScaled,
withImage,
loadJpegFile, loadJpegData, loadJpegByteString,
loadPngFile, loadPngData, loadPngByteString,
loadGifFile, loadGifData, loadGifByteString,
saveJpegFile, saveJpegByteString,
savePngFile, savePngByteString,
saveGifFile, saveGifByteString,
imageSize,
getPixel,
resizeImage, rotateImage,
brushed,
setBrush,
fillImage,
drawFilledRectangle,
drawFilledEllipse,
drawLine,
drawArc,
antiAliased,
setPixel,
colorAllocate,
useFontConfig,
drawString, measureString,
drawStringCircle,
rgb, rgba, toRGBA,
saveAlpha,
alphaBlending,
) where
import Control.Exception (bracket)
import Control.Monad (liftM, unless)
import Data.Bits
import qualified Data.ByteString.Internal as B
import Foreign (Ptr,FunPtr,ForeignPtr)
import Foreign (peekByteOff)
import qualified Foreign as F
import Foreign.C (CString)
import qualified Foreign.C as C
import Foreign.C.Types
data 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 :: FilePath -> FilePath -> IO (Ptr CFILE)
fopen FilePath
file FilePath
mode =
FilePath -> IO (Ptr CFILE) -> IO (Ptr CFILE)
forall a. FilePath -> IO (Ptr a) -> IO (Ptr a)
C.throwErrnoIfNull FilePath
file (IO (Ptr CFILE) -> IO (Ptr CFILE))
-> IO (Ptr CFILE) -> IO (Ptr CFILE)
forall a b. (a -> b) -> a -> b
$ FilePath -> (CString -> IO (Ptr CFILE)) -> IO (Ptr CFILE)
forall a. FilePath -> (CString -> IO a) -> IO a
C.withCString FilePath
file ((CString -> IO (Ptr CFILE)) -> IO (Ptr CFILE))
-> (CString -> IO (Ptr CFILE)) -> IO (Ptr CFILE)
forall a b. (a -> b) -> a -> b
$
\CString
f -> FilePath -> (CString -> IO (Ptr CFILE)) -> IO (Ptr CFILE)
forall a. FilePath -> (CString -> IO a) -> IO a
C.withCString FilePath
mode ((CString -> IO (Ptr CFILE)) -> IO (Ptr CFILE))
-> (CString -> IO (Ptr CFILE)) -> IO (Ptr CFILE)
forall a b. (a -> b) -> a -> b
$ \CString
m -> CString -> CString -> IO (Ptr CFILE)
c_fopen CString
f CString
m
fclose :: Ptr CFILE -> IO ()
fclose :: Ptr CFILE -> IO ()
fclose Ptr CFILE
p = (Color -> Bool) -> FilePath -> IO Color -> IO ()
forall a. (a -> Bool) -> FilePath -> IO a -> IO ()
C.throwErrnoIf_ (Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== -Color
1) FilePath
"fclose" (IO Color -> IO ()) -> IO Color -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CFILE -> IO Color
c_fclose Ptr CFILE
p
{-# LINE 78 "Graphics/GD.hsc" #-}
withCFILE :: FilePath -> String -> (Ptr CFILE -> IO a) -> IO a
withCFILE :: forall a. FilePath -> FilePath -> (Ptr CFILE -> IO a) -> IO a
withCFILE FilePath
file FilePath
mode = IO (Ptr CFILE)
-> (Ptr CFILE -> IO ()) -> (Ptr CFILE -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FilePath -> FilePath -> IO (Ptr CFILE)
fopen FilePath
file FilePath
mode) Ptr CFILE -> IO ()
fclose
data GDImage
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)
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)
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)
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 ())
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-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
foreign import ccall "gd.h gdImageSetBrush" gdImageSetBrush
:: Ptr GDImage -> Ptr GDImage -> IO ()
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 ()
foreign import ccall "gd.h gdImageColorAllocate" gdImageColorAllocate
:: Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> IO CInt
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
foreign import ccall "gd.h &gdFree" gdFree
:: FunPtr (Ptr a -> IO ())
toRGBA :: Color -> (Int, Int, Int, Int)
toRGBA :: Color -> (Int, Int, Int, Int)
toRGBA Color
c = (Color -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Color
r, Color -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Color
g, Color -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Color
b, Color -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Color
a)
where
b :: Color
b = Color
c Color -> Color -> Color
forall a. Integral a => a -> a -> a
`mod` Color
byte
g :: Color
g = Color -> Int -> Color
forall a. Bits a => a -> Int -> a
shiftR Color
c Int
8 Color -> Color -> Color
forall a. Integral a => a -> a -> a
`mod` Color
byte
r :: Color
r = Color -> Int -> Color
forall a. Bits a => a -> Int -> a
shiftR Color
c Int
16 Color -> Color -> Color
forall a. Integral a => a -> a -> a
`mod` Color
byte
a :: Color
a = Color -> Int -> Color
forall a. Bits a => a -> Int -> a
shiftR Color
c Int
24 Color -> Color -> Color
forall a. Integral a => a -> a -> a
`mod` Color
byte
byte :: Color
byte = Color
2 Color -> Int -> Color
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
8::Int)
foreign import ccall "gd.h gdImageSaveAlpha" gdImageSaveAlpha
:: Ptr GDImage -> CInt -> IO ()
foreign import ccall "gd.h gdImageAlphaBlending" gdImageAlphaBlending
:: Ptr GDImage -> CInt -> IO ()
newtype PCREOption = PCREOption { PCREOption -> Color
unPCREOption :: CInt }
deriving (PCREOption -> PCREOption -> Bool
(PCREOption -> PCREOption -> Bool)
-> (PCREOption -> PCREOption -> Bool) -> Eq PCREOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PCREOption -> PCREOption -> Bool
== :: PCREOption -> PCREOption -> Bool
$c/= :: PCREOption -> PCREOption -> Bool
/= :: PCREOption -> PCREOption -> Bool
Eq,Int -> PCREOption -> ShowS
[PCREOption] -> ShowS
PCREOption -> FilePath
(Int -> PCREOption -> ShowS)
-> (PCREOption -> FilePath)
-> ([PCREOption] -> ShowS)
-> Show PCREOption
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PCREOption -> ShowS
showsPrec :: Int -> PCREOption -> ShowS
$cshow :: PCREOption -> FilePath
show :: PCREOption -> FilePath
$cshowList :: [PCREOption] -> ShowS
showList :: [PCREOption] -> ShowS
Show)
newtype Image = Image (ForeignPtr (Ptr GDImage))
type Size = (Int,Int)
type Point = (Int,Int)
type Color = CInt
mkImage :: Ptr GDImage -> IO Image
mkImage :: Ptr GDImage -> IO Image
mkImage Ptr GDImage
img = do ForeignPtr (Ptr GDImage)
fp <- IO (ForeignPtr (Ptr GDImage))
forall a. Storable a => IO (ForeignPtr a)
F.mallocForeignPtr
ForeignPtr (Ptr GDImage) -> (Ptr (Ptr GDImage) -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr (Ptr GDImage)
fp ((Ptr (Ptr GDImage) -> IO ()) -> IO ())
-> (Ptr (Ptr GDImage) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr GDImage)
p -> Ptr (Ptr GDImage) -> Ptr GDImage -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
F.poke Ptr (Ptr GDImage)
p Ptr GDImage
img
FinalizerPtr (Ptr GDImage) -> ForeignPtr (Ptr GDImage) -> IO ()
forall a. FinalizerPtr a -> ForeignPtr a -> IO ()
F.addForeignPtrFinalizer FinalizerPtr (Ptr GDImage)
ptr_gdImagePtrDestroyIfNotNull ForeignPtr (Ptr GDImage)
fp
Image -> IO Image
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Image -> IO Image) -> Image -> IO Image
forall a b. (a -> b) -> a -> b
$ ForeignPtr (Ptr GDImage) -> Image
Image ForeignPtr (Ptr GDImage)
fp
withImage :: IO Image
-> (Image -> IO b)
-> IO b
withImage :: forall b. IO Image -> (Image -> IO b) -> IO b
withImage IO Image
ini Image -> IO b
f = IO Image -> (Image -> IO ()) -> (Image -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Image
ini Image -> IO ()
freeImage Image -> IO b
f
freeImage :: Image -> IO ()
freeImage :: Image -> IO ()
freeImage (Image ForeignPtr (Ptr GDImage)
fp) = ForeignPtr (Ptr GDImage) -> (Ptr (Ptr GDImage) -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr (Ptr GDImage)
fp ((Ptr (Ptr GDImage) -> IO ()) -> IO ())
-> (Ptr (Ptr GDImage) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\Ptr (Ptr GDImage)
pp -> do Ptr GDImage
p <- Ptr (Ptr GDImage) -> IO (Ptr GDImage)
forall a. Storable a => Ptr a -> IO a
F.peek Ptr (Ptr GDImage)
pp
Ptr (Ptr GDImage) -> Ptr GDImage -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
F.poke Ptr (Ptr GDImage)
pp Ptr GDImage
forall a. Ptr a
F.nullPtr
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Ptr GDImage
p Ptr GDImage -> Ptr GDImage -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr GDImage
forall a. Ptr a
F.nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr GDImage -> IO ()
gdImageDestroy Ptr GDImage
p
withImagePtr :: Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr :: forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr (Image ForeignPtr (Ptr GDImage)
fp) Ptr GDImage -> IO a
f = ForeignPtr (Ptr GDImage) -> (Ptr (Ptr GDImage) -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr (Ptr GDImage)
fp ((Ptr (Ptr GDImage) -> IO a) -> IO a)
-> (Ptr (Ptr GDImage) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$
\Ptr (Ptr GDImage)
pp -> Ptr (Ptr GDImage) -> IO (Ptr GDImage)
forall a. Storable a => Ptr a -> IO a
F.peek Ptr (Ptr GDImage)
pp IO (Ptr GDImage) -> (Ptr GDImage -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr GDImage
p ->
if Ptr GDImage
p Ptr GDImage -> Ptr GDImage -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr GDImage
forall a. Ptr a
F.nullPtr then FilePath -> IO a
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Image has been freed." else Ptr GDImage -> IO a
f Ptr GDImage
p
newImage :: Size -> IO Image
newImage :: Size -> IO Image
newImage (Int
w,Int
h) = Color -> Color -> IO Image
newImage_ (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
w) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
h)
newImage_ :: CInt -> CInt -> IO Image
newImage_ :: Color -> Color -> IO Image
newImage_ Color
w Color
h = do Ptr GDImage
p <- FilePath -> IO (Ptr GDImage) -> IO (Ptr GDImage)
forall a. FilePath -> IO (Ptr a) -> IO (Ptr a)
F.throwIfNull FilePath
"gdImageCreateTrueColor" (IO (Ptr GDImage) -> IO (Ptr GDImage))
-> IO (Ptr GDImage) -> IO (Ptr GDImage)
forall a b. (a -> b) -> a -> b
$
Color -> Color -> IO (Ptr GDImage)
gdImageCreateTrueColor Color
w Color
h
Ptr GDImage -> IO Image
mkImage Ptr GDImage
p
onNewImage :: CInt -> CInt -> (Ptr GDImage -> IO a) -> IO Image
onNewImage :: forall a. Color -> Color -> (Ptr GDImage -> IO a) -> IO Image
onNewImage Color
w Color
h Ptr GDImage -> IO a
f = Color -> Color -> IO Image
newImage_ Color
w Color
h IO Image -> (Image -> IO Image) -> IO Image
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Image
i -> Image -> (Ptr GDImage -> IO a) -> IO a
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i Ptr GDImage -> IO a
f IO a -> IO Image -> IO Image
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Image -> IO Image
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Image
i
copyImage :: Image -> IO Image
copyImage :: Image -> IO Image
copyImage Image
i = Image -> (Ptr GDImage -> IO Image) -> IO Image
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i Ptr GDImage -> IO Image
f
where f :: Ptr GDImage -> IO Image
f Ptr GDImage
p = do (Color
w,Color
h) <- Ptr GDImage -> IO (Color, Color)
imageSize_ Ptr GDImage
p
Color -> Color -> (Ptr GDImage -> IO ()) -> IO Image
forall a. Color -> Color -> (Ptr GDImage -> IO a) -> IO Image
onNewImage Color
w Color
h (\Ptr GDImage
p' -> Ptr GDImage
-> Ptr GDImage
-> Color
-> Color
-> Color
-> Color
-> Color
-> Color
-> IO ()
gdImageCopy Ptr GDImage
p' Ptr GDImage
p Color
0 Color
0 Color
0 Color
0 Color
w Color
h)
copyRegion :: Point
-> Size
-> Image
-> Point
-> Image
-> IO ()
copyRegion :: Size -> Size -> Image -> Size -> Image -> IO ()
copyRegion (Int
srcX, Int
srcY) (Int
w, Int
h) Image
srcIPtr (Int
dstX, Int
dstY) Image
dstIPtr
= Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
dstIPtr ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\Ptr GDImage
dstImg -> Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
srcIPtr ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\Ptr GDImage
srcImg -> Ptr GDImage
-> Ptr GDImage
-> Color
-> Color
-> Color
-> Color
-> Color
-> Color
-> IO ()
gdImageCopy Ptr GDImage
dstImg Ptr GDImage
srcImg
(Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
dstX) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
dstY) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
srcX) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
srcY) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
w) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
h)
copyRegionScaled :: Point
-> Size
-> Image
-> Point
-> Size
-> Image
-> IO ()
copyRegionScaled :: Size -> Size -> Image -> Size -> Size -> Image -> IO ()
copyRegionScaled (Int
srcX,Int
srcY) (Int
srcW,Int
srcH) Image
srcIPtr (Int
dstX,Int
dstY) (Int
dstW,Int
dstH) Image
dstIPtr
= Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
dstIPtr ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\Ptr GDImage
dstImg -> Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
srcIPtr ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\Ptr GDImage
srcImg -> Ptr GDImage
-> Ptr GDImage
-> Color
-> Color
-> Color
-> Color
-> Color
-> Color
-> Color
-> Color
-> IO ()
gdImageCopyResampled Ptr GDImage
dstImg Ptr GDImage
srcImg
(Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
dstX) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
dstY) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
srcX) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
srcY)
(Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
dstW) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
dstH) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
srcW) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
srcH)
loadJpegFile :: FilePath -> IO Image
loadJpegFile :: FilePath -> IO Image
loadJpegFile = (Ptr CFILE -> IO (Ptr GDImage)) -> FilePath -> IO Image
loadImageFile Ptr CFILE -> IO (Ptr GDImage)
gdImageCreateFromJpeg
loadJpegData :: Int
-> Ptr a
-> IO Image
loadJpegData :: forall a. Int -> Ptr a -> IO Image
loadJpegData = (Color -> Ptr a -> IO (Ptr GDImage)) -> Int -> Ptr a -> IO Image
forall a.
(Color -> Ptr a -> IO (Ptr GDImage)) -> Int -> Ptr a -> IO Image
loadImageData Color -> Ptr a -> IO (Ptr GDImage)
forall a. Color -> Ptr a -> IO (Ptr GDImage)
gdImageCreateFromJpegPtr
loadJpegByteString :: B.ByteString -> IO Image
loadJpegByteString :: ByteString -> IO Image
loadJpegByteString = (Int -> Ptr Any -> IO Image) -> ByteString -> IO Image
forall a b. (Int -> Ptr a -> IO b) -> ByteString -> IO b
onByteStringData Int -> Ptr Any -> IO Image
forall a. Int -> Ptr a -> IO Image
loadJpegData
loadPngFile :: FilePath -> IO Image
loadPngFile :: FilePath -> IO Image
loadPngFile = (Ptr CFILE -> IO (Ptr GDImage)) -> FilePath -> IO Image
loadImageFile Ptr CFILE -> IO (Ptr GDImage)
gdImageCreateFromPng
loadPngData :: Int
-> Ptr a
-> IO Image
loadPngData :: forall a. Int -> Ptr a -> IO Image
loadPngData = (Color -> Ptr a -> IO (Ptr GDImage)) -> Int -> Ptr a -> IO Image
forall a.
(Color -> Ptr a -> IO (Ptr GDImage)) -> Int -> Ptr a -> IO Image
loadImageData Color -> Ptr a -> IO (Ptr GDImage)
forall a. Color -> Ptr a -> IO (Ptr GDImage)
gdImageCreateFromPngPtr
loadPngByteString :: B.ByteString -> IO Image
loadPngByteString :: ByteString -> IO Image
loadPngByteString = (Int -> Ptr Any -> IO Image) -> ByteString -> IO Image
forall a b. (Int -> Ptr a -> IO b) -> ByteString -> IO b
onByteStringData Int -> Ptr Any -> IO Image
forall a. Int -> Ptr a -> IO Image
loadPngData
loadGifFile :: FilePath -> IO Image
loadGifFile :: FilePath -> IO Image
loadGifFile = (Ptr CFILE -> IO (Ptr GDImage)) -> FilePath -> IO Image
loadImageFile Ptr CFILE -> IO (Ptr GDImage)
gdImageCreateFromGif
loadGifData :: Int
-> Ptr a
-> IO Image
loadGifData :: forall a. Int -> Ptr a -> IO Image
loadGifData = (Color -> Ptr a -> IO (Ptr GDImage)) -> Int -> Ptr a -> IO Image
forall a.
(Color -> Ptr a -> IO (Ptr GDImage)) -> Int -> Ptr a -> IO Image
loadImageData Color -> Ptr a -> IO (Ptr GDImage)
forall a. Color -> Ptr a -> IO (Ptr GDImage)
gdImageCreateFromGifPtr
loadGifByteString :: B.ByteString -> IO Image
loadGifByteString :: ByteString -> IO Image
loadGifByteString = (Int -> Ptr Any -> IO Image) -> ByteString -> IO Image
forall a b. (Int -> Ptr a -> IO b) -> ByteString -> IO b
onByteStringData Int -> Ptr Any -> IO Image
forall a. Int -> Ptr a -> IO Image
loadGifData
loadImageFile :: (Ptr CFILE -> IO (Ptr GDImage)) -> FilePath -> IO Image
loadImageFile :: (Ptr CFILE -> IO (Ptr GDImage)) -> FilePath -> IO Image
loadImageFile Ptr CFILE -> IO (Ptr GDImage)
f FilePath
file = do
Ptr GDImage
p <- FilePath -> IO (Ptr GDImage) -> IO (Ptr GDImage)
forall a. FilePath -> IO (Ptr a) -> IO (Ptr a)
F.throwIfNull (FilePath
"Loading image from " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
file) (IO (Ptr GDImage) -> IO (Ptr GDImage))
-> IO (Ptr GDImage) -> IO (Ptr GDImage)
forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath -> (Ptr CFILE -> IO (Ptr GDImage)) -> IO (Ptr GDImage)
forall a. FilePath -> FilePath -> (Ptr CFILE -> IO a) -> IO a
withCFILE FilePath
file FilePath
"rb" Ptr CFILE -> IO (Ptr GDImage)
f
Ptr GDImage -> IO Image
mkImage Ptr GDImage
p
loadImageData :: (CInt -> Ptr a -> IO (Ptr GDImage)) -> Int -> Ptr a -> IO Image
loadImageData :: forall a.
(Color -> Ptr a -> IO (Ptr GDImage)) -> Int -> Ptr a -> IO Image
loadImageData Color -> Ptr a -> IO (Ptr GDImage)
f Int
sz Ptr a
buf = do
Ptr GDImage
p <- FilePath -> IO (Ptr GDImage) -> IO (Ptr GDImage)
forall a. FilePath -> IO (Ptr a) -> IO (Ptr a)
F.throwIfNull (FilePath
"Loading image") (IO (Ptr GDImage) -> IO (Ptr GDImage))
-> IO (Ptr GDImage) -> IO (Ptr GDImage)
forall a b. (a -> b) -> a -> b
$ Color -> Ptr a -> IO (Ptr GDImage)
f (Int -> Color
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz) Ptr a
buf
Ptr GDImage -> IO Image
mkImage Ptr GDImage
p
onByteStringData :: (Int -> Ptr a -> IO b) -> B.ByteString -> IO b
onByteStringData :: forall a b. (Int -> Ptr a -> IO b) -> ByteString -> IO b
onByteStringData Int -> Ptr a -> IO b
f ByteString
bstr =
case ByteString -> (ForeignPtr Word8, Int, Int)
B.toForeignPtr ByteString
bstr of
(ForeignPtr Word8
fptr, Int
start, Int
sz) -> ForeignPtr Word8 -> (Ptr Word8 -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO b) -> IO b) -> (Ptr Word8 -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$
\Ptr Word8
ptr -> Int -> Ptr a -> IO b
f Int
sz (Ptr Word8 -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
F.plusPtr Ptr Word8
ptr Int
start)
saveJpegFile :: Int
-> FilePath -> Image -> IO ()
saveJpegFile :: Int -> FilePath -> Image -> IO ()
saveJpegFile Int
q = (Ptr GDImage -> Ptr CFILE -> IO ()) -> FilePath -> Image -> IO ()
saveImageFile (\Ptr GDImage
p Ptr CFILE
h -> Ptr GDImage -> Ptr CFILE -> Color -> IO ()
gdImageJpeg Ptr GDImage
p Ptr CFILE
h (Int -> Color
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
q))
saveJpegByteString :: Int -> Image -> IO B.ByteString
saveJpegByteString :: Int -> Image -> IO ByteString
saveJpegByteString Int
q =
(Ptr GDImage -> Ptr Color -> IO (Ptr Any))
-> Image -> IO ByteString
forall a.
(Ptr GDImage -> Ptr Color -> IO (Ptr a)) -> Image -> IO ByteString
saveImageByteString (\Ptr GDImage
p Ptr Color
h -> Ptr GDImage -> Ptr Color -> Color -> IO (Ptr Any)
forall a. Ptr GDImage -> Ptr Color -> Color -> IO (Ptr a)
gdImageJpegPtr Ptr GDImage
p Ptr Color
h (Int -> Color
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
q))
savePngFile :: FilePath -> Image -> IO ()
savePngFile :: FilePath -> Image -> IO ()
savePngFile = (Ptr GDImage -> Ptr CFILE -> IO ()) -> FilePath -> Image -> IO ()
saveImageFile Ptr GDImage -> Ptr CFILE -> IO ()
gdImagePng
savePngByteString :: Image -> IO B.ByteString
savePngByteString :: Image -> IO ByteString
savePngByteString = (Ptr GDImage -> Ptr Color -> IO (Ptr Any))
-> Image -> IO ByteString
forall a.
(Ptr GDImage -> Ptr Color -> IO (Ptr a)) -> Image -> IO ByteString
saveImageByteString Ptr GDImage -> Ptr Color -> IO (Ptr Any)
forall a. Ptr GDImage -> Ptr Color -> IO (Ptr a)
gdImagePngPtr
saveGifFile :: FilePath -> Image -> IO ()
saveGifFile :: FilePath -> Image -> IO ()
saveGifFile = (Ptr GDImage -> Ptr CFILE -> IO ()) -> FilePath -> Image -> IO ()
saveImageFile Ptr GDImage -> Ptr CFILE -> IO ()
gdImageGif
saveGifByteString :: Image -> IO B.ByteString
saveGifByteString :: Image -> IO ByteString
saveGifByteString = (Ptr GDImage -> Ptr Color -> IO (Ptr Any))
-> Image -> IO ByteString
forall a.
(Ptr GDImage -> Ptr Color -> IO (Ptr a)) -> Image -> IO ByteString
saveImageByteString Ptr GDImage -> Ptr Color -> IO (Ptr Any)
forall a. Ptr GDImage -> Ptr Color -> IO (Ptr a)
gdImageGifPtr
saveImageFile :: (Ptr GDImage -> Ptr CFILE -> IO ())
-> FilePath -> Image -> IO ()
saveImageFile :: (Ptr GDImage -> Ptr CFILE -> IO ()) -> FilePath -> Image -> IO ()
saveImageFile Ptr GDImage -> Ptr CFILE -> IO ()
f FilePath
file Image
i = Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i (\Ptr GDImage
p -> FilePath -> FilePath -> (Ptr CFILE -> IO ()) -> IO ()
forall a. FilePath -> FilePath -> (Ptr CFILE -> IO a) -> IO a
withCFILE FilePath
file FilePath
"wb" (Ptr GDImage -> Ptr CFILE -> IO ()
f Ptr GDImage
p))
saveImageByteString :: (Ptr GDImage -> Ptr CInt -> IO (Ptr a)) -> Image
-> IO (B.ByteString)
saveImageByteString :: forall a.
(Ptr GDImage -> Ptr Color -> IO (Ptr a)) -> Image -> IO ByteString
saveImageByteString Ptr GDImage -> Ptr Color -> IO (Ptr a)
f Image
img = Image -> (Ptr GDImage -> IO ByteString) -> IO ByteString
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
img (\Ptr GDImage
p -> (Ptr Color -> IO (Ptr a)) -> IO ByteString
forall a. (Ptr Color -> IO (Ptr a)) -> IO ByteString
dataByteString (Ptr GDImage -> Ptr Color -> IO (Ptr a)
f Ptr GDImage
p))
dataByteString :: (Ptr CInt -> IO (Ptr a)) -> IO B.ByteString
dataByteString :: forall a. (Ptr Color -> IO (Ptr a)) -> IO ByteString
dataByteString Ptr Color -> IO (Ptr a)
f = (Ptr Color -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca ((Ptr Color -> IO ByteString) -> IO ByteString)
-> (Ptr Color -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Color
szPtr -> do
ForeignPtr Word8
datPtr <- Ptr Color -> IO (Ptr a)
f Ptr Color
szPtr IO (Ptr a)
-> (Ptr a -> IO (ForeignPtr Word8)) -> IO (ForeignPtr Word8)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FinalizerPtr Word8 -> Ptr Word8 -> IO (ForeignPtr Word8)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
F.newForeignPtr FinalizerPtr Word8
forall a. FunPtr (Ptr a -> IO ())
gdFree (Ptr Word8 -> IO (ForeignPtr Word8))
-> (Ptr a -> Ptr Word8) -> Ptr a -> IO (ForeignPtr Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
F.castPtr
(Color -> ByteString) -> IO Color -> IO ByteString
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (ForeignPtr Word8 -> Int -> Int -> ByteString
B.fromForeignPtr ForeignPtr Word8
datPtr Int
0 (Int -> ByteString) -> (Color -> Int) -> Color -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Ptr Color -> IO Color
forall a. Storable a => Ptr a -> IO a
F.peek Ptr Color
szPtr)
getPixel :: (Int,Int) -> Image -> IO Color
getPixel :: Size -> Image -> IO Color
getPixel (Int
x,Int
y) Image
i = Image -> (Ptr GDImage -> IO Color) -> IO Color
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i Ptr GDImage -> IO Color
f
where f :: Ptr GDImage -> IO Color
f Ptr GDImage
p' = Ptr GDImage -> Color -> Color -> IO Color
gdImageGetPixel Ptr GDImage
p' (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
x) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
y)
imageSize :: Image -> IO (Int,Int)
imageSize :: Image -> IO Size
imageSize Image
i = ((Color, Color) -> Size) -> IO (Color, Color) -> IO Size
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Color, Color) -> Size
f (IO (Color, Color) -> IO Size) -> IO (Color, Color) -> IO Size
forall a b. (a -> b) -> a -> b
$ Image -> (Ptr GDImage -> IO (Color, Color)) -> IO (Color, Color)
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i Ptr GDImage -> IO (Color, Color)
imageSize_
where f :: (Color, Color) -> Size
f = (\ (Color
w,Color
h) -> (Color -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Color
w, Color -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Color
h))
imageSize_ :: Ptr GDImage -> IO (CInt,CInt)
imageSize_ :: Ptr GDImage -> IO (Color, Color)
imageSize_ Ptr GDImage
p = do Color
w <- (\Ptr GDImage
hsc_ptr -> Ptr GDImage -> Int -> IO Color
forall b. Ptr b -> Int -> IO Color
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr GDImage
hsc_ptr Int
8) Ptr GDImage
p
{-# LINE 455 "Graphics/GD.hsc" #-}
Color
h <- (\Ptr GDImage
hsc_ptr -> Ptr GDImage -> Int -> IO Color
forall b. Ptr b -> Int -> IO Color
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr GDImage
hsc_ptr Int
12) Ptr GDImage
p
{-# LINE 456 "Graphics/GD.hsc" #-}
(Color, Color) -> IO (Color, Color)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Color
w, Color
h)
resizeImage :: Int
-> Int
-> Image
-> IO Image
resizeImage :: Int -> Int -> Image -> IO Image
resizeImage Int
w Int
h Image
i = Image -> (Ptr GDImage -> IO Image) -> IO Image
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i Ptr GDImage -> IO Image
f
where
f :: Ptr GDImage -> IO Image
f Ptr GDImage
p = do let (Color
outW,Color
outH) = (Int -> Color
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w, Int -> Color
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
(Color
inW, Color
inH) <- Ptr GDImage -> IO (Color, Color)
imageSize_ Ptr GDImage
p
Color -> Color -> (Ptr GDImage -> IO ()) -> IO Image
forall a. Color -> Color -> (Ptr GDImage -> IO a) -> IO Image
onNewImage Color
outW Color
outH ((Ptr GDImage -> IO ()) -> IO Image)
-> (Ptr GDImage -> IO ()) -> IO Image
forall a b. (a -> b) -> a -> b
$ \Ptr GDImage
p' ->
Ptr GDImage
-> Ptr GDImage
-> Color
-> Color
-> Color
-> Color
-> Color
-> Color
-> Color
-> Color
-> IO ()
gdImageCopyResampled Ptr GDImage
p' Ptr GDImage
p Color
0 Color
0 Color
0 Color
0 Color
outW Color
outH Color
inW Color
inH
rotateImage :: Int
-> Image
-> IO Image
rotateImage :: Int -> Image -> IO Image
rotateImage Int
r Image
i = Image -> (Ptr GDImage -> IO Image) -> IO Image
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i Ptr GDImage -> IO Image
f
where f :: Ptr GDImage -> IO Image
f Ptr GDImage
p = do (Color
inW,Color
inH) <- Ptr GDImage -> IO (Color, Color)
imageSize_ Ptr GDImage
p
let q :: Color
q = Int -> Color
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
r Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4)
(Color
outW,Color
outH) | Int
r Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (Color
inW,Color
inH)
| Bool
otherwise = (Color
inH,Color
inW)
srcX :: Color
srcX = if Color
q Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
1 Bool -> Bool -> Bool
|| Color
q Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
2 then Color
inWColor -> Color -> Color
forall a. Num a => a -> a -> a
-Color
1 else Color
0;
srcY :: Color
srcY = if Color
q Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
2 Bool -> Bool -> Bool
|| Color
q Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
3 then Color
inHColor -> Color -> Color
forall a. Num a => a -> a -> a
-Color
1 else Color
0;
Color -> Color -> (Ptr GDImage -> IO ()) -> IO Image
forall a. Color -> Color -> (Ptr GDImage -> IO a) -> IO Image
onNewImage Color
outW Color
outH (\Ptr GDImage
p' ->
Ptr GDImage
-> Ptr GDImage
-> Color
-> Color
-> Color
-> Color
-> Color
-> Color
-> Color
-> IO ()
gdImageCopyRotated90 Ptr GDImage
p' Ptr GDImage
p Color
0 Color
0 Color
srcX Color
srcY Color
inW Color
inH Color
q)
brushed :: PCREOption
brushed :: PCREOption
brushed = Color -> PCREOption
PCREOption (-Color
3)
{-# LINE 496 "Graphics/GD.hsc" #-}
setBrush :: Image
-> Image
-> IO ()
setBrush :: Image -> Image -> IO ()
setBrush Image
i Image
b =
Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
b ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\Ptr GDImage
brushImg -> Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\Ptr GDImage
srcImg -> Ptr GDImage -> Ptr GDImage -> IO ()
gdImageSetBrush Ptr GDImage
srcImg Ptr GDImage
brushImg
fillImage :: Color -> Image -> IO ()
fillImage :: Color -> Image -> IO ()
fillImage Color
c Image
i = do Size
sz <- Image -> IO Size
imageSize Image
i
Size -> Size -> Color -> Image -> IO ()
drawFilledRectangle (Int
0,Int
0) Size
sz Color
c Image
i
drawFilledRectangle :: Point
-> Point
-> Color -> Image -> IO ()
drawFilledRectangle :: Size -> Size -> Color -> Image -> IO ()
drawFilledRectangle (Int
x1,Int
y1) (Int
x2,Int
y2) Color
c Image
i =
Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GDImage
p ->
Ptr GDImage -> Color -> Color -> Color -> Color -> Color -> IO ()
gdImageFilledRectangle Ptr GDImage
p (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
x1) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
y1) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
x2) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
y2) Color
c
drawFilledEllipse :: Point
-> Size
-> Color -> Image -> IO ()
drawFilledEllipse :: Size -> Size -> Color -> Image -> IO ()
drawFilledEllipse (Int
cx,Int
cy) (Int
w,Int
h) Color
c Image
i =
Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GDImage
p ->
Ptr GDImage -> Color -> Color -> Color -> Color -> Color -> IO ()
gdImageFilledEllipse Ptr GDImage
p (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
cx) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
cy) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
w) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
h) Color
c
drawLine :: Point
-> Point
-> Color -> Image -> IO ()
drawLine :: Size -> Size -> Color -> Image -> IO ()
drawLine (Int
x1,Int
y1) (Int
x2,Int
y2) Color
c Image
i =
Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GDImage
p ->
Ptr GDImage -> Color -> Color -> Color -> Color -> Color -> IO ()
gdImageLine Ptr GDImage
p (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
x1) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
y1) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
x2) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
y2) Color
c
drawArc :: Point
-> Size
-> Int
-> Int
-> Color -> Image -> IO ()
drawArc :: Size -> Size -> Int -> Int -> Color -> Image -> IO ()
drawArc (Int
cx,Int
cy) (Int
w,Int
h) Int
sp Int
ep Color
c Image
i =
Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GDImage
p ->
Ptr GDImage
-> Color
-> Color
-> Color
-> Color
-> Color
-> Color
-> Color
-> IO ()
gdImageArc Ptr GDImage
p (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
cx) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
cy) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
w) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
h) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
sp) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
ep) Color
c
antiAliased :: (Color -> Image -> IO a) -> Color -> Image -> IO a
antiAliased :: forall a. (Color -> Image -> IO a) -> Color -> Image -> IO a
antiAliased Color -> Image -> IO a
f Color
c Image
i =
do Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i (\Ptr GDImage
p -> Ptr GDImage -> Color -> IO ()
gdImageSetAntiAliased Ptr GDImage
p Color
c)
Color -> Image -> IO a
f (-Color
7) Image
i
{-# LINE 547 "Graphics/GD.hsc" #-}
setPixel :: Point -> Color -> Image -> IO ()
setPixel :: Size -> Color -> Image -> IO ()
setPixel (Int
x,Int
y) Color
c Image
i =
Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GDImage
p ->
Ptr GDImage -> Color -> Color -> Color -> IO ()
gdImageSetPixel Ptr GDImage
p (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
x) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
y) Color
c
colorAllocate :: CInt -> CInt -> CInt -> CInt -> Image -> IO Color
colorAllocate :: Color -> Color -> Color -> Color -> Image -> IO Color
colorAllocate Color
r Color
g Color
b Color
a Image
i =
Image -> (Ptr GDImage -> IO Color) -> IO Color
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i ((Ptr GDImage -> IO Color) -> IO Color)
-> (Ptr GDImage -> IO Color) -> IO Color
forall a b. (a -> b) -> a -> b
$ \Ptr GDImage
p ->
Ptr GDImage -> Color -> Color -> Color -> Color -> IO Color
gdImageColorAllocate Ptr GDImage
p Color
r Color
g Color
b Color
a
useFontConfig :: Bool -> IO Bool
useFontConfig :: Bool -> IO Bool
useFontConfig Bool
use = (Color -> Bool) -> IO Color -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
/= Color
0) (IO Color -> IO Bool) -> IO Color -> IO Bool
forall a b. (a -> b) -> a -> b
$ Color -> IO Color
gdFTUseFontConfig (Color -> IO Color) -> Color -> IO Color
forall a b. (a -> b) -> a -> b
$ if Bool
use then Color
1 else Color
0
drawString :: String
-> Double
-> Double
-> Point
-> String
-> Color -> Image
-> IO (Point, Point, Point, Point)
drawString :: FilePath
-> Double
-> Double
-> Size
-> FilePath
-> Color
-> Image
-> IO (Size, Size, Size, Size)
drawString FilePath
fontName Double
ptSize Double
angle (Int
oriX, Int
oriY) FilePath
txt Color
color Image
img
= Image
-> (Ptr GDImage -> IO (Size, Size, Size, Size))
-> IO (Size, Size, Size, Size)
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
img ((Ptr GDImage -> IO (Size, Size, Size, Size))
-> IO (Size, Size, Size, Size))
-> (Ptr GDImage -> IO (Size, Size, Size, Size))
-> IO (Size, Size, Size, Size)
forall a b. (a -> b) -> a -> b
$
Color
-> FilePath
-> Double
-> Double
-> Size
-> FilePath
-> Ptr GDImage
-> IO (Size, Size, Size, Size)
drawStringImagePtr Color
color FilePath
fontName Double
ptSize Double
angle (Int
oriX, Int
oriY) FilePath
txt
measureString :: String
-> Double
-> Double
-> Point
-> String
-> Color
-> IO (Point, Point, Point, Point)
measureString :: FilePath
-> Double
-> Double
-> Size
-> FilePath
-> Color
-> IO (Size, Size, Size, Size)
measureString FilePath
fontName Double
ptSize Double
angle (Int
oriX, Int
oriY) FilePath
txt Color
color
= Color
-> FilePath
-> Double
-> Double
-> Size
-> FilePath
-> Ptr GDImage
-> IO (Size, Size, Size, Size)
drawStringImagePtr Color
color FilePath
fontName Double
ptSize Double
angle (Int
oriX, Int
oriY) FilePath
txt Ptr GDImage
forall a. Ptr a
F.nullPtr
drawStringImagePtr :: Color -> String -> Double -> Double -> Point -> String ->
Ptr GDImage -> IO (Point, Point, Point, Point)
drawStringImagePtr :: Color
-> FilePath
-> Double
-> Double
-> Size
-> FilePath
-> Ptr GDImage
-> IO (Size, Size, Size, Size)
drawStringImagePtr Color
color FilePath
fontName Double
ptSize Double
angle (Int
oriX, Int
oriY) FilePath
txt Ptr GDImage
imgPtr
= Int
-> (Ptr Color -> IO (Size, Size, Size, Size))
-> IO (Size, Size, Size, Size)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
F.allocaArray Int
8 ((Ptr Color -> IO (Size, Size, Size, Size))
-> IO (Size, Size, Size, Size))
-> (Ptr Color -> IO (Size, Size, Size, Size))
-> IO (Size, Size, Size, Size)
forall a b. (a -> b) -> a -> b
$
\Ptr Color
bboxPtr -> FilePath
-> (CString -> IO (Size, Size, Size, Size))
-> IO (Size, Size, Size, Size)
forall a. FilePath -> (CString -> IO a) -> IO a
C.withCAString FilePath
fontName ((CString -> IO (Size, Size, Size, Size))
-> IO (Size, Size, Size, Size))
-> (CString -> IO (Size, Size, Size, Size))
-> IO (Size, Size, Size, Size)
forall a b. (a -> b) -> a -> b
$
\CString
cFontName -> FilePath
-> (CString -> IO (Size, Size, Size, Size))
-> IO (Size, Size, Size, Size)
forall a. FilePath -> (CString -> IO a) -> IO a
C.withCAString FilePath
txt ((CString -> IO (Size, Size, Size, Size))
-> IO (Size, Size, Size, Size))
-> (CString -> IO (Size, Size, Size, Size))
-> IO (Size, Size, Size, Size)
forall a b. (a -> b) -> a -> b
$
\CString
cTxt -> do CString
res <- Ptr GDImage
-> Ptr Color
-> Color
-> CString
-> CDouble
-> CDouble
-> Color
-> Color
-> CString
-> IO CString
gdImageStringFT Ptr GDImage
imgPtr Ptr Color
bboxPtr Color
color CString
cFontName
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
double Double
ptSize) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
double Double
angle)
(Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
oriX) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
oriY) CString
cTxt
if CString
res CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
F.nullPtr
then Int -> Ptr Color -> IO [Color]
forall a. Storable a => Int -> Ptr a -> IO [a]
F.peekArray Int
8 Ptr Color
bboxPtr IO [Color]
-> ([Color] -> IO (Size, Size, Size, Size))
-> IO (Size, Size, Size, Size)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Color] -> IO (Size, Size, Size, Size)
forall {a} {b}.
(Integral a, Show a, Num b) =>
[a] -> IO ((b, b), (b, b), (b, b), (b, b))
parseBBox
else CString -> IO FilePath
C.peekCAString CString
res IO FilePath
-> (FilePath -> IO (Size, Size, Size, Size))
-> IO (Size, Size, Size, Size)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IOError -> IO (Size, Size, Size, Size)
forall a. IOError -> IO a
ioError (IOError -> IO (Size, Size, Size, Size))
-> (FilePath -> IOError) -> FilePath -> IO (Size, Size, Size, Size)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IOError
userError
where parseBBox :: [a] -> IO ((b, b), (b, b), (b, b), (b, b))
parseBBox [a]
l =
case (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
forall a b. (Integral a, Num b) => a -> b
int [a]
l of
[b
llx, b
lly, b
lrx, b
lry, b
urx, b
ury, b
ulx, b
uly] ->
((b, b), (b, b), (b, b), (b, b))
-> IO ((b, b), (b, b), (b, b), (b, b))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((b
llx, b
lly), (b
lrx, b
lry), (b
urx, b
ury), (b
ulx, b
uly))
[b]
_ -> IOError -> IO ((b, b), (b, b), (b, b), (b, b))
forall a. IOError -> IO a
ioError (IOError -> IO ((b, b), (b, b), (b, b), (b, b)))
-> IOError -> IO ((b, b), (b, b), (b, b), (b, b))
forall a b. (a -> b) -> a -> b
$ FilePath -> IOError
userError (FilePath -> IOError) -> FilePath -> IOError
forall a b. (a -> b) -> a -> b
$
FilePath
"parseBBox with /= 8 elements: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> FilePath
forall a. Show a => a -> FilePath
show [a]
l
drawStringCircle :: Point
-> Double
-> Double
-> Double
-> String
-> Double
-> String
-> String
-> Color
-> Image -> IO ()
drawStringCircle :: Size
-> Double
-> Double
-> Double
-> FilePath
-> Double
-> FilePath
-> FilePath
-> Color
-> Image
-> IO ()
drawStringCircle (Int
ctrX, Int
ctrY) Double
rad Double
textRad Double
textFill FilePath
fontName
Double
fontSize FilePath
topTxt FilePath
bottomTxt Color
color Image
img
= FilePath -> (CString -> IO ()) -> IO ()
forall a. FilePath -> (CString -> IO a) -> IO a
C.withCAString FilePath
fontName ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\CString
cFontName -> FilePath -> (CString -> IO ()) -> IO ()
forall a. FilePath -> (CString -> IO a) -> IO a
C.withCAString FilePath
topTxt ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\CString
cTopTxt -> FilePath -> (CString -> IO ()) -> IO ()
forall a. FilePath -> (CString -> IO a) -> IO a
C.withCAString FilePath
bottomTxt ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\CString
cBottomTxt -> Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
img ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\Ptr GDImage
imgPtr -> do
CString
res <- Ptr GDImage
-> Color
-> Color
-> CDouble
-> CDouble
-> CDouble
-> CString
-> CDouble
-> CString
-> CString
-> Color
-> IO CString
gdImageStringFTCircle Ptr GDImage
imgPtr
(Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
ctrX) (Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
ctrY) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
double Double
rad) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
double Double
textRad)
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
double Double
textFill) CString
cFontName (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
double Double
fontSize)
CString
cTopTxt CString
cBottomTxt Color
color
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CString
res CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
F.nullPtr) (CString -> IO FilePath
C.peekCAString CString
res IO FilePath -> (FilePath -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IOError -> IO ()
forall a. IOError -> IO a
ioError (IOError -> IO ()) -> (FilePath -> IOError) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IOError
userError)
saveAlpha :: Bool -> Image -> IO ()
saveAlpha :: Bool -> Image -> IO ()
saveAlpha Bool
b Image
i = Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GDImage
p -> Ptr GDImage -> Color -> IO ()
gdImageSaveAlpha Ptr GDImage
p (Color -> IO ()) -> Color -> IO ()
forall a b. (a -> b) -> a -> b
$ if Bool
b then Color
1 else Color
0
alphaBlending :: Bool -> Image -> IO ()
alphaBlending :: Bool -> Image -> IO ()
alphaBlending Bool
b Image
i = Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GDImage
p -> Ptr GDImage -> Color -> IO ()
gdImageAlphaBlending Ptr GDImage
p (Color -> IO ()) -> Color -> IO ()
forall a b. (a -> b) -> a -> b
$ if Bool
b then Color
1 else Color
0
rgb :: Int
-> Int
-> Int
-> Color
rgb :: Int -> Int -> Int -> Color
rgb Int
r Int
g Int
b = Int -> Int -> Int -> Int -> Color
rgba Int
r Int
g Int
b Int
0
rgba :: Int
-> Int
-> Int
-> Int
-> Color
rgba :: Int -> Int -> Int -> Int -> Color
rgba Int
r Int
g Int
b Int
a =
(Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
a Color -> Int -> Color
forall a. Bits a => a -> Int -> a
`F.shiftL` Int
24) Color -> Color -> Color
forall a. Bits a => a -> a -> a
.|.
(Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
r Color -> Int -> Color
forall a. Bits a => a -> Int -> a
`F.shiftL` Int
16) Color -> Color -> Color
forall a. Bits a => a -> a -> a
.|.
(Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
g Color -> Int -> Color
forall a. Bits a => a -> Int -> a
`F.shiftL` Int
8) Color -> Color -> Color
forall a. Bits a => a -> a -> a
.|.
Int -> Color
forall a b. (Integral a, Num b) => a -> b
int Int
b
int :: (Integral a, Num b) => a -> b
int :: forall a b. (Integral a, Num b) => a -> b
int = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral
double :: (Real a, Fractional b) => a -> b
double :: forall a b. (Real a, Fractional b) => a -> b
double = a -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac