git.iko.soy/vty
on cd6747c help sign in
vty/src/Graphics/Vty/Image.hs
304 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 | otherwise = HorizJoin i_0 i_1 (w_0 + w_1) (image_height i_0 + image_height i_1)
80horiz_join i_0 i_1
81 -- If the images are of the same height then no padding is required
82 | h_0 == h_1 = HorizJoin i_0 i_1 w h_0
83 -- otherwise one of the images needs to be padded to the right size.
84 | h_0 < h_1 -- Pad i_0
85 = let pad_amount = h_1 - h_0
86 in HorizJoin (VertJoin i_0 (BGFill w_0 pad_amount) w_0 h_1) i_1 w h_1
87 | h_0 > h_1 -- Pad i_1
88 = let pad_amount = h_0 - h_1
89 in HorizJoin i_0 (VertJoin i_1 (BGFill w_1 pad_amount) w_1 h_0) w h_0
90 where
91 w_0 = image_width i_0
92 w_1 = image_width i_1
93 w = w_0 + w_1
94 h_0 = image_height i_0
95 h_1 = image_height i_1
96horiz_join _ _ = error "horiz_join applied to undefined values."
98-- | combines two images vertically
99--
100-- The result image will have a height equal to the sum of the heights of both images.
101-- The width will equal the largest width of the two images.
102-- The area not defined in one image due to a width missmatch will be filled with the background
103-- pattern.
104--
105-- TODO: the bg fill is biased towards right to left languages(?)
106vert_join :: Image -> Image -> Image
107vert_join EmptyImage i = i
108vert_join i EmptyImage = i
109vert_join i_0 i_1
110 -- If the images are of the same height then no background padding is required
111 | w_0 == w_1 = VertJoin i_0 i_1 w_0 h
112 -- Otherwise one of the images needs to be padded to the size of the other image.
113 | w_0 < w_1
114 = let pad_amount = w_1 - w_0
115 in VertJoin (HorizJoin i_0 (BGFill pad_amount h_0) w_1 h_0) i_1 w_1 h
116 | w_0 > w_1
117 = let pad_amount = w_0 - w_1
118 in VertJoin i_0 (HorizJoin i_1 (BGFill pad_amount h_1) w_0 h_1) w_0 h
119 where
120 w_0 = image_width i_0
121 w_1 = image_width i_1
122 h_0 = image_height i_0
123 h_1 = image_height i_1
124 h = h_0 + h_1
125vert_join _ _ = error "vert_join applied to undefined values."
127-- | An area of the picture's bacground (See Background) of w columns and h rows.
128background_fill :: Int -> Int -> Image
129background_fill w h
130 | w == 0 = EmptyImage
131 | h == 0 = EmptyImage
132 | otherwise = BGFill w h
134-- | Combines two images horizontally. Alias for horiz_join
135--
136-- infixr 5
137(<|>) :: Image -> Image -> Image
138(<|>) = horiz_join
140-- | Combines two images vertically. Alias for vert_join
141--
142-- infixr 4
143(<->) :: Image -> Image -> Image
144(<->) = vert_join
146-- | Compose any number of images horizontally.
147horiz_cat :: [Image] -> Image
148horiz_cat = foldr (<|>) EmptyImage
150-- | Compose any number of images vertically.
151vert_cat :: [Image] -> Image
152vert_cat = foldr (<->) EmptyImage
154-- | A Data.Text.Lazy value
155text :: Attr -> TL.Text -> Image
156text a txt
157 | TL.length txt == 0 = EmptyImage
158 | otherwise = let display_width = safe_wcswidth (TL.unpack txt)
159 in HorizText a txt display_width (fromIntegral $! TL.length txt)
161-- | A Data.Text value
162strict_text :: Attr -> T.Text -> Image
163strict_text a txt
164 | T.length txt == 0 = EmptyImage
165 | otherwise = let display_width = safe_wcswidth (T.unpack txt)
166 in HorizText a (TL.fromStrict txt) display_width (T.length txt)
168-- | an image of a single character. This is a standard Haskell 31-bit character assumed to be in
169-- the ISO-10646 encoding.
170char :: Attr -> Char -> Image
171char a c =
172 let display_width = safe_wcwidth c
173 in HorizText a (TL.singleton c) display_width 1
175-- | A string of characters layed out on a single row with the same display attribute. The string is
176-- assumed to be a sequence of ISO-10646 characters.
177--
178-- Note: depending on how the Haskell compiler represents string literals a string literal in a
179-- UTF-8 encoded source file, for example, may be represented as a ISO-10646 string.
180-- That is, I think, the case with GHC 6.10. This means, for the most part, you don't need to worry
181-- about the encoding format when outputting string literals. Just provide the string literal
182-- directly to iso_10646_string or string.
183--
184iso_10646_string :: Attr -> String -> Image
185iso_10646_string a str =
186 let display_width = safe_wcswidth str
187 in HorizText a (TL.pack str) display_width (length str)
189-- | Alias for iso_10646_string. Since the usual case is that a literal string like "foo" is
190-- represented internally as a list of ISO 10646 31 bit characters.
191--
192-- Note: Keep in mind that GHC will compile source encoded as UTF-8 but the literal strings, while
193-- UTF-8 encoded in the source, will be transcoded to a ISO 10646 31 bit characters runtime
194-- representation.
195string :: Attr -> String -> Image
196string = iso_10646_string
198-- | A string of characters layed out on a single row. The input is assumed to be the bytes for
199-- UTF-8 encoded text.
200utf8_string :: Attr -> [Word8] -> Image
201utf8_string a bytes = utf8_bytestring a (BL.pack bytes)
203-- | Renders a UTF-8 encoded lazy bytestring.
204utf8_bytestring :: Attr -> BL.ByteString -> Image
205utf8_bytestring a bs = text a (TL.decodeUtf8 bs)
207-- | Renders a UTF-8 encoded strict bytestring.
208utf8_strict_bytestring :: Attr -> B.ByteString -> Image
209utf8_strict_bytestring a bs = strict_text a (T.decodeUtf8 bs)
211-- | creates a fill of the specified character. The dimensions are in number of characters wide and
212-- number of rows high.
213--
214-- Unlike the Background fill character this character can have double column display width.
215char_fill :: Integral d => Attr -> Char -> d -> d -> Image
216char_fill _a _c 0 _h = EmptyImage
217char_fill _a _c _w 0 = EmptyImage
218char_fill a c w h =
219 vert_cat $ replicate (fromIntegral h) $ HorizText a txt display_width char_width
220 where
221 txt = TL.replicate (fromIntegral w) (TL.singleton c)
222 display_width = safe_wcwidth c * (fromIntegral w)
223 char_width = fromIntegral w
225-- | The empty image. Useful for fold combinators. These occupy no space nor define any display
226-- attributes.
227empty_image :: Image
228empty_image = EmptyImage
230-- | pad the given image. This adds background character fills to the left, top, right, bottom.
231pad :: Int -> Int -> Int -> Int -> Image -> Image
232pad 0 0 0 0 i = i
233pad in_l in_t in_r in_b in_image
234 | in_l < 0 || in_t < 0 || in_r < 0 || in_b < 0 = error "cannot pad by negative amount"
235 | otherwise = go in_l in_t in_r in_b in_image
236 where
237 -- TODO: uh.
238 go 0 0 0 0 i = i
239 go 0 0 0 b i = VertJoin i (BGFill w b) w h
240 where w = image_width i
241 h = image_height i + b
242 go 0 0 r b i = go 0 0 0 b $ HorizJoin i (BGFill r h) w h
243 where w = image_width i + r
244 h = image_height i
245 go 0 t r b i = go 0 0 r b $ VertJoin (BGFill w t) i w h
246 where w = image_width i
247 h = image_height i + t
248 go l t r b i = go 0 t r b $ HorizJoin (BGFill l h) i w h
249 where w = image_width i + l
250 h = image_height i
252-- | "translates" an image by padding the top and left.
253translate :: Int -> Int -> Image -> Image
254translate x y i = pad x y 0 0 i
256-- | Ensure an image is no larger than the provided size. If the image is larger then crop the right
257-- or bottom.
258--
259-- This is transformed to a vertical crop from the bottom followed by horizontal crop from the
260-- right.
261crop :: Int -> Int -> Image -> Image
262crop 0 _ _ = EmptyImage
263crop _ 0 _ = EmptyImage
264crop w h i = crop_bottom h (crop_right w i)
266-- | crop the display height. If the image is less than or equal in height then this operation has
267-- no effect. Otherwise the image is cropped from the bottom.
268crop_bottom :: Int -> Image -> Image
269crop_bottom 0 _ = EmptyImage
270crop_bottom h in_i
271 | h < 0 = error "cannot crop height to less than zero"
272 | otherwise = go in_i
273 where
274 go EmptyImage = EmptyImage
275 go (CropBottom {cropped_image, output_width, output_height}) =
276 CropBottom cropped_image output_width (min h output_height)
277 go i
278 | h >= image_height i = i
279 | otherwise = CropBottom i (image_width i) h
281crop_right :: Int -> Image -> Image
282crop_right 0 _ = EmptyImage
283crop_right w in_i
284 | w < 0 = error "cannot crop width to less than zero"
285 | otherwise = go in_i
286 where
287 go EmptyImage = EmptyImage
288 go (CropRight {cropped_image, output_width, output_height}) =
289 CropRight cropped_image (min w output_width) output_height
290 go i
291 | w >= image_width i = i
292 | otherwise = CropRight i w (image_height i)
294crop_left :: Int -> Image -> Image
295crop_left _ _ = error "not implemented"
297crop_top :: Int -> Image -> Image
298crop_top _ _ = error "not implemented"
300-- | Generic resize. Pads and crops as required to assure the given display width and height.
301-- This is biased to pad the right and bottom.
302resize :: Int -> Int -> Image -> Image
303resize _w _h _i = error "not implemented yet"