on d64ff96 help sign in
vty/src/Graphics/Vty/Image.hs
380 lines 13 kB history raw
1-- Copyright 2009-2010 Corey O'Connor
2{-# LANGUAGE BangPatterns #-}
3{-# LANGUAGE NamedFieldPuns #-}
4{-# LANGUAGE DisambiguateRecordFields #-}
5-- | A Vty program makes 'Picture's from 'Image's. This module provides
6-- the core constructors for creating, combining, and modifying
7-- 'Image's.
8module Graphics.Vty.Image
9 (
10 -- * Images
11 Image
12 , imageWidth
13 , imageHeight
14 -- * Image constructors
15 , emptyImage
16 , char
17 , string
18 , iso10646String
19 , utf8String
20 , text
21 , text'
22 , backgroundFill
23 , utf8Bytestring
24 , utf8Bytestring'
25 , charFill
26 -- * Combinators
27 , horizJoin
28 , (<|>)
29 , vertJoin
30 , (<->)
31 , horizCat
32 , vertCat
33 -- * Image modifications
34 , crop
35 , cropRight
36 , cropLeft
37 , cropBottom
38 , cropTop
39 , pad
40 , resize
41 , resizeWidth
42 , resizeHeight
43 , translate
44 , translateX
45 , translateY
46 -- * Character width functions
47 , safeWcwidth
48 , safeWcswidth
49 , safeWctwidth
50 , safeWctlwidth
51 , wcwidth
52 , wcswidth
53 , wctwidth
54 , wctlwidth
55 -- * Display Regions
56 , DisplayText
57 , DisplayRegion
58 , regionWidth
59 , regionHeight
60 )
61where
63import Graphics.Vty.Attributes
64import Graphics.Vty.Image.Internal
65import Graphics.Text.Width
67import qualified Data.ByteString as B
68import qualified Data.ByteString.Lazy as BL
69import qualified Data.Text as T
70import qualified Data.Text.Encoding as T
71import qualified Data.Text.Lazy as TL
72import qualified Data.Text.Lazy.Encoding as TL
73import Data.Word
75-- | A region of the display (first width, then height)
76type DisplayRegion = (Int,Int)
78regionWidth :: DisplayRegion -> Int
79regionWidth = fst
81regionHeight :: DisplayRegion -> Int
82regionHeight = snd
84infixr 5 <|>
85infixr 4 <->
87-- | An area of the picture's background (See 'Background').
88backgroundFill :: Int
89 -- ^ Fill width in columns
90 -> Int
91 -- ^ Fill height in rows
92 -> Image
93backgroundFill w h
94 | w == 0 = EmptyImage
95 | h == 0 = EmptyImage
96 | otherwise = BGFill w h
98-- | Combines two images horizontally. This is an alias for 'horizJoin'.
99--
100-- infixr 5
101(<|>) :: Image -> Image -> Image
102(<|>) = horizJoin
104-- | Combines two images vertically. This is an alias for 'vertJoin'.
105--
106-- infixr 4
107(<->) :: Image -> Image -> Image
108(<->) = vertJoin
110-- | Compose any number of images together horizontally, with the first
111-- in the list being leftmost.
112horizCat :: [Image] -> Image
113horizCat = foldr horizJoin EmptyImage
115-- | Compose any number of images vertically, with the first in the list
116-- being topmost.
117vertCat :: [Image] -> Image
118vertCat = foldr vertJoin EmptyImage
120-- | Make an 'Image' from a lazy text value. This function should not be
121-- given a text value containing escapes.
122text :: Attr -> TL.Text -> Image
123text a txt = let displayWidth = safeWctlwidth txt
124 in HorizText a txt displayWidth (fromIntegral $! TL.length txt)
126-- | Make an 'Image' from a text value. This function should not be
127-- given a text value containing escapes.
128text' :: Attr -> T.Text -> Image
129text' a txt = let displayWidth = safeWctwidth txt
130 in HorizText a (TL.fromStrict txt) displayWidth (T.length txt)
132-- | Make an image from a single character. This is a standard Haskell
133-- 31-bit character assumed to be in the ISO-10646 encoding.
134char :: Attr -> Char -> Image
135char a c =
136 let displayWidth = safeWcwidth c
137 in HorizText a (TL.singleton c) displayWidth 1
139-- | Make an image from a string of characters layed out on a single
140-- row with the same display attribute. The string is assumed to be a
141-- sequence of ISO-10646 characters. This function should not be given a
142-- string containing escapes.
143--
144-- Note: depending on how the Haskell compiler represents string
145-- literals, a string literal in a UTF-8 encoded source file, for
146-- example, may be represented as a ISO-10646 string. That is, I think,
147-- the case with GHC 6.10. This means, for the most part, you don't need
148-- to worry about the encoding format when outputting string literals.
149-- Just provide the string literal directly to iso10646String or string.
150iso10646String :: Attr -> String -> Image
151iso10646String a str =
152 let displayWidth = safeWcswidth str
153 in HorizText a (TL.pack str) displayWidth (length str)
155-- | Make an 'Image' from a 'String'.
156--
157-- This is an alias for iso10646String since the usual case is that a
158-- literal string like "foo" is represented internally as a list of ISO
159-- 10646 31 bit characters. This function should not be given a string
160-- containing escapes.
161--
162-- Note: Keep in mind that GHC will compile source encoded as UTF-8
163-- but the literal strings, while UTF-8 encoded in the source, will be
164-- transcoded to a ISO 10646 31 bit characters runtime representation.
165string :: Attr -> String -> Image
166string = iso10646String
168-- | Make an 'Image' from a string of characters layed out on a single
169-- row. The input is assumed to be the bytes for UTF-8 encoded text.
170utf8String :: Attr -> [Word8] -> Image
171utf8String a bytes = utf8Bytestring a (BL.pack bytes)
173-- | Make an 'Image' from a UTF-8 encoded lazy bytestring.
174utf8Bytestring :: Attr -> BL.ByteString -> Image
175utf8Bytestring a bs = text a (TL.decodeUtf8 bs)
177-- | Make an 'Image' from a UTF-8 encoded lazy bytestring.
178utf8Bytestring' :: Attr -> B.ByteString -> Image
179utf8Bytestring' a bs = text' a (T.decodeUtf8 bs)
181-- | Make an image filling a region with the specified character.
182--
183-- If either the width or height are less than or equal to 0, then
184-- the result is the empty image.
185charFill :: Integral d
186 => Attr
187 -- ^ The attribute to use.
188 -> Char
189 -- ^ The character to use in filling the region.
190 -> d
191 -- ^ The region width.
192 -> d
193 -- ^ The region height.
194 -> Image
195charFill a c w h
196 | w <= 0 || h <= 0 = EmptyImage
197 | otherwise = vertCat
198 $ replicate (fromIntegral h)
199 $ HorizText a txt displayWidth charWidth
200 where
201 txt = TL.replicate charWidth (TL.singleton c)
202 displayWidth = safeWcwidth c * charWidth
204 charWidth :: Num a => a
205 charWidth = fromIntegral w
207-- | The empty image. Useful for fold combinators. These occupy no space
208-- and do not affect display attributes.
209emptyImage :: Image
210emptyImage = EmptyImage
212-- | Pad the given image. This adds background character fills to the
213-- left, top, right, bottom.
214pad :: Int
215 -- ^ How much padding to add to the left side of the image.
216 -> Int
217 -- ^ How much padding to add to the top of the image.
218 -> Int
219 -- ^ How much padding to add to the right side of the image.
220 -> Int
221 -- ^ How much padding to add to the bottom of the image.
222 -> Image
223 -- ^ The image to pad.
224 -> Image
225pad 0 0 0 0 i = i
226pad inL inT inR inB inImage
227 | inL < 0 || inT < 0 || inR < 0 || inB < 0 = error "cannot pad by negative amount"
228 | otherwise = go inL inT inR inB inImage
229 where
230 go 0 0 0 0 i = i
231 go 0 0 0 b i = VertJoin i (BGFill w b) w h
232 where w = imageWidth i
233 h = imageHeight i + b
234 go 0 0 r b i = go 0 0 0 b $ HorizJoin i (BGFill r h) w h
235 where w = imageWidth i + r
236 h = imageHeight i
237 go 0 t r b i = go 0 0 r b $ VertJoin (BGFill w t) i w h
238 where w = imageWidth i
239 h = imageHeight i + t
240 go l t r b i = go 0 t r b $ HorizJoin (BGFill l h) i w h
241 where w = imageWidth i + l
242 h = imageHeight i
244-- | Translates an image by padding or cropping the left and top.
245--
246-- If translation offsets are negative then the image is cropped.
247translate :: Int
248 -- ^ The horizontal translation offset (can be negative)
249 -> Int
250 -- ^ The vertical translation offset (can be negative)
251 -> Image
252 -- ^ The image to translate.
253 -> Image
254translate x y i = translateX x (translateY y i)
256-- | Translates an image by padding or cropping its left side.
257translateX :: Int -> Image -> Image
258translateX x i
259 | x < 0 && (abs x > imageWidth i) = emptyImage
260 | x < 0 = let s = abs x in CropLeft i s (imageWidth i - s) (imageHeight i)
261 | x == 0 = i
262 | otherwise = let h = imageHeight i in HorizJoin (BGFill x h) i (imageWidth i + x) h
264-- | Translates an image by padding or cropping its top.
265translateY :: Int -> Image -> Image
266translateY y i
267 | y < 0 && (abs y > imageHeight i) = emptyImage
268 | y < 0 = let s = abs y in CropTop i s (imageWidth i) (imageHeight i - s)
269 | y == 0 = i
270 | otherwise = let w = imageWidth i in VertJoin (BGFill w y) i w (imageHeight i + y)
272-- | Ensure an image is no larger than the provided size. If the image
273-- is larger then crop the right or bottom.
274--
275-- This is equivalent to a vertical crop from the bottom followed by
276-- horizontal crop from the right.
277crop :: Int
278 -- ^ Cropping width
279 -> Int
280 -- ^ Cropping height
281 -> Image
282 -- ^ The image to crop
283 -> Image
284crop 0 _ _ = EmptyImage
285crop _ 0 _ = EmptyImage
286crop w h i = cropBottom h (cropRight w i)
288-- | Crop an image's height. If the image's height is less than or equal
289-- to the specified height then this operation has no effect. Otherwise
290-- the image is cropped from the bottom.
291cropBottom :: Int -> Image -> Image
292cropBottom 0 _ = EmptyImage
293cropBottom h inI
294 | h < 0 = error "cannot crop height to less than zero"
295 | otherwise = go inI
296 where
297 go EmptyImage = EmptyImage
298 go i@(CropBottom {croppedImage, outputWidth, outputHeight})
299 | outputHeight <= h = i
300 | otherwise = CropBottom croppedImage outputWidth h
301 go i
302 | h >= imageHeight i = i
303 | otherwise = CropBottom i (imageWidth i) h
305-- | Crop an image's width. If the image's width is less than or equal
306-- to the specified width then this operation has no effect. Otherwise
307-- the image is cropped from the right.
308cropRight :: Int -> Image -> Image
309cropRight 0 _ = EmptyImage
310cropRight w inI
311 | w < 0 = error "cannot crop width to less than zero"
312 | otherwise = go inI
313 where
314 go EmptyImage = EmptyImage
315 go i@(CropRight {croppedImage, outputWidth, outputHeight})
316 | outputWidth <= w = i
317 | otherwise = CropRight croppedImage w outputHeight
318 go i
319 | w >= imageWidth i = i
320 | otherwise = CropRight i w (imageHeight i)
322-- | Crop an image's width. If the image's width is less than or equal
323-- to the specified width then this operation has no effect. Otherwise
324-- the image is cropped from the left.
325cropLeft :: Int -> Image -> Image
326cropLeft 0 _ = EmptyImage
327cropLeft w inI
328 | w < 0 = error "cannot crop the width to less than zero"
329 | otherwise = go inI
330 where
331 go EmptyImage = EmptyImage
332 go i@(CropLeft {croppedImage, leftSkip, outputWidth, outputHeight})
333 | outputWidth <= w = i
334 | otherwise =
335 let leftSkip' = leftSkip + outputWidth - w
336 in CropLeft croppedImage leftSkip' w outputHeight
337 go i
338 | imageWidth i <= w = i
339 | otherwise = CropLeft i (imageWidth i - w) w (imageHeight i)
341-- | Crop an image's height. If the image's height is less than or equal
342-- to the specified height then this operation has no effect. Otherwise
343-- the image is cropped from the top.
344cropTop :: Int -> Image -> Image
345cropTop 0 _ = EmptyImage
346cropTop h inI
347 | h < 0 = error "cannot crop the height to less than zero"
348 | otherwise = go inI
349 where
350 go EmptyImage = EmptyImage
351 go i@(CropTop {croppedImage, topSkip, outputWidth, outputHeight})
352 | outputHeight <= h = i
353 | otherwise =
354 let topSkip' = topSkip + outputHeight - h
355 in CropTop croppedImage topSkip' outputWidth h
356 go i
357 | imageHeight i <= h = i
358 | otherwise = CropTop i (imageHeight i - h) (imageWidth i) h
360-- | Generic resize. Pads and crops are added to ensure that the
361-- resulting image matches the specified dimensions. This is biased to
362-- pad/crop the right and bottom.
363resize :: Int -> Int -> Image -> Image
364resize w h i = resizeHeight h (resizeWidth w i)
366-- | Resize the width. Pads and crops as required to assure the given
367-- display width. This is biased to pad/crop on the right.
368resizeWidth :: Int -> Image -> Image
369resizeWidth w i = case w `compare` imageWidth i of
370 LT -> cropRight w i
371 EQ -> i
372 GT -> i <|> BGFill (w - imageWidth i) (imageHeight i)
374-- | Resize the height. Pads and crops as required to assure the given
375-- display height. This is biased to pad/crop on the bottom.
376resizeHeight :: Int -> Image -> Image
377resizeHeight h i = case h `compare` imageHeight i of
378 LT -> cropBottom h i
379 EQ -> i
380 GT -> i <-> BGFill (imageWidth i) (h - imageHeight i)