on da635bb help sign in
vty/src/Graphics/Vty/Image.hs
379 lines 16 kB history raw
1-- Copyright 2009-2010 Corey O'Connor
2{-# LANGUAGE BangPatterns #-}
3{-# LANGUAGE NamedFieldPuns #-}
4{-# LANGUAGE DisambiguateRecordFields #-}
5{-# OPTIONS_GHC -funbox-strict-fields #-}
6module Graphics.Vty.Image ( DisplayString
7 , Image(..)
8 , image_width
9 , image_height
10 , (<|>)
11 , (<->)
12 , horiz_cat
13 , vert_cat
14 , background_fill
15 , char
16 , string
17 , iso_10646_string
18 , utf8_string
19 , utf8_bytestring
20 , char_fill
21 , empty_image
22 , translate
23 , safe_wcwidth
24 , safe_wcswidth
25 , wcwidth
26 , wcswidth
27 , crop
28 , pad
29 -- | The possible display attributes used in constructing an `Image`.
30 , module Graphics.Vty.Attributes
31 )
32 where
34import Graphics.Vty.Attributes
36import Codec.Binary.UTF8.Width
38import Codec.Binary.UTF8.String ( decode )
40import qualified Data.ByteString as BS
41import Data.Monoid
42import qualified Data.Sequence as Seq
43import qualified Data.String.UTF8 as UTF8
44import Data.Word
46infixr 5 <|>
47infixr 4 <->
49-- | We pair each character with it's display length. This way we only compute the length once per
50-- character.
51-- * Though currently the width of some strings is still compute multiple times.
52type DisplayString = Seq.Seq (Char, Word)
54-- | An image in VTY defines:
55--
56-- * properties required to display the image. These are properties that effect the output image
57-- but are independent of position
58--
59-- * A set of position-dependent text and attribute regions. The possible regions are:
60--
61-- * a point. ( char )
62--
63-- * a horizontal line of characters with a single attribute. (string, utf8_string,
64-- utf8_bytestring )
65--
66-- * a fill of a single character. (char_fill)
67--
68-- * a fill of the picture's background. (background_fill)
69--
70-- todo: increase the number of encoded bytestring formats supported.
71data Image =
72 -- A horizontal text span is always >= 1 column and has a row height of 1.
73 HorizText
74 { attr :: !Attr
75 -- All character data is stored as Char sequences with the ISO-10646 encoding.
76 , text :: DisplayString
77 , output_width :: !Word -- >= 0
78 , char_width :: !Word -- >= 1
79 }
80 -- A horizontal join can be constructed between any two images. However a HorizJoin instance is
81 -- required to be between two images of equal height. The horiz_join constructor adds background
82 -- filles to the provided images that assure this is true for the HorizJoin value produced.
83 | HorizJoin
84 { part_left :: Image
85 , part_right :: Image
86 , output_width :: !Word -- >= 1
87 , output_height :: !Word -- >= 1
88 }
89 -- A veritical join can be constructed between any two images. However a VertJoin instance is
90 -- required to be between two images of equal width. The vert_join constructor adds background
91 -- fills to the provides images that assure this is true for the VertJoin value produced.
92 | VertJoin
93 { part_top :: Image
94 , part_bottom :: Image
95 , output_width :: !Word -- >= 1
96 , output_height :: !Word -- >= 1
97 }
98 -- A background fill will be filled with the background pattern. The background pattern is
99 -- defined as a property of the Picture this Image is used to form.
100 | BGFill
101 { output_width :: !Word -- >= 1
102 , output_height :: !Word -- >= 1
103 }
104 -- The combining operators identity constant.
105 -- EmptyImage <|> a = a
106 -- EmptyImage <-> a = a
107 --
108 -- Any image of zero size equals the empty image.
109 | EmptyImage
110 | Translation (Int, Int) Image
111 -- Crop an image to a size
112 | ImageCrop (Word, Word) Image
113 -- Pad an image up to a size
114 | ImagePad (Word, Word) Image
115 deriving Eq
117instance Show Image where
118 show ( HorizText { output_width = ow, text = txt } )
119 = "HorizText [" ++ show ow ++ "] (" ++ show (fmap fst txt) ++ ")"
120 show ( BGFill { output_width = c, output_height = r } )
121 = "BGFill (" ++ show c ++ "," ++ show r ++ ")"
122 show ( HorizJoin { part_left = l, part_right = r, output_width = c } )
123 = "HorizJoin " ++ show c ++ " ( " ++ show l ++ " <|> " ++ show r ++ " )"
124 show ( VertJoin { part_top = t, part_bottom = b, output_width = c, output_height = r } )
125 = "VertJoin (" ++ show c ++ ", " ++ show r ++ ") ( " ++ show t ++ " ) <-> ( " ++ show b ++ " )"
126 show ( Translation offset i )
127 = "Translation " ++ show offset ++ " ( " ++ show i ++ " )"
128 show ( ImageCrop size i )
129 = "ImageCrop " ++ show size ++ " ( " ++ show i ++ " )"
130 show ( ImagePad size i )
131 = "ImagePad " ++ show size ++ " ( " ++ show i ++ " )"
132 show ( EmptyImage ) = "EmptyImage"
134-- | Currently append in the Monoid instance is equivalent to <->.
135instance Monoid Image where
136 mempty = empty_image
137 mappend = (<->)
139-- A horizontal text image of 0 characters in width simplifies to the EmptyImage
140horiz_text :: Attr -> DisplayString -> Word -> Image
141horiz_text a txt ow
142 | ow == 0 = EmptyImage
143 | otherwise = HorizText a txt ow (toEnum $ Seq.length txt)
145horiz_join :: Image -> Image -> Word -> Word -> Image
146horiz_join i_0 i_1 w h
147 -- A horiz join of two 0 width images simplifies to the EmptyImage
148 | w == 0 = EmptyImage
149 -- A horizontal join where either part is 0 columns in width simplifies to the other part.
150 -- This covers the case where one part is the EmptyImage.
151 | image_width i_0 == 0 = i_1
152 | image_width i_1 == 0 = i_0
153 -- If the images are of the same height then no BG padding is required
154 | image_height i_0 == image_height i_1 = HorizJoin i_0 i_1 w h
155 -- otherwise one of the imagess needs to be padded to the right size.
156 | image_height i_0 < image_height i_1 -- Pad i_0
157 = let pad_amount = image_height i_1 - image_height i_0
158 in horiz_join ( vert_join i_0
159 ( BGFill ( image_width i_0 ) pad_amount )
160 ( image_width i_0 )
161 ( image_height i_1 )
162 )
163 i_1
164 w h
165 | image_height i_0 > image_height i_1 -- Pad i_1
166 = let pad_amount = image_height i_0 - image_height i_1
167 in horiz_join i_0
168 ( vert_join i_1
169 ( BGFill ( image_width i_1 ) pad_amount )
170 ( image_width i_1 )
171 ( image_height i_0 )
172 )
173 w h
174horiz_join _ _ _ _ = error "horiz_join applied to undefined values."
176vert_join :: Image -> Image -> Word -> Word -> Image
177vert_join i_0 i_1 w h
178 -- A vertical join of two 0 height images simplifies to the EmptyImage
179 | h == 0 = EmptyImage
180 -- A vertical join where either part is 0 rows in height simplifies to the other part.
181 -- This covers the case where one part is the EmptyImage
182 | image_height i_0 == 0 = i_1
183 | image_height i_1 == 0 = i_0
184 -- If the images are of the same height then no background padding is required
185 | image_width i_0 == image_width i_1 = VertJoin i_0 i_1 w h
186 -- Otherwise one of the images needs to be padded to the size of the other image.
187 | image_width i_0 < image_width i_1
188 = let pad_amount = image_width i_1 - image_width i_0
189 in vert_join ( horiz_join i_0
190 ( BGFill pad_amount ( image_height i_0 ) )
191 ( image_width i_1 )
192 ( image_height i_0 )
193 )
194 i_1
195 w h
196 | image_width i_0 > image_width i_1
197 = let pad_amount = image_width i_0 - image_width i_1
198 in vert_join i_0
199 ( horiz_join i_1
200 ( BGFill pad_amount ( image_height i_1 ) )
201 ( image_width i_0 )
202 ( image_height i_1 )
203 )
204 w h
205vert_join _ _ _ _ = error "vert_join applied to undefined values."
207-- | An area of the picture's bacground (See Background) of w columns and h rows.
208background_fill :: Word -> Word -> Image
209background_fill w h
210 | w == 0 = EmptyImage
211 | h == 0 = EmptyImage
212 | otherwise = BGFill w h
214-- | The width of an Image. This is the number display columns the image will occupy.
215image_width :: Image -> Word
216image_width HorizText { output_width = w } = w
217image_width HorizJoin { output_width = w } = w
218image_width VertJoin { output_width = w } = w
219image_width BGFill { output_width = w } = w
220image_width EmptyImage = 0
221image_width ( Translation v i ) = toEnum $ max 0 $ (fst v +) $ fromEnum $ image_width i
222image_width ( ImageCrop v i ) = min (image_width i) $ fst v
223image_width ( ImagePad v i ) = max (image_width i) $ fst v
225-- | The height of an Image. This is the number of display rows the image will occupy.
226image_height :: Image -> Word
227image_height HorizText {} = 1
228image_height HorizJoin { output_height = r } = r
229image_height VertJoin { output_height = r } = r
230image_height BGFill { output_height = r } = r
231image_height EmptyImage = 0
232image_height ( Translation v i ) = toEnum $ max 0 $ (snd v +) $ fromEnum $ image_height i
233image_height ( ImageCrop v i ) = min (image_height i) $ snd v
234image_height ( ImagePad v i ) = max (image_height i) $ snd v
236-- | Combines two images side by side.
237--
238-- The result image will have a width equal to the sum of the two images width. And the height will
239-- equal the largest height of the two images. The area not defined in one image due to a height
240-- missmatch will be filled with the background pattern.
241(<|>) :: Image -> Image -> Image
243-- Two horizontal text spans with the same attributes can be merged.
244h0@(HorizText attr_0 text_0 ow_0 _) <|> h1@(HorizText attr_1 text_1 ow_1 _)
245 | attr_0 == attr_1 = horiz_text attr_0 (text_0 Seq.>< text_1) (ow_0 + ow_1)
246 | otherwise = horiz_join h0 h1 (ow_0 + ow_1) 1
248-- Anything placed to the right of a join wil be joined to the right sub image.
249-- The total columns for the join is the sum of the two arguments columns
250h0@( HorizJoin {} ) <|> h1
251 = horiz_join ( part_left h0 )
252 ( part_right h0 <|> h1 )
253 ( image_width h0 + image_width h1 )
254 ( max (image_height h0) (image_height h1) )
256-- Anything but a join placed to the left of a join wil be joined to the left sub image.
257-- The total columns for the join is the sum of the two arguments columns
258h0 <|> h1@( HorizJoin {} )
259 = horiz_join ( h0 <|> part_left h1 )
260 ( part_right h1 )
261 ( image_width h0 + image_width h1 )
262 ( max (image_height h0) (image_height h1) )
264h0 <|> h1
265 = horiz_join h0
266 h1
267 ( image_width h0 + image_width h1 )
268 ( max (image_height h0) (image_height h1) )
270-- | Combines two images vertically.
271-- The result image will have a height equal to the sum of the heights of both images.
272-- The width will equal the largest width of the two images.
273-- The area not defined in one image due to a width missmatch will be filled with the background
274-- pattern.
275(<->) :: Image -> Image -> Image
276im_t <-> im_b
277 = vert_join im_t
278 im_b
279 ( max (image_width im_t) (image_width im_b) )
280 ( image_height im_t + image_height im_b )
282-- | Compose any number of images horizontally.
283horiz_cat :: [Image] -> Image
284horiz_cat = foldr (<|>) EmptyImage
286-- | Compose any number of images vertically.
287vert_cat :: [Image] -> Image
288vert_cat = foldr (<->) EmptyImage
290-- | an image of a single character. This is a standard Haskell 31-bit character assumed to be in
291-- the ISO-10646 encoding.
292char :: Attr -> Char -> Image
293char !a !c =
294 let display_width = safe_wcwidth c
295 in HorizText a (Seq.singleton (c, display_width)) display_width 1
297-- | A string of characters layed out on a single row with the same display attribute. The string is
298-- assumed to be a sequence of ISO-10646 characters.
299--
300-- Note: depending on how the Haskell compiler represents string literals a string literal in a
301-- UTF-8 encoded source file, for example, may be represented as a ISO-10646 string.
302-- That is, I think, the case with GHC 6.10. This means, for the most part, you don't need to worry
303-- about the encoding format when outputting string literals. Just provide the string literal
304-- directly to iso_10646_string or string.
305--
306iso_10646_string :: Attr -> String -> Image
307iso_10646_string !a !str =
308 let display_text = Seq.fromList $ map (\c -> (c, safe_wcwidth c)) str
309 in horiz_text a display_text (safe_wcswidth str)
311-- | Alias for iso_10646_string. Since the usual case is that a literal string like "foo" is
312-- represented internally as a list of ISO 10646 31 bit characters.
313--
314-- Note: Keep in mind that GHC will compile source encoded as UTF-8 but the literal strings, while
315-- UTF-8 encoded in the source, will be transcoded to a ISO 10646 31 bit characters runtime
316-- representation.
317string :: Attr -> String -> Image
318string = iso_10646_string
320-- | A string of characters layed out on a single row. The string is assumed to be a sequence of
321-- UTF-8 characters.
322utf8_string :: Attr -> [Word8] -> Image
323utf8_string !a !str = string a ( decode str )
325-- XXX: Characters with unknown widths occupy 1 column?
326--
327-- Not sure if this is actually correct. I presume there is a replacement character that is output
328-- by the terminal instead of the character and this replacement character is 1 column wide. If this
329-- is not true for all terminals then a per-terminal replacement character width needs to be
330-- implemented.
332-- | Returns the display width of a character. Assumes all characters with unknown widths are 1 width
333safe_wcwidth :: Char -> Word
334safe_wcwidth c = case wcwidth c of
335 i | i < 0 -> 1
336 | otherwise -> toEnum i
338-- | Returns the display width of a string. Assumes all characters with unknown widths are 1 width
339safe_wcswidth :: String -> Word
340safe_wcswidth str = case wcswidth str of
341 i | i < 0 -> 1
342 | otherwise -> toEnum i
344-- | Renders a UTF-8 encoded bytestring.
345utf8_bytestring :: Attr -> BS.ByteString -> Image
346utf8_bytestring !a !bs = string a (UTF8.toString $ UTF8.fromRep bs)
348-- | creates a fill of the specified character. The dimensions are in number of characters wide and
349-- number of rows high.
350--
351-- Unlike the Background fill character this character can have double column display width.
352char_fill :: Enum d => Attr -> Char -> d -> d -> Image
353char_fill !a !c w h =
354 vert_cat $ replicate (fromEnum h) $ horiz_cat $ replicate (fromEnum w) $ char a c
356-- | The empty image. Useful for fold combinators. These occupy no space nor define any display
357-- attributes.
358empty_image :: Image
359empty_image = EmptyImage
361-- | Apply the given offset to the image.
362translate :: (Int, Int) -> Image -> Image
363translate v i = Translation v i
365-- | Ensure an image is no larger than the provided size. If the image is larger then crop.
366crop :: (Word, Word) -> Image -> Image
367crop (0,_) _ = EmptyImage
368crop (_,0) _ = EmptyImage
369crop v (ImageCrop _size i) = ImagePad (min (fst v) (fst _size), min (snd v) (snd _size)) i
370crop v (ImagePad _size i) = ImagePad (min (fst v) (fst _size), min (snd v) (snd _size)) i
371crop v i = ImagePad v i
373-- | Ensure an image is at least the provided size. If the image is smaler then pad.
374pad :: (Word, Word) -> Image -> Image
375pad (0,_) _ = EmptyImage
376pad (_,0) _ = EmptyImage
377pad v (ImagePad _size i) = ImagePad (max (fst v) (fst _size), max (snd v) (snd _size)) i
378pad v i = ImagePad v i