git.iko.soy/vty
on 5edacaa help sign in
vty/src/Graphics/Vty/Image.hs
322 lines 13 kB history raw
1-- Copyright 2009 Corey O'Connor
2{-# LANGUAGE BangPatterns #-}
3{-# LANGUAGE NamedFieldPuns #-}
4{-# LANGUAGE DisambiguateRecordFields #-}
5{-# OPTIONS_GHC -funbox-strict-fields #-}
6module Graphics.Vty.Image ( Image(..)
7 , image_width
8 , image_height
9 , (<|>)
10 , (<->)
11 , horiz_cat
12 , vert_cat
13 , horzcat
14 , vertcat
15 , background_fill
16 , char
17 , string
18 , iso_10646_string
19 , utf8_string
20 , utf8_bytestring
21 , char_fill
22 , empty_image
23 -- | The possible display attributes used in constructing an `Image`.
24 , module Graphics.Vty.Attributes
25 )
26 where
28import Graphics.Vty.Attributes
30import Codec.Binary.UTF8.Width
32import Codec.Binary.UTF8.String ( decode )
34import qualified Data.ByteString as BS
35import qualified Data.Sequence as Seq
36import qualified Data.String.UTF8 as UTF8
37import Data.Word
39infixr 5 <|>
40infixr 4 <->
42type StringSeq = Seq.Seq Char
44-- | An image in VTY defines:
45--
46-- * properties required to display the image. These are properties that effect the output image
47-- but are independent of position
48--
49-- * A set of position-dependent text and attribute regions. The possible regions are:
50--
51-- * a point. ( char )
52--
53-- * a horizontal line of characters with a single attribute. (string, utf8_string,
54-- utf8_bytestring )
55--
56-- * a fill of a single character. (char_fill)
57--
58-- * a fill of the picture's background. (background_fill)
59--
60-- todo: increase the number of encoded bytestring formats supported.
61data Image =
62 -- A horizontal text span is always >= 1 column and has a row height of 1.
63 HorizText
64 { attr :: !Attr
65 -- All character data is stored as Char sequences with the ISO-10646 encoding.
66 , text :: StringSeq
67 -- in columns
68 , output_width :: !Word -- >= 0
69 , char_width :: !Word -- >= 1
70 }
71 -- A horizontal join can be constructed between any two images. However a HorizJoin instance is
72 -- required to be between two images of equal height. The horiz_join constructor adds blanks to
73 -- the provided images that assure this is true for the HorizJoin value produced.
74 | HorizJoin
75 { part_left :: Image
76 , part_right :: Image
77 , output_width :: !Word -- >= 1
78 , output_height :: !Word -- >= 1
79 }
80 -- A veritical join can be constructed between any two images. However a VertJoin instance is
81 -- required to be between two images of equal width. The horiz_join constructor adds blanks to
82 -- the provides images that assure this is true for the HorizJoin value produced.
83 | VertJoin
84 { part_top :: Image
85 , part_bottom :: Image
86 , output_width :: !Word -- >= 1
87 , output_height :: !Word -- >= 1
88 }
89 -- A background fill will be filled with the background pattern. The background pattern is
90 -- defined as a property of the Picture this Image is used to form.
91 | BGFill
92 { output_width :: !Word -- >= 1
93 , output_height :: !Word -- >= 1
94 }
95 -- The combining operators identity constant.
96 -- IdImage <|> a = a
97 -- IdImage <-> a = a
98 --
99 -- Any image of zero size equals the identity image.
100 | IdImage
101 deriving Eq
103instance Show Image where
104 show ( HorizText { output_width = ow, text = txt } )
105 = "HorizText [" ++ show ow ++ "] (" ++ show txt ++ ")"
106 show ( BGFill { output_width = c, output_height = r } )
107 = "BGFill (" ++ show c ++ "," ++ show r ++ ")"
108 show ( HorizJoin { part_left = l, part_right = r, output_width = c } )
109 = "HorizJoin " ++ show c ++ " ( " ++ show l ++ " <|> " ++ show r ++ " )"
110 show ( VertJoin { part_top = t, part_bottom = b, output_width = c, output_height = r } )
111 = "VertJoin (" ++ show c ++ ", " ++ show r ++ ") ( " ++ show t ++ " ) <-> ( " ++ show b ++ " )"
112 show ( IdImage ) = "IdImage"
114-- A horizontal text image of 0 characters in width simplifies to the IdImage
115horiz_text :: Attr -> StringSeq -> Word -> Image
116horiz_text a txt ow
117 | ow == 0 = IdImage
118 | otherwise = HorizText a txt (toEnum $ Seq.length txt) ow
120horiz_join :: Image -> Image -> Word -> Word -> Image
121horiz_join i_0 i_1 w h
122 -- A horiz join of two 0 width images simplifies to the IdImage
123 | w == 0 = IdImage
124 -- A horizontal join where either part is 0 columns in width simplifies to the other part.
125 -- This covers the case where one part is the IdImage.
126 | image_width i_0 == 0 = i_1
127 | image_width i_1 == 0 = i_0
128 -- If the images are of the same height then no BG padding is required
129 | image_height i_0 == image_height i_1 = HorizJoin i_0 i_1 w h
130 -- otherwise one of the imagess needs to be padded to the right size.
131 | image_height i_0 < image_height i_1 -- Pad i_0
132 = let pad_amount = image_height i_1 - image_height i_0
133 in horiz_join ( vert_join i_0
134 ( BGFill ( image_width i_0 ) pad_amount )
135 ( image_width i_0 )
136 ( image_height i_1 )
137 )
138 i_1
139 w h
140 | image_height i_0 > image_height i_1 -- Pad i_1
141 = let pad_amount = image_height i_0 - image_height i_1
142 in horiz_join i_0
143 ( vert_join i_1
144 ( BGFill ( image_width i_1 ) pad_amount )
145 ( image_width i_1 )
146 ( image_height i_0 )
147 )
148 w h
149horiz_join _ _ _ _ = error "horiz_join applied to undefined values."
151vert_join :: Image -> Image -> Word -> Word -> Image
152vert_join i_0 i_1 w h
153 -- A vertical join of two 0 height images simplifies to the IdImage
154 | h == 0 = IdImage
155 -- A vertical join where either part is 0 rows in height simplifies to the other part.
156 -- This covers the case where one part is the IdImage
157 | image_height i_0 == 0 = i_1
158 | image_height i_1 == 0 = i_0
159 -- If the images are of the same height then no background padding is required
160 | image_width i_0 == image_width i_1 = VertJoin i_0 i_1 w h
161 -- Otherwise one of the images needs to be padded to the size of the other image.
162 | image_width i_0 < image_width i_1
163 = let pad_amount = image_width i_1 - image_width i_0
164 in vert_join ( horiz_join i_0
165 ( BGFill pad_amount ( image_height i_0 ) )
166 ( image_width i_1 )
167 ( image_height i_0 )
168 )
169 i_1
170 w h
171 | image_width i_0 > image_width i_1
172 = let pad_amount = image_width i_0 - image_width i_1
173 in vert_join i_0
174 ( horiz_join i_1
175 ( BGFill pad_amount ( image_height i_1 ) )
176 ( image_width i_0 )
177 ( image_height i_1 )
178 )
179 w h
180vert_join _ _ _ _ = error "vert_join applied to undefined values."
182-- | An area of the picture's bacground (See Background) of w columns and h rows.
183background_fill :: Word -> Word -> Image
184background_fill w h
185 | w == 0 = IdImage
186 | h == 0 = IdImage
187 | otherwise = BGFill w h
189-- | The width of an Image. This is the number display columns the image will occupy.
190image_width :: Image -> Word
191image_width HorizText { output_width = w } = w
192image_width HorizJoin { output_width = w } = w
193image_width VertJoin { output_width = w } = w
194image_width BGFill { output_width = w } = w
195image_width IdImage = 0
197-- | The height of an Image. This is the number of display rows the image will occupy.
198image_height :: Image -> Word
199image_height HorizText {} = 1
200image_height HorizJoin { output_height = r } = r
201image_height VertJoin { output_height = r } = r
202image_height BGFill { output_height = r } = r
203image_height IdImage = 0
205-- | Combines two images side by side.
206--
207-- The result image will have a width equal to the sum of the two images width. And the height will
208-- equal the largest height of the two images. The area not defined in one image due to a height
209-- missmatch will be filled with the background pattern.
210(<|>) :: Image -> Image -> Image
212-- Two horizontal text spans with the same attributes can be merged.
213h0@(HorizText attr_0 text_0 ow_0 _) <|> h1@(HorizText attr_1 text_1 ow_1 _)
214 | attr_0 == attr_1 = horiz_text attr_0 (text_0 Seq.>< text_1) (ow_0 + ow_1)
215 | otherwise = horiz_join h0 h1 (ow_0 + ow_1) 1
217-- Anything placed to the right of a join wil be joined to the right sub image.
218-- The total columns for the join is the sum of the two arguments columns
219h0@( HorizJoin {} ) <|> h1
220 = horiz_join ( part_left h0 )
221 ( part_right h0 <|> h1 )
222 ( image_width h0 + image_width h1 )
223 ( max (image_height h0) (image_height h1) )
225-- Anything but a join placed to the left of a join wil be joined to the left sub image.
226-- The total columns for the join is the sum of the two arguments columns
227h0 <|> h1@( HorizJoin {} )
228 = horiz_join ( h0 <|> part_left h1 )
229 ( part_right h1 )
230 ( image_width h0 + image_width h1 )
231 ( max (image_height h0) (image_height h1) )
233h0 <|> h1
234 = horiz_join h0
235 h1
236 ( image_width h0 + image_width h1 )
237 ( max (image_height h0) (image_height h1) )
239-- | Combines two images vertically.
240-- The result image will have a height equal to the sum of the heights of both images.
241-- The width will equal the largest width of the two images.
242-- The area not defined in one image due to a width missmatch will be filled with the background
243-- pattern.
244(<->) :: Image -> Image -> Image
245im_t <-> im_b
246 = vert_join im_t
247 im_b
248 ( max (image_width im_t) (image_width im_b) )
249 ( image_height im_t + image_height im_b )
251-- | Compose any number of images horizontally.
252horiz_cat :: [Image] -> Image
253horiz_cat = foldr (<|>) IdImage
255horzcat :: [Image] -> Image
256horzcat = horiz_cat
258-- | Compose any number of images vertically.
259vert_cat :: [Image] -> Image
260vert_cat = foldr (<->) IdImage
262vertcat :: [Image] -> Image
263vertcat = vert_cat
265-- | an image of a single character. This is a standard Haskell 31-bit character assumed to be in
266-- the ISO-10646 encoding.
267char :: Attr -> Char -> Image
268char !a !c = HorizText a (Seq.singleton c) (safe_wcwidth c) 1
270-- | A string of characters layed out on a single row with the same display attribute. The string is
271-- assumed to be a sequence of ISO-10646 characters.
272--
273-- Note: depending on how the Haskell compiler represents string literals a string literal in a
274-- UTF-8 encoded source file, for example, may be represented as a ISO-10646 string.
275-- That is, I think, the case with GHC 6.10. This means, for the most part, you don't need to worry
276-- about the encoding format when outputting string literals. Just provide the string literal
277-- directly to iso_10646_string or string.
278--
279iso_10646_string :: Attr -> String -> Image
280iso_10646_string !a !str = horiz_text a (Seq.fromList str) (safe_wcswidth str)
282-- | Alias for iso_10646_string. Since the usual case is that a literal string like "foo" is
283-- represented internally as a list of ISO 10646 31 bit characters.
284--
285-- Note: Keep in mind that GHC will compile source encoded as UTF-8 but the literal strings, while
286-- UTF-8 encoded in the source, will be transcoded to a ISO 10646 31 bit characters runtime
287-- representation.
288string :: Attr -> String -> Image
289string = iso_10646_string
291-- | A string of characters layed out on a single row. The string is assumed to be a sequence of
292-- UTF-8 characters.
293utf8_string :: Attr -> [Word8] -> Image
294utf8_string !a !str = string a ( decode str )
296safe_wcwidth :: Char -> Word
297safe_wcwidth c = case wcwidth c of
298 i | i < 0 -> error "negative wcwidth"
299 | otherwise -> toEnum i
301safe_wcswidth :: String -> Word
302safe_wcswidth str = case wcswidth str of
303 i | i < 0 -> error "negative wcswidth"
304 | otherwise -> toEnum i
306-- | Renders a UTF-8 encoded bytestring.
307utf8_bytestring :: Attr -> BS.ByteString -> Image
308utf8_bytestring !a !bs = string a (UTF8.toString $ UTF8.fromRep bs)
310-- | creates a fill of the specified character. The dimensions are in number of characters wide and
311-- number of rows high.
312--
313-- Unlike the Background fill character this character can have double column display width.
314char_fill :: Enum d => Attr -> Char -> d -> d -> Image
315char_fill !a !c w h =
316 vert_cat $ replicate (fromEnum h) $ horiz_cat $ replicate (fromEnum w) $ char a c
318-- | The empty image. Useful for fold combinators. These occupy no space nor define any display
319-- attributes.
320empty_image :: Image
321empty_image = IdImage