git.iko.soy/vty
on 175c235 help sign in
vty/src/Graphics/Vty/Image.hs
319 lines 11 kB history raw
1-- Copyright 2009-2010 Corey O'Connor
2{-# LANGUAGE BangPatterns #-}
3{-# LANGUAGE NamedFieldPuns #-}
4{-# LANGUAGE DisambiguateRecordFields #-}
5module Graphics.Vty.Image
6 ( DisplayText
7 , DisplayRegion
8 , regionWidth
9 , regionHeight
10 , Image
11 , imageWidth
12 , imageHeight
13 , horizJoin
14 , (<|>)
15 , vertJoin
16 , (<->)
17 , horizCat
18 , vertCat
19 , backgroundFill
20 , text
21 , text'
22 , char
23 , string
24 , iso10646String
25 , utf8String
26 , utf8Bytestring
27 , utf8Bytestring'
28 , charFill
29 , emptyImage
30 , safeWcwidth
31 , safeWcswidth
32 , wcwidth
33 , wcswidth
34 , crop
35 , cropRight
36 , cropLeft
37 , cropBottom
38 , cropTop
39 , pad
40 , resize
41 , resizeWidth
42 , resizeHeight
43 , translate
44 , translateX
45 , translateY
46 )
47where
49import Graphics.Vty.Attributes
50import Graphics.Vty.Image.Internal
51import Graphics.Text.Width
53import qualified Data.ByteString as B
54import qualified Data.ByteString.Lazy as BL
55import qualified Data.Text as T
56import qualified Data.Text.Encoding as T
57import qualified Data.Text.Lazy as TL
58import qualified Data.Text.Lazy.Encoding as TL
59import Data.Word
61-- | Named alias for a Int pair
62type DisplayRegion = (Int,Int)
64regionWidth :: DisplayRegion -> Int
65regionWidth = fst
67regionHeight :: DisplayRegion -> Int
68regionHeight = snd
70infixr 5 <|>
71infixr 4 <->
73-- | An area of the picture's bacground (See Background) of w columns
74-- and h rows.
75backgroundFill :: Int -> Int -> Image
76backgroundFill w h
77 | w == 0 = EmptyImage
78 | h == 0 = EmptyImage
79 | otherwise = BGFill w h
81-- | Combines two images horizontally. Alias for horizJoin
82--
83-- infixr 5
84(<|>) :: Image -> Image -> Image
85(<|>) = horizJoin
87-- | Combines two images vertically. Alias for vertJoin
88--
89-- infixr 4
90(<->) :: Image -> Image -> Image
91(<->) = vertJoin
93-- | Compose any number of images horizontally.
94horizCat :: [Image] -> Image
95horizCat = foldr horizJoin EmptyImage
97-- | Compose any number of images vertically.
98vertCat :: [Image] -> Image
99vertCat = foldr vertJoin EmptyImage
101-- | A Data.Text.Lazy value
102text :: Attr -> TL.Text -> Image
103text a txt = let displayWidth = safeWcswidth (TL.unpack txt)
104 in HorizText a txt displayWidth (fromIntegral $! TL.length txt)
106-- | A Data.Text value
107text' :: Attr -> T.Text -> Image
108text' a txt = let displayWidth = safeWcswidth (T.unpack txt)
109 in HorizText a (TL.fromStrict txt) displayWidth (T.length txt)
111-- | An image of a single character. This is a standard Haskell 31-bit
112-- character assumed to be in the ISO-10646 encoding.
113char :: Attr -> Char -> Image
114char a c =
115 let displayWidth = safeWcwidth c
116 in HorizText a (TL.singleton c) displayWidth 1
118-- | A string of characters layed out on a single row with the same
119-- display attribute. The string is assumed to be a sequence of
120-- ISO-10646 characters.
121--
122-- Note: depending on how the Haskell compiler represents string
123-- literals a string literal in a UTF-8 encoded source file, for
124-- example, may be represented as a ISO-10646 string. That is, I think,
125-- the case with GHC 6.10. This means, for the most part, you don't need
126-- to worry about the encoding format when outputting string literals.
127-- Just provide the string literal directly to iso10646String or string.
128iso10646String :: Attr -> String -> Image
129iso10646String a str =
130 let displayWidth = safeWcswidth str
131 in HorizText a (TL.pack str) displayWidth (length str)
133-- | Alias for iso10646String. Since the usual case is that a literal
134-- string like "foo" is represented internally as a list of ISO 10646 31
135-- bit characters.
136--
137-- Note: Keep in mind that GHC will compile source encoded as UTF-8
138-- but the literal strings, while UTF-8 encoded in the source, will be
139-- transcoded to a ISO 10646 31 bit characters runtime representation.
140string :: Attr -> String -> Image
141string = iso10646String
143-- | A string of characters layed out on a single row. The input is
144-- assumed to be the bytes for UTF-8 encoded text.
145utf8String :: Attr -> [Word8] -> Image
146utf8String a bytes = utf8Bytestring a (BL.pack bytes)
148-- | Renders a UTF-8 encoded lazy bytestring.
149utf8Bytestring :: Attr -> BL.ByteString -> Image
150utf8Bytestring a bs = text a (TL.decodeUtf8 bs)
152-- | Renders a UTF-8 encoded strict bytestring.
153utf8Bytestring' :: Attr -> B.ByteString -> Image
154utf8Bytestring' a bs = text' a (T.decodeUtf8 bs)
156-- | Creates a fill of the specified character. The dimensions are in
157-- number of characters wide and number of rows high.
158charFill :: Integral d => Attr -> Char -> d -> d -> Image
159charFill _a _c 0 _h = EmptyImage
160charFill _a _c _w 0 = EmptyImage
161charFill a c w h =
162 vertCat $ replicate (fromIntegral h) $ HorizText a txt displayWidth charWidth
163 where
164 txt = TL.replicate (fromIntegral w) (TL.singleton c)
165 displayWidth = safeWcwidth c * (fromIntegral w)
166 charWidth = fromIntegral w
168-- | The empty image. Useful for fold combinators. These occupy no space
169-- nor define any display attributes.
170emptyImage :: Image
171emptyImage = EmptyImage
173-- | Pad the given image. This adds background character fills to the
174-- left, top, right, bottom. The pad values are how many display columns
175-- or rows to add.
176pad :: Int -> Int -> Int -> Int -> Image -> Image
177pad 0 0 0 0 i = i
178pad inL inT inR inB inImage
179 | inL < 0 || inT < 0 || inR < 0 || inB < 0 = error "cannot pad by negative amount"
180 | otherwise = go inL inT inR inB inImage
181 where
182 go 0 0 0 0 i = i
183 go 0 0 0 b i = VertJoin i (BGFill w b) w h
184 where w = imageWidth i
185 h = imageHeight i + b
186 go 0 0 r b i = go 0 0 0 b $ HorizJoin i (BGFill r h) w h
187 where w = imageWidth i + r
188 h = imageHeight i
189 go 0 t r b i = go 0 0 r b $ VertJoin (BGFill w t) i w h
190 where w = imageWidth i
191 h = imageHeight i + t
192 go l t r b i = go 0 t r b $ HorizJoin (BGFill l h) i w h
193 where w = imageWidth i + l
194 h = imageHeight i
196-- | Translates an image by padding or cropping the left and top.
197-- First param is amount to translate left. Second param is amount to
198-- translate top.
199--
200-- This can have an unexpected effect: Translating an image to less than
201-- (0,0) then to greater than (0,0) will crop the image.
202translate :: Int -> Int -> Image -> Image
203translate x y i = translateX x (translateY y i)
205-- | translates an image by padding or cropping the left
206translateX :: Int -> Image -> Image
207translateX x i
208 | x < 0 = let s = abs x in CropLeft i s (imageWidth i - s) (imageHeight i)
209 | x == 0 = i
210 | otherwise = let h = imageHeight i in HorizJoin (BGFill x h) i (imageWidth i + x) h
212-- | translates an image by padding or cropping the top
213translateY :: Int -> Image -> Image
214translateY y i
215 | y < 0 = let s = abs y in CropTop i s (imageWidth i) (imageHeight i - s)
216 | y == 0 = i
217 | otherwise = let w = imageWidth i in VertJoin (BGFill w y) i w (imageHeight i + y)
219-- | Ensure an image is no larger than the provided size. If the image
220-- is larger then crop the right or bottom.
221--
222-- This is transformed to a vertical crop from the bottom followed by
223-- horizontal crop from the right.
224crop :: Int -> Int -> Image -> Image
225crop 0 _ _ = EmptyImage
226crop _ 0 _ = EmptyImage
227crop w h i = cropBottom h (cropRight w i)
229-- | crop the display height. If the image is less than or equal in
230-- height then this operation has no effect. Otherwise the image is
231-- cropped from the bottom.
232cropBottom :: Int -> Image -> Image
233cropBottom 0 _ = EmptyImage
234cropBottom h inI
235 | h < 0 = error "cannot crop height to less than zero"
236 | otherwise = go inI
237 where
238 go EmptyImage = EmptyImage
239 go i@(CropBottom {croppedImage, outputWidth, outputHeight})
240 | outputHeight <= h = i
241 | otherwise = CropBottom croppedImage outputWidth h
242 go i
243 | h >= imageHeight i = i
244 | otherwise = CropBottom i (imageWidth i) h
246-- | ensure the image is no wider than the given width. If the image is
247-- wider then crop the right side.
248cropRight :: Int -> Image -> Image
249cropRight 0 _ = EmptyImage
250cropRight w inI
251 | w < 0 = error "cannot crop width to less than zero"
252 | otherwise = go inI
253 where
254 go EmptyImage = EmptyImage
255 go i@(CropRight {croppedImage, outputWidth, outputHeight})
256 | outputWidth <= w = i
257 | otherwise = CropRight croppedImage w outputHeight
258 go i
259 | w >= imageWidth i = i
260 | otherwise = CropRight i w (imageHeight i)
262-- | ensure the image is no wider than the given width. If the image is
263-- wider then crop the left side.
264cropLeft :: Int -> Image -> Image
265cropLeft 0 _ = EmptyImage
266cropLeft w inI
267 | w < 0 = error "cannot crop the width to less than zero"
268 | otherwise = go inI
269 where
270 go EmptyImage = EmptyImage
271 go i@(CropLeft {croppedImage, leftSkip, outputWidth, outputHeight})
272 | outputWidth <= w = i
273 | otherwise =
274 let leftSkip' = leftSkip + outputWidth - w
275 in CropLeft croppedImage leftSkip' w outputHeight
276 go i
277 | imageWidth i <= w = i
278 | otherwise = CropLeft i (imageWidth i - w) w (imageHeight i)
280-- | crop the display height. If the image is less than or equal in
281-- height then this operation has no effect. Otherwise the image is
282-- cropped from the top.
283cropTop :: Int -> Image -> Image
284cropTop 0 _ = EmptyImage
285cropTop h inI
286 | h < 0 = error "cannot crop the height to less than zero"
287 | otherwise = go inI
288 where
289 go EmptyImage = EmptyImage
290 go i@(CropTop {croppedImage, topSkip, outputWidth, outputHeight})
291 | outputHeight <= h = i
292 | otherwise =
293 let topSkip' = topSkip + outputHeight - h
294 in CropTop croppedImage topSkip' outputWidth h
295 go i
296 | imageHeight i <= h = i
297 | otherwise = CropTop i (imageHeight i - h) (imageWidth i) h
299-- | Generic resize. Pads and crops as required to assure the given
300-- display width and height. This is biased to pad/crop the right and
301-- bottom.
302resize :: Int -> Int -> Image -> Image
303resize w h i = resizeHeight h (resizeWidth w i)
305-- | Resize the width. Pads and crops as required to assure the given
306-- display width. This is biased to pad/crop the right.
307resizeWidth :: Int -> Image -> Image
308resizeWidth w i = case w `compare` imageWidth i of
309 LT -> cropRight w i
310 EQ -> i
311 GT -> i <|> BGFill (w - imageWidth i) (imageHeight i)
313-- | Resize the height. Pads and crops as required to assure the given
314-- display height. This is biased to pad/crop the bottom.
315resizeHeight :: Int -> Image -> Image
316resizeHeight h i = case h `compare` imageHeight i of
317 LT -> cropBottom h i
318 EQ -> i
319 GT -> i <-> BGFill (imageWidth i) (h - imageHeight i)