git.iko.soy/vty
on 00a6a4f help sign in
vty/src/Graphics/Vty/Image.hs
305 lines 12 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 , text'
18 , char
19 , string
20 , iso_10646_string
21 , utf8_string
22 , utf8_bytestring
23 , utf8_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 , translate_x
41 , translate_y
42 -- | The possible display attributes used in constructing an `Image`.
43 , module Graphics.Vty.Attributes
44 )
45 where
47import Graphics.Vty.Attributes
48import Graphics.Vty.Image.Internal
49import Graphics.Text.Width
51import qualified Data.ByteString as B
52import qualified Data.ByteString.Lazy as BL
53import qualified Data.Text as T
54import qualified Data.Text.Encoding as T
55import qualified Data.Text.Lazy as TL
56import qualified Data.Text.Lazy.Encoding as TL
57import Data.Word
59infixr 5 <|>
60infixr 4 <->
62-- | An area of the picture's bacground (See Background) of w columns and h rows.
63background_fill :: Int -> Int -> Image
64background_fill w h
65 | w == 0 = EmptyImage
66 | h == 0 = EmptyImage
67 | otherwise = BGFill w h
69-- | Combines two images horizontally. Alias for horiz_join
70--
71-- infixr 5
72(<|>) :: Image -> Image -> Image
73(<|>) = horiz_join
75-- | Combines two images vertically. Alias for vert_join
76--
77-- infixr 4
78(<->) :: Image -> Image -> Image
79(<->) = vert_join
81-- | Compose any number of images horizontally.
82horiz_cat :: [Image] -> Image
83horiz_cat = foldr horiz_join EmptyImage
85-- | Compose any number of images vertically.
86vert_cat :: [Image] -> Image
87vert_cat = foldr vert_join EmptyImage
89-- | A Data.Text.Lazy value
90text :: Attr -> TL.Text -> Image
91text a txt
92 | TL.length txt == 0 = EmptyImage
93 | otherwise = let display_width = safe_wcswidth (TL.unpack txt)
94 in HorizText a txt display_width (fromIntegral $! TL.length txt)
96-- | A Data.Text value
97text' :: Attr -> T.Text -> Image
98text' a txt
99 | T.length txt == 0 = EmptyImage
100 | otherwise = let display_width = safe_wcswidth (T.unpack txt)
101 in HorizText a (TL.fromStrict txt) display_width (T.length txt)
103-- | an image of a single character. This is a standard Haskell 31-bit character assumed to be in
104-- the ISO-10646 encoding.
105char :: Attr -> Char -> Image
106char a c =
107 let display_width = safe_wcwidth c
108 in HorizText a (TL.singleton c) display_width 1
110-- | A string of characters layed out on a single row with the same display attribute. The string is
111-- assumed to be a sequence of ISO-10646 characters.
112--
113-- Note: depending on how the Haskell compiler represents string literals a string literal in a
114-- UTF-8 encoded source file, for example, may be represented as a ISO-10646 string.
115-- That is, I think, the case with GHC 6.10. This means, for the most part, you don't need to worry
116-- about the encoding format when outputting string literals. Just provide the string literal
117-- directly to iso_10646_string or string.
118--
119iso_10646_string :: Attr -> String -> Image
120iso_10646_string a str =
121 let display_width = safe_wcswidth str
122 in HorizText a (TL.pack str) display_width (length str)
124-- | Alias for iso_10646_string. Since the usual case is that a literal string like "foo" is
125-- represented internally as a list of ISO 10646 31 bit characters.
126--
127-- Note: Keep in mind that GHC will compile source encoded as UTF-8 but the literal strings, while
128-- UTF-8 encoded in the source, will be transcoded to a ISO 10646 31 bit characters runtime
129-- representation.
130string :: Attr -> String -> Image
131string = iso_10646_string
133-- | A string of characters layed out on a single row. The input is assumed to be the bytes for
134-- UTF-8 encoded text.
135utf8_string :: Attr -> [Word8] -> Image
136utf8_string a bytes = utf8_bytestring a (BL.pack bytes)
138-- | Renders a UTF-8 encoded lazy bytestring.
139utf8_bytestring :: Attr -> BL.ByteString -> Image
140utf8_bytestring a bs = text a (TL.decodeUtf8 bs)
142-- | Renders a UTF-8 encoded strict bytestring.
143utf8_bytestring' :: Attr -> B.ByteString -> Image
144utf8_bytestring' a bs = text' a (T.decodeUtf8 bs)
146-- | creates a fill of the specified character. The dimensions are in number of characters wide and
147-- number of rows high.
148char_fill :: Integral d => Attr -> Char -> d -> d -> Image
149char_fill _a _c 0 _h = EmptyImage
150char_fill _a _c _w 0 = EmptyImage
151char_fill a c w h =
152 vert_cat $ replicate (fromIntegral h) $ HorizText a txt display_width char_width
153 where
154 txt = TL.replicate (fromIntegral w) (TL.singleton c)
155 display_width = safe_wcwidth c * (fromIntegral w)
156 char_width = fromIntegral w
158-- | The empty image. Useful for fold combinators. These occupy no space nor define any display
159-- attributes.
160empty_image :: Image
161empty_image = EmptyImage
163-- | pad the given image. This adds background character fills to the left, top, right, bottom.
164-- The pad values are how many display columns or rows to add.
165pad :: Int -> Int -> Int -> Int -> Image -> Image
166pad 0 0 0 0 i = i
167pad in_l in_t in_r in_b in_image
168 | in_l < 0 || in_t < 0 || in_r < 0 || in_b < 0 = error "cannot pad by negative amount"
169 | otherwise = go in_l in_t in_r in_b in_image
170 where
171 -- TODO: uh.
172 go 0 0 0 0 i = i
173 go 0 0 0 b i = VertJoin i (BGFill w b) w h
174 where w = image_width i
175 h = image_height i + b
176 go 0 0 r b i = go 0 0 0 b $ HorizJoin i (BGFill r h) w h
177 where w = image_width i + r
178 h = image_height i
179 go 0 t r b i = go 0 0 r b $ VertJoin (BGFill w t) i w h
180 where w = image_width i
181 h = image_height i + t
182 go l t r b i = go 0 t r b $ HorizJoin (BGFill l h) i w h
183 where w = image_width i + l
184 h = image_height i
186-- | translates an image by padding or cropping the top and left.
187--
188-- This can have an unexpected effect: Translating an image to less than (0,0) then to greater than
189-- (0,0) will crop the image.
190translate :: Int -> Int -> Image -> Image
191translate x y i = translate_x x (translate_y y i)
193-- | translates an image by padding or cropping the left
194translate_x :: Int -> Image -> Image
195translate_x x i
196 | x < 0 = let s = abs x in CropLeft i s (image_width i - s) (image_height i)
197 | x == 0 = i
198 | otherwise = let h = image_height i in HorizJoin (BGFill x h) i (image_width i + x) h
200-- | translates an image by padding or cropping the top
201translate_y :: Int -> Image -> Image
202translate_y y i
203 | y < 0 = let s = abs y in CropTop i s (image_width i) (image_height i - s)
204 | y == 0 = i
205 | otherwise = let w = image_width i in VertJoin (BGFill w y) i w (image_height i + y)
207-- | Ensure an image is no larger than the provided size. If the image is larger then crop the right
208-- or bottom.
209--
210-- This is transformed to a vertical crop from the bottom followed by horizontal crop from the
211-- right.
212crop :: Int -> Int -> Image -> Image
213crop 0 _ _ = EmptyImage
214crop _ 0 _ = EmptyImage
215crop w h i = crop_bottom h (crop_right w i)
217-- | crop the display height. If the image is less than or equal in height then this operation has
218-- no effect. Otherwise the image is cropped from the bottom.
219crop_bottom :: Int -> Image -> Image
220crop_bottom 0 _ = EmptyImage
221crop_bottom h in_i
222 | h < 0 = error "cannot crop height to less than zero"
223 | otherwise = go in_i
224 where
225 go EmptyImage = EmptyImage
226 go i@(CropBottom {cropped_image, output_width, output_height})
227 | output_height <= h = i
228 | otherwise = CropBottom cropped_image output_width h
229 go i
230 | h >= image_height i = i
231 | otherwise = CropBottom i (image_width i) h
233-- | ensure the image is no wider than the given width. If the image is wider then crop the right
234-- side.
235crop_right :: Int -> Image -> Image
236crop_right 0 _ = EmptyImage
237crop_right w in_i
238 | w < 0 = error "cannot crop width to less than zero"
239 | otherwise = go in_i
240 where
241 go EmptyImage = EmptyImage
242 go i@(CropRight {cropped_image, output_width, output_height})
243 | output_width <= w = i
244 | otherwise = CropRight cropped_image w output_height
245 go i
246 | w >= image_width i = i
247 | otherwise = CropRight i w (image_height i)
249-- | ensure the image is no wider than the given width. If the image is wider then crop the left
250-- side.
251crop_left :: Int -> Image -> Image
252crop_left 0 _ = EmptyImage
253crop_left w in_i
254 | w < 0 = error "cannot crop the width to less than zero"
255 | otherwise = go in_i
256 where
257 go EmptyImage = EmptyImage
258 go i@(CropLeft {cropped_image, left_skip, output_width, output_height})
259 | output_width <= w = i
260 | otherwise =
261 let left_skip' = left_skip + output_width - w
262 in CropLeft cropped_image left_skip' w output_height
263 go i
264 | image_width i <= w = i
265 | otherwise = CropLeft i (image_width i - w) w (image_height i)
267-- | crop the display height. If the image is less than or equal in height then this operation has
268-- no effect. Otherwise the image is cropped from the top.
269crop_top :: Int -> Image -> Image
270crop_top 0 _ = EmptyImage
271crop_top h in_i
272 | h < 0 = error "cannot crop the height to less than zero"
273 | otherwise = go in_i
274 where
275 go EmptyImage = EmptyImage
276 go i@(CropTop {cropped_image, top_skip, output_width, output_height})
277 | output_height <= h = i
278 | otherwise =
279 let top_skip' = top_skip + output_height - h
280 in CropTop cropped_image top_skip' output_width h
281 go i
282 | image_height i <= h = i
283 | otherwise = CropTop i (image_height i - h) (image_width i) h
285-- | Generic resize. Pads and crops as required to assure the given display width and height.
286-- This is biased to pad/crop the right and bottom.
287resize :: Int -> Int -> Image -> Image
288resize w h i = resize_height h (resize_width w i)
290-- | Resize the width. Pads and crops as required to assure the given display width.
291-- This is biased to pad/crop the right.
292resize_width :: Int -> Image -> Image
293resize_width w i = case w `compare` image_width i of
294 LT -> crop_right w i
295 EQ -> i
296 GT -> i <|> BGFill (w - image_width i) (image_height i)
298-- | Resize the height. Pads and crops as required to assure the given display height.
299-- This is biased to pad/crop the bottom.
300resize_height :: Int -> Image -> Image
301resize_height h i = case h `compare` image_height i of
302 LT -> crop_bottom h i
303 EQ -> i
304 GT -> i <-> BGFill (image_width i) (h - image_height i)