git.iko.soy/vty
on ffe6de2 help sign in
vty/src/Graphics/Vty/Image.hs
356 lines 14 kB history raw
1-- Copyright 2009-2010 Corey O'Connor
2{-# LANGUAGE BangPatterns #-}
3{-# LANGUAGE NamedFieldPuns #-}
4{-# LANGUAGE DisambiguateRecordFields #-}
5module Graphics.Vty.Image ( DisplayText
6 , Image
7 , image_width
8 , image_height
9 , horiz_join
10 , (<|>)
11 , vert_join
12 , (<->)
13 , horiz_cat
14 , vert_cat
15 , background_fill
16 , text
17 , strict_text
18 , char
19 , string
20 , iso_10646_string
21 , utf8_string
22 , utf8_bytestring
23 , utf8_strict_bytestring
24 , char_fill
25 , empty_image
26 , safe_wcwidth
27 , safe_wcswidth
28 , wcwidth
29 , wcswidth
30 , crop
31 , crop_right
32 , crop_left
33 , crop_bottom
34 , crop_top
35 , pad
36 , resize
37 , resize_width
38 , resize_height
39 , translate
40 -- | The possible display attributes used in constructing an `Image`.
41 , module Graphics.Vty.Attributes
42 )
43 where
45import Graphics.Vty.Attributes
46import Graphics.Vty.Image.Internal
47import Graphics.Text.Width
49import qualified Data.ByteString as B
50import qualified Data.ByteString.Lazy as BL
51import Data.Monoid
52import qualified Data.Text as T
53import qualified Data.Text.Encoding as T
54import qualified Data.Text.Lazy as TL
55import qualified Data.Text.Lazy.Encoding as TL
56import Data.Word
58infixr 5 <|>
59infixr 4 <->
61-- | Append in the Monoid instance is equivalent to <->.
62instance Monoid Image where
63 mempty = EmptyImage
64 mappend = (<->)
66-- | combines two images side by side
67--
68-- Combines text chunks where possible. Assures output_width and output_height properties are not
69-- violated.
70--
71-- The result image will have a width equal to the sum of the two images width. And the height will
72-- equal the largest height of the two images. The area not defined in one image due to a height
73-- missmatch will be filled with the background pattern.
74--
75-- TODO: the bg fill is biased towards top to bottom languages(?)
76horiz_join :: Image -> Image -> Image
77horiz_join EmptyImage i = i
78horiz_join i EmptyImage = i
79horiz_join i_0@(HorizText a_0 t_0 w_0 cw_0) i_1@(HorizText a_1 t_1 w_1 cw_1)
80 | a_0 == a_1 = HorizText a_0 (TL.append t_0 t_1) (w_0 + w_1) (cw_0 + cw_1)
81 -- TODO: assumes horiz text height is always 1
82 | otherwise = HorizJoin i_0 i_1 (w_0 + w_1) 1
83horiz_join i_0 i_1
84 -- If the images are of the same height then no padding is required
85 | h_0 == h_1 = HorizJoin i_0 i_1 w h_0
86 -- otherwise one of the images needs to be padded to the right size.
87 | h_0 < h_1 -- Pad i_0
88 = let pad_amount = h_1 - h_0
89 in HorizJoin (VertJoin i_0 (BGFill w_0 pad_amount) w_0 h_1) i_1 w h_1
90 | h_0 > h_1 -- Pad i_1
91 = let pad_amount = h_0 - h_1
92 in HorizJoin i_0 (VertJoin i_1 (BGFill w_1 pad_amount) w_1 h_0) w h_0
93 where
94 w_0 = image_width i_0
95 w_1 = image_width i_1
96 w = w_0 + w_1
97 h_0 = image_height i_0
98 h_1 = image_height i_1
99horiz_join _ _ = error "horiz_join applied to undefined values."
101-- | combines two images vertically
102--
103-- The result image will have a height equal to the sum of the heights of both images.
104-- The width will equal the largest width of the two images.
105-- The area not defined in one image due to a width missmatch will be filled with the background
106-- pattern.
107--
108-- TODO: the bg fill is biased towards right to left languages(?)
109vert_join :: Image -> Image -> Image
110vert_join EmptyImage i = i
111vert_join i EmptyImage = i
112vert_join i_0 i_1
113 -- If the images are of the same width then no background padding is required
114 | w_0 == w_1 = VertJoin i_0 i_1 w_0 h
115 -- Otherwise one of the images needs to be padded to the size of the other image.
116 | w_0 < w_1
117 = let pad_amount = w_1 - w_0
118 in VertJoin (HorizJoin i_0 (BGFill pad_amount h_0) w_1 h_0) i_1 w_1 h
119 | w_0 > w_1
120 = let pad_amount = w_0 - w_1
121 in VertJoin i_0 (HorizJoin i_1 (BGFill pad_amount h_1) w_0 h_1) w_0 h
122 where
123 w_0 = image_width i_0
124 w_1 = image_width i_1
125 h_0 = image_height i_0
126 h_1 = image_height i_1
127 h = h_0 + h_1
128vert_join _ _ = error "vert_join applied to undefined values."
130-- | An area of the picture's bacground (See Background) of w columns and h rows.
131background_fill :: Int -> Int -> Image
132background_fill w h
133 | w == 0 = EmptyImage
134 | h == 0 = EmptyImage
135 | otherwise = BGFill w h
137-- | Combines two images horizontally. Alias for horiz_join
138--
139-- infixr 5
140(<|>) :: Image -> Image -> Image
141(<|>) = horiz_join
143-- | Combines two images vertically. Alias for vert_join
144--
145-- infixr 4
146(<->) :: Image -> Image -> Image
147(<->) = vert_join
149-- | Compose any number of images horizontally.
150horiz_cat :: [Image] -> Image
151horiz_cat = foldr (<|>) EmptyImage
153-- | Compose any number of images vertically.
154vert_cat :: [Image] -> Image
155vert_cat = foldr (<->) EmptyImage
157-- | A Data.Text.Lazy value
158text :: Attr -> TL.Text -> Image
159text a txt
160 | TL.length txt == 0 = EmptyImage
161 | otherwise = let display_width = safe_wcswidth (TL.unpack txt)
162 in HorizText a txt display_width (fromIntegral $! TL.length txt)
164-- | A Data.Text value
165strict_text :: Attr -> T.Text -> Image
166strict_text a txt
167 | T.length txt == 0 = EmptyImage
168 | otherwise = let display_width = safe_wcswidth (T.unpack txt)
169 in HorizText a (TL.fromStrict txt) display_width (T.length txt)
171-- | an image of a single character. This is a standard Haskell 31-bit character assumed to be in
172-- the ISO-10646 encoding.
173char :: Attr -> Char -> Image
174char a c =
175 let display_width = safe_wcwidth c
176 in HorizText a (TL.singleton c) display_width 1
178-- | A string of characters layed out on a single row with the same display attribute. The string is
179-- assumed to be a sequence of ISO-10646 characters.
180--
181-- Note: depending on how the Haskell compiler represents string literals a string literal in a
182-- UTF-8 encoded source file, for example, may be represented as a ISO-10646 string.
183-- That is, I think, the case with GHC 6.10. This means, for the most part, you don't need to worry
184-- about the encoding format when outputting string literals. Just provide the string literal
185-- directly to iso_10646_string or string.
186--
187iso_10646_string :: Attr -> String -> Image
188iso_10646_string a str =
189 let display_width = safe_wcswidth str
190 in HorizText a (TL.pack str) display_width (length str)
192-- | Alias for iso_10646_string. Since the usual case is that a literal string like "foo" is
193-- represented internally as a list of ISO 10646 31 bit characters.
194--
195-- Note: Keep in mind that GHC will compile source encoded as UTF-8 but the literal strings, while
196-- UTF-8 encoded in the source, will be transcoded to a ISO 10646 31 bit characters runtime
197-- representation.
198string :: Attr -> String -> Image
199string = iso_10646_string
201-- | A string of characters layed out on a single row. The input is assumed to be the bytes for
202-- UTF-8 encoded text.
203utf8_string :: Attr -> [Word8] -> Image
204utf8_string a bytes = utf8_bytestring a (BL.pack bytes)
206-- | Renders a UTF-8 encoded lazy bytestring.
207utf8_bytestring :: Attr -> BL.ByteString -> Image
208utf8_bytestring a bs = text a (TL.decodeUtf8 bs)
210-- | Renders a UTF-8 encoded strict bytestring.
211utf8_strict_bytestring :: Attr -> B.ByteString -> Image
212utf8_strict_bytestring a bs = strict_text a (T.decodeUtf8 bs)
214-- | creates a fill of the specified character. The dimensions are in number of characters wide and
215-- number of rows high.
216char_fill :: Integral d => Attr -> Char -> d -> d -> Image
217char_fill _a _c 0 _h = EmptyImage
218char_fill _a _c _w 0 = EmptyImage
219char_fill a c w h =
220 vert_cat $ replicate (fromIntegral h) $ HorizText a txt display_width char_width
221 where
222 txt = TL.replicate (fromIntegral w) (TL.singleton c)
223 display_width = safe_wcwidth c * (fromIntegral w)
224 char_width = fromIntegral w
226-- | The empty image. Useful for fold combinators. These occupy no space nor define any display
227-- attributes.
228empty_image :: Image
229empty_image = EmptyImage
231-- | pad the given image. This adds background character fills to the left, top, right, bottom.
232-- The pad values are how many display columns or rows to add.
233pad :: Int -> Int -> Int -> Int -> Image -> Image
234pad 0 0 0 0 i = i
235pad in_l in_t in_r in_b in_image
236 | in_l < 0 || in_t < 0 || in_r < 0 || in_b < 0 = error "cannot pad by negative amount"
237 | otherwise = go in_l in_t in_r in_b in_image
238 where
239 -- TODO: uh.
240 go 0 0 0 0 i = i
241 go 0 0 0 b i = VertJoin i (BGFill w b) w h
242 where w = image_width i
243 h = image_height i + b
244 go 0 0 r b i = go 0 0 0 b $ HorizJoin i (BGFill r h) w h
245 where w = image_width i + r
246 h = image_height i
247 go 0 t r b i = go 0 0 r b $ VertJoin (BGFill w t) i w h
248 where w = image_width i
249 h = image_height i + t
250 go l t r b i = go 0 t r b $ HorizJoin (BGFill l h) i w h
251 where w = image_width i + l
252 h = image_height i
254-- | "translates" an image by padding the top and left.
255translate :: Int -> Int -> Image -> Image
256translate x y i = pad x y 0 0 i
258-- | Ensure an image is no larger than the provided size. If the image is larger then crop the right
259-- or bottom.
260--
261-- This is transformed to a vertical crop from the bottom followed by horizontal crop from the
262-- right.
263crop :: Int -> Int -> Image -> Image
264crop 0 _ _ = EmptyImage
265crop _ 0 _ = EmptyImage
266crop w h i = crop_bottom h (crop_right w i)
268-- | crop the display height. If the image is less than or equal in height then this operation has
269-- no effect. Otherwise the image is cropped from the bottom.
270crop_bottom :: Int -> Image -> Image
271crop_bottom 0 _ = EmptyImage
272crop_bottom h in_i
273 | h < 0 = error "cannot crop height to less than zero"
274 | otherwise = go in_i
275 where
276 go EmptyImage = EmptyImage
277 go i@(CropBottom {cropped_image, output_width, output_height})
278 | output_height <= h = i
279 | otherwise = CropBottom cropped_image output_width h
280 go i
281 | h >= image_height i = i
282 | otherwise = CropBottom i (image_width i) h
284-- | ensure the image is no wider than the given width. If the image is wider then crop the right
285-- side.
286crop_right :: Int -> Image -> Image
287crop_right 0 _ = EmptyImage
288crop_right w in_i
289 | w < 0 = error "cannot crop width to less than zero"
290 | otherwise = go in_i
291 where
292 go EmptyImage = EmptyImage
293 go i@(CropRight {cropped_image, output_width, output_height})
294 | output_width <= w = i
295 | otherwise = CropRight cropped_image w output_height
296 go i
297 | w >= image_width i = i
298 | otherwise = CropRight i w (image_height i)
300-- | ensure the image is no wider than the given width. If the image is wider then crop the left
301-- side.
302crop_left :: Int -> Image -> Image
303crop_left 0 _ = EmptyImage
304crop_left w in_i
305 | w < 0 = error "cannot crop the width to less than zero"
306 | otherwise = go in_i
307 where
308 go EmptyImage = EmptyImage
309 go i@(CropLeft {cropped_image, left_skip, output_width, output_height})
310 | output_width <= w = i
311 | otherwise =
312 let left_skip' = left_skip + output_width - w
313 in CropLeft cropped_image left_skip' w output_height
314 go i
315 | image_width i <= w = i
316 | otherwise = CropLeft i (image_width i - w) w (image_height i)
318-- | crop the display height. If the image is less than or equal in height then this operation has
319-- no effect. Otherwise the image is cropped from the top.
320crop_top :: Int -> Image -> Image
321crop_top 0 _ = EmptyImage
322crop_top h in_i
323 | h < 0 = error "cannot crop the height to less than zero"
324 | otherwise = go in_i
325 where
326 go EmptyImage = EmptyImage
327 go i@(CropTop {cropped_image, top_skip, output_width, output_height})
328 | output_height <= h = i
329 | otherwise =
330 let top_skip' = top_skip + output_height - h
331 in CropTop cropped_image top_skip' output_width h
332 go i
333 | image_height i <= h = i
334 | otherwise = CropTop i (image_height i - h) (image_width i) h
336-- | Generic resize. Pads and crops as required to assure the given display width and height.
337-- This is biased to pad/crop the right and bottom.
338resize :: Int -> Int -> Image -> Image
339resize w h i = resize_height h (resize_width w i)
341-- | Resize the width. Pads and crops as required to assure the given display width.
342-- This is biased to pad/crop the right.
343resize_width :: Int -> Image -> Image
344resize_width w i = case w `compare` image_width i of
345 LT -> crop_right w i
346 EQ -> i
347 GT -> i <|> BGFill (w - image_width i) (image_height i)
349-- | Resize the height. Pads and crops as required to assure the given display height.
350-- This is biased to pad/crop the bottom.
351resize_height :: Int -> Image -> Image
352resize_height h i = case h `compare` image_height i of
353 LT -> crop_bottom h i
354 EQ -> i
355 GT -> i <-> BGFill (image_width i) (h - image_height i)