git.iko.soy/vty
on dc8be4e 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 , 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 , translate
38 -- | The possible display attributes used in constructing an `Image`.
39 , module Graphics.Vty.Attributes
40 )
41 where
43import Graphics.Vty.Attributes
44import Graphics.Vty.Image.Internal
45import Graphics.Text.Width
47import qualified Data.ByteString as B
48import qualified Data.ByteString.Lazy as BL
49import Data.Monoid
50import qualified Data.Text as T
51import qualified Data.Text.Encoding as T
52import qualified Data.Text.Lazy as TL
53import qualified Data.Text.Lazy.Encoding as TL
54import Data.Word
56infixr 5 <|>
57infixr 4 <->
59-- | Currently append in the Monoid instance is equivalent to <->.
60instance Monoid Image where
61 mempty = EmptyImage
62 mappend = (<->)
64-- | combines two images side by side
65--
66-- Combines text chunks where possible. Assures output_width and output_height properties are not
67-- violated.
68--
69-- The result image will have a width equal to the sum of the two images width. And the height will
70-- equal the largest height of the two images. The area not defined in one image due to a height
71-- missmatch will be filled with the background pattern.
72--
73-- TODO: the bg fill is biased towards top to bottom languages(?)
74horiz_join :: Image -> Image -> Image
75horiz_join EmptyImage i = i
76horiz_join i EmptyImage = i
77horiz_join i_0@(HorizText a_0 t_0 w_0 cw_0) i_1@(HorizText a_1 t_1 w_1 cw_1)
78 | a_0 == a_1 = HorizText a_0 (TL.append t_0 t_1) (w_0 + w_1) (cw_0 + cw_1)
79 -- TODO: assumes horiz text height is always 1
80 | otherwise = HorizJoin i_0 i_1 (w_0 + w_1) 1
81horiz_join i_0 i_1
82 -- If the images are of the same height then no padding is required
83 | h_0 == h_1 = HorizJoin i_0 i_1 w h_0
84 -- otherwise one of the images needs to be padded to the right size.
85 | h_0 < h_1 -- Pad i_0
86 = let pad_amount = h_1 - h_0
87 in HorizJoin (VertJoin i_0 (BGFill w_0 pad_amount) w_0 h_1) i_1 w h_1
88 | h_0 > h_1 -- Pad i_1
89 = let pad_amount = h_0 - h_1
90 in HorizJoin i_0 (VertJoin i_1 (BGFill w_1 pad_amount) w_1 h_0) w h_0
91 where
92 w_0 = image_width i_0
93 w_1 = image_width i_1
94 w = w_0 + w_1
95 h_0 = image_height i_0
96 h_1 = image_height i_1
97horiz_join _ _ = error "horiz_join applied to undefined values."
99-- | combines two images vertically
100--
101-- The result image will have a height equal to the sum of the heights of both images.
102-- The width will equal the largest width of the two images.
103-- The area not defined in one image due to a width missmatch will be filled with the background
104-- pattern.
105--
106-- TODO: the bg fill is biased towards right to left languages(?)
107vert_join :: Image -> Image -> Image
108vert_join EmptyImage i = i
109vert_join i EmptyImage = i
110vert_join i_0 i_1
111 -- If the images are of the same width then no background padding is required
112 | w_0 == w_1 = VertJoin i_0 i_1 w_0 h
113 -- Otherwise one of the images needs to be padded to the size of the other image.
114 | w_0 < w_1
115 = let pad_amount = w_1 - w_0
116 in VertJoin (HorizJoin i_0 (BGFill pad_amount h_0) w_1 h_0) i_1 w_1 h
117 | w_0 > w_1
118 = let pad_amount = w_0 - w_1
119 in VertJoin i_0 (HorizJoin i_1 (BGFill pad_amount h_1) w_0 h_1) w_0 h
120 where
121 w_0 = image_width i_0
122 w_1 = image_width i_1
123 h_0 = image_height i_0
124 h_1 = image_height i_1
125 h = h_0 + h_1
126vert_join _ _ = error "vert_join applied to undefined values."
128-- | An area of the picture's bacground (See Background) of w columns and h rows.
129background_fill :: Int -> Int -> Image
130background_fill w h
131 | w == 0 = EmptyImage
132 | h == 0 = EmptyImage
133 | otherwise = BGFill w h
135-- | Combines two images horizontally. Alias for horiz_join
136--
137-- infixr 5
138(<|>) :: Image -> Image -> Image
139(<|>) = horiz_join
141-- | Combines two images vertically. Alias for vert_join
142--
143-- infixr 4
144(<->) :: Image -> Image -> Image
145(<->) = vert_join
147-- | Compose any number of images horizontally.
148horiz_cat :: [Image] -> Image
149horiz_cat = foldr (<|>) EmptyImage
151-- | Compose any number of images vertically.
152vert_cat :: [Image] -> Image
153vert_cat = foldr (<->) EmptyImage
155-- | A Data.Text.Lazy value
156text :: Attr -> TL.Text -> Image
157text a txt
158 | TL.length txt == 0 = EmptyImage
159 | otherwise = let display_width = safe_wcswidth (TL.unpack txt)
160 in HorizText a txt display_width (fromIntegral $! TL.length txt)
162-- | A Data.Text value
163strict_text :: Attr -> T.Text -> Image
164strict_text a txt
165 | T.length txt == 0 = EmptyImage
166 | otherwise = let display_width = safe_wcswidth (T.unpack txt)
167 in HorizText a (TL.fromStrict txt) display_width (T.length txt)
169-- | an image of a single character. This is a standard Haskell 31-bit character assumed to be in
170-- the ISO-10646 encoding.
171char :: Attr -> Char -> Image
172char a c =
173 let display_width = safe_wcwidth c
174 in HorizText a (TL.singleton c) display_width 1
176-- | A string of characters layed out on a single row with the same display attribute. The string is
177-- assumed to be a sequence of ISO-10646 characters.
178--
179-- Note: depending on how the Haskell compiler represents string literals a string literal in a
180-- UTF-8 encoded source file, for example, may be represented as a ISO-10646 string.
181-- That is, I think, the case with GHC 6.10. This means, for the most part, you don't need to worry
182-- about the encoding format when outputting string literals. Just provide the string literal
183-- directly to iso_10646_string or string.
184--
185iso_10646_string :: Attr -> String -> Image
186iso_10646_string a str =
187 let display_width = safe_wcswidth str
188 in HorizText a (TL.pack str) display_width (length str)
190-- | Alias for iso_10646_string. Since the usual case is that a literal string like "foo" is
191-- represented internally as a list of ISO 10646 31 bit characters.
192--
193-- Note: Keep in mind that GHC will compile source encoded as UTF-8 but the literal strings, while
194-- UTF-8 encoded in the source, will be transcoded to a ISO 10646 31 bit characters runtime
195-- representation.
196string :: Attr -> String -> Image
197string = iso_10646_string
199-- | A string of characters layed out on a single row. The input is assumed to be the bytes for
200-- UTF-8 encoded text.
201utf8_string :: Attr -> [Word8] -> Image
202utf8_string a bytes = utf8_bytestring a (BL.pack bytes)
204-- | Renders a UTF-8 encoded lazy bytestring.
205utf8_bytestring :: Attr -> BL.ByteString -> Image
206utf8_bytestring a bs = text a (TL.decodeUtf8 bs)
208-- | Renders a UTF-8 encoded strict bytestring.
209utf8_strict_bytestring :: Attr -> B.ByteString -> Image
210utf8_strict_bytestring a bs = strict_text a (T.decodeUtf8 bs)
212-- | creates a fill of the specified character. The dimensions are in number of characters wide and
213-- number of rows high.
214--
215-- Unlike the Background fill character this character can have double column display width.
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.
232pad :: Int -> Int -> Int -> Int -> Image -> Image
233pad 0 0 0 0 i = i
234pad in_l in_t in_r in_b in_image
235 | in_l < 0 || in_t < 0 || in_r < 0 || in_b < 0 = error "cannot pad by negative amount"
236 | otherwise = go in_l in_t in_r in_b in_image
237 where
238 -- TODO: uh.
239 go 0 0 0 0 i = i
240 go 0 0 0 b i = VertJoin i (BGFill w b) w h
241 where w = image_width i
242 h = image_height i + b
243 go 0 0 r b i = go 0 0 0 b $ HorizJoin i (BGFill r h) w h
244 where w = image_width i + r
245 h = image_height i
246 go 0 t r b i = go 0 0 r b $ VertJoin (BGFill w t) i w h
247 where w = image_width i
248 h = image_height i + t
249 go l t r b i = go 0 t r b $ HorizJoin (BGFill l h) i w h
250 where w = image_width i + l
251 h = image_height i
253-- | "translates" an image by padding the top and left.
254translate :: Int -> Int -> Image -> Image
255translate x y i = pad x y 0 0 i
257-- | Ensure an image is no larger than the provided size. If the image is larger then crop the right
258-- or bottom.
259--
260-- This is transformed to a vertical crop from the bottom followed by horizontal crop from the
261-- right.
262crop :: Int -> Int -> Image -> Image
263crop 0 _ _ = EmptyImage
264crop _ 0 _ = EmptyImage
265crop w h i = crop_bottom h (crop_right w 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 bottom.
269crop_bottom :: Int -> Image -> Image
270crop_bottom 0 _ = EmptyImage
271crop_bottom h in_i
272 | h < 0 = error "cannot crop height to less than zero"
273 | otherwise = go in_i
274 where
275 go EmptyImage = EmptyImage
276 go (CropBottom {cropped_image, output_width, output_height}) =
277 CropBottom cropped_image output_width (min h output_height)
278 go i
279 | h >= image_height i = i
280 | otherwise = CropBottom i (image_width i) h
282crop_right :: Int -> Image -> Image
283crop_right 0 _ = EmptyImage
284crop_right w in_i
285 | w < 0 = error "cannot crop width to less than zero"
286 | otherwise = go in_i
287 where
288 go EmptyImage = EmptyImage
289 go (CropRight {cropped_image, output_width, output_height}) =
290 CropRight cropped_image (min w output_width) output_height
291 go i
292 | w >= image_width i = i
293 | otherwise = CropRight i w (image_height i)
295crop_left :: Int -> Image -> Image
296crop_left _ _ = error "not implemented"
298crop_top :: Int -> Image -> Image
299crop_top _ _ = error "not implemented"
301-- | Generic resize. Pads and crops as required to assure the given display width and height.
302-- This is biased to pad the right and bottom.
303resize :: Int -> Int -> Image -> Image
304resize _w _h _i = error "not implemented yet"