1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
|
module Graphics.GD.ByteString (
-- * Types
Image, Size, Point, Color,
-- * Creating and copying images
GD.newImage, GD.copyImage,
GD.copyRegion, GD.copyRegionScaled,
-- * Memory management
GD.withImage,
-- * Loading images
-- ** JPEG
loadJpegFile, loadJpegData, loadJpegByteString,
-- ** PNG
loadPngFile, loadPngData, loadPngByteString,
-- ** GIF
loadGifFile, loadGifData, loadGifByteString,
-- * Saving images
-- ** JPEG
saveJpegFile, saveJpegByteString,
-- ** PNG
savePngFile, savePngByteString,
-- ** GIF
saveGifFile, saveGifByteString,
-- * Getting image information
GD.imageSize,
-- * Querying
GD.getPixel,
-- * Manipulating images
GD.resizeImage, GD.rotateImage,
-- * Drawing
GD.fillImage,
GD.drawFilledRectangle,
GD.drawFilledEllipse,
GD.drawLine,
GD.drawArc,
GD.antiAliased,
GD.setPixel,
-- * Text
GD.useFontConfig,
drawString,
measureString,
drawStringCircle,
-- * Colors
GD.rgb, GD.rgba, 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.Internal as BI
import Control.Monad (liftM,unless)
import Foreign (Ptr)
import qualified Foreign as F
import Foreign (peek)
import Foreign.C (CInt)
import Foreign.C (peekCAString,peekCAString)
--
-- * Loading images
--
-- | Load a JPEG image from a file.
loadJpegFile :: FilePath -> IO Image
loadJpegFile = loadImageFile GD.gdImageCreateFromJpeg
-- | Load a JPEG image from a buffer.
loadJpegData :: Int -- ^ Buffer size.
-> Ptr a -- ^ Buffer with image data.
-> IO Image
loadJpegData = loadImageData GD.gdImageCreateFromJpegPtr
-- | Load a JPEG image from a ByteString
loadJpegByteString :: B.ByteString -> IO Image
loadJpegByteString = onByteStringData loadJpegData
-- | Load a PNG image from a file.
loadPngFile :: FilePath -> IO Image
loadPngFile = loadImageFile GD.gdImageCreateFromPng
-- | Load a PNG image from a buffer.
loadPngData :: Int -- ^ Buffer size.
-> Ptr a -- ^ Buffer with image data.
-> IO Image
loadPngData = loadImageData GD.gdImageCreateFromPngPtr
-- | Load a PNG image from a ByteString
loadPngByteString :: B.ByteString -> IO Image
loadPngByteString = onByteStringData loadPngData
-- | Load a GIF image from a file.
loadGifFile :: FilePath -> IO Image
loadGifFile = loadImageFile GD.gdImageCreateFromGif
-- | Load a GIF image from a buffer.
loadGifData :: Int -- ^ Buffer size.
-> Ptr a -- ^ Buffer with image data.
-> IO Image
loadGifData = loadImageData GD.gdImageCreateFromGifPtr
-- | Load a GIF image from a ByteString
loadGifByteString :: B.ByteString -> IO Image
loadGifByteString = onByteStringData loadGifData
loadImageFile :: (Ptr CFILE -> IO (Ptr GDImage)) -> FilePath -> IO Image
loadImageFile f file = do
p <- F.throwIfNull ("Loading image from " ++ file) $ GD.withCFILE file "rb" f
GD.mkImage p
loadImageData :: (CInt -> Ptr a -> IO (Ptr GDImage)) -> Int -> Ptr a -> IO Image
loadImageData f sz buf =
do p <- F.throwIfNull ("Loading image") $ f (fromIntegral sz) buf
GD.mkImage p
onByteStringData :: (Int -> Ptr a -> IO b) -> B.ByteString -> IO b
onByteStringData f bstr
= case BI.toForeignPtr bstr of
(fptr, start, sz) -> F.withForeignPtr fptr $
\ptr -> f sz (F.plusPtr ptr start)
--
-- * Saving images
--
-- | Save an image as a JPEG file.
saveJpegFile :: Int -- ^ quality: 0-95, or negative for default quality.
-> FilePath -> Image -> IO ()
saveJpegFile q = saveImageFile (\p h -> GD.gdImageJpeg p h (fromIntegral q))
-- | Write a JPEG format ByteString of an image.
saveJpegByteString :: Int -> Image -> IO B.ByteString
saveJpegByteString q =
saveImageByteString (\p h -> GD.gdImageJpegPtr p h (fromIntegral q))
-- | Save an image as a PNG file.
savePngFile :: FilePath -> Image -> IO ()
savePngFile = saveImageFile GD.gdImagePng
-- | Write a PNG format ByteString of an image.
savePngByteString :: Image -> IO B.ByteString
savePngByteString = saveImageByteString GD.gdImagePngPtr
-- | Save an image as a GIF file.
saveGifFile :: FilePath -> Image -> IO ()
saveGifFile = saveImageFile GD.gdImageGif
-- | Write a GIF format ByteString of an image.
saveGifByteString :: Image -> IO B.ByteString
saveGifByteString = saveImageByteString GD.gdImageGifPtr
saveImageFile :: (Ptr GDImage -> Ptr CFILE -> IO ()) -> FilePath -> Image
-> IO ()
saveImageFile f file i = GD.withImagePtr i (\p -> GD.withCFILE file "wb" (f p))
saveImageByteString :: (Ptr GDImage -> Ptr CInt -> IO (Ptr a)) -> Image ->
IO (B.ByteString)
saveImageByteString f img = GD.withImagePtr img (\p -> dataByteString (f p))
dataByteString :: (Ptr CInt -> IO (Ptr a)) -> IO B.ByteString
dataByteString f = F.alloca $ \szPtr -> do
datPtr <- f szPtr >>= F.newForeignPtr GD.gdFree . F.castPtr
liftM (BI.fromForeignPtr datPtr 0 . fromIntegral) (peek szPtr)
--
-- * Text
--
-- | Draw a string using the FreeType 2.x library
drawString :: B.ByteString -- ^ Font name
-> Double -- ^ Font point size
-> Double -- ^ Angle in counterclockwise radians
-> Point -- ^ Origin
-> B.ByteString -- ^ Text, including HTML entities
-> Color -> Image
-> IO (Point, Point, Point, Point) -- ^ Bounding box
-- of the drawn
-- text
drawString fontName ptSize angle (oriX, oriY) txt color img =
GD.withImagePtr img $ drawStringImagePtr color fontName ptSize angle
(oriX, oriY) txt
-- | Measure a string using the FreeType 2.x library. This computes
-- the bounding box but does not actually draw the string to any
-- image.
measureString :: B.ByteString -- ^ Font name
-> Double -- ^ Font point size
-> Double -- ^ Angle in counterclockwise radians
-> Point -- ^ Origin
-> B.ByteString -- ^ Text, including HTML entities
-> Color
-> IO (Point, Point, Point, Point) -- ^ Bounding
-- box of the
-- drawn text
measureString fontName ptSize angle (oriX, oriY) txt color
= drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt F.nullPtr
drawStringImagePtr :: Color -> B.ByteString -> Double -> Double -> Point
-> B.ByteString -> Ptr GDImage
-> IO (Point, Point, Point, Point)
drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt imgPtr
= F.allocaArray 8 $
\bboxPtr -> B.useAsCString fontName $
\cFontName -> B.useAsCString txt $
\cTxt -> do res <- GD.gdImageStringFT imgPtr bboxPtr color cFontName
(GD.double ptSize) (GD.double angle)
(GD.int oriX) (GD.int oriY) cTxt
if res == F.nullPtr
then F.peekArray 8 bboxPtr >>= parseBBox
else peekCAString res >>= ioError . userError
where parseBBox l =
case map GD.int l of
[llx, lly, lrx, lry, urx, ury, ulx, uly] ->
return ((llx, lly), (lrx, lry), (urx, ury), (ulx, uly))
_ -> ioError $ userError $
"parseBBox with /= 8 elements: " ++ show l
-- | Draw strings around the top and bottom of a torus
drawStringCircle :: Point -- ^ Center of text path circle
-> Double -- ^ Outer radius of text
-> Double -- ^ Fraction of radius occupied by text
-> Double -- ^ Portion of circle arc filled by text
-> B.ByteString -- ^ Font name
-> Double -- ^ Font size hint
-> B.ByteString -- ^ Text to write on the top of the circle
-> B.ByteString -- ^ Text to write on the bottom of the circle
-> Color -- ^ Text color
-> Image -> IO ()
drawStringCircle (ctrX, ctrY) rad textRad textFill fontName fontSize topTxt
bottomTxt color img
= B.useAsCString fontName $
\cFontName -> B.useAsCString topTxt $
\cTopTxt -> B.useAsCString bottomTxt $
\cBottomTxt -> GD.withImagePtr img $
\imgPtr -> do
res <- GD.gdImageStringFTCircle imgPtr (GD.int ctrX) (GD.int ctrY)
(GD.double rad) (GD.double textRad)
(GD.double textFill) cFontName
(GD.double fontSize) cTopTxt
cBottomTxt color
unless (res == F.nullPtr) (peekCAString res >>= ioError . userError)
|
