1-- Copyright 2009-2010 Corey O'Connor 2{-# LANGUAGE NamedFieldPuns #-} 3{-# LANGUAGE DisambiguateRecordFields #-} 4-- | A Vty program makes 'Picture's from 'Image's. This module provides 5-- the core constructors for creating, combining, and modifying 6-- 'Image's. 7module Graphics.Vty.Image 8 ( 9 -- * Images 10 Image 11 , imageWidth 12 , imageHeight 13 -- * Image constructors 14 , emptyImage 15 , char 16 , string 17 , iso10646String 18 , utf8String 19 , text 20 , text' 21 , backgroundFill 22 , utf8Bytestring 23 , utf8Bytestring' 24 , charFill 25 -- * Combinators 26 , horizJoin 27 , (<|>) 28 , vertJoin 29 , (<->) 30 , horizCat 31 , vertCat 32 -- * Image modifications 33 , crop 34 , cropRight 35 , cropLeft 36 , cropBottom 37 , cropTop 38 , pad 39 , resize 40 , resizeWidth 41 , resizeHeight 42 , translate 43 , translateX 44 , translateY 45 -- * Character width functions 46 , safeWcwidth 47 , safeWcswidth 48 , safeWctwidth 49 , safeWctlwidth 50 , wcwidth 51 , wcswidth 52 , wctwidth 53 , wctlwidth 54 -- * Display Regions 55 , DisplayText 56 , DisplayRegion 57 , regionWidth 58 , regionHeight 59 ) 60where 61 62import Graphics.Vty.Attributes 63import Graphics.Vty.Image.Internal 64import Graphics.Text.Width 65 66import qualified Data.ByteString as B 67import qualified Data.ByteString.Lazy as BL 68import qualified Data.Text as T 69import qualified Data.Text.Encoding as T 70import qualified Data.Text.Lazy as TL 71import qualified Data.Text.Lazy.Encoding as TL 72import Data.Word 73 74-- | A region of the display (first width, then height) 75type DisplayRegion = (Int,Int) 76 77regionWidth :: DisplayRegion -> Int 78regionWidth = fst 79 80regionHeight :: DisplayRegion -> Int 81regionHeight = snd 82 83infixr 5 <|> 84infixr 4 <-> 85 86-- | An area of the picture's background (See 'Background'). 87backgroundFill :: Int 88 -- ^ Fill width in columns 89 -> Int 90 -- ^ Fill height in rows 91 -> Image 92backgroundFill w h 93 | w == 0 = EmptyImage 94 | h == 0 = EmptyImage 95 | otherwise = BGFill w h 96 97-- | Combines two images horizontally. This is an alias for 'horizJoin'. 98-- 99-- infixr 5 100(<|>) :: Image -> Image -> Image 101(<|>) = horizJoin 102 103-- | Combines two images vertically. This is an alias for 'vertJoin'. 104-- 105-- infixr 4 106(<->) :: Image -> Image -> Image 107(<->) = vertJoin 108 109-- | Compose any number of images together horizontally, with the first 110-- in the list being leftmost. 111horizCat :: [Image] -> Image 112horizCat = foldr horizJoin EmptyImage 113 114-- | Compose any number of images vertically, with the first in the list 115-- being topmost. 116vertCat :: [Image] -> Image 117vertCat = foldr vertJoin EmptyImage 118 119-- | Make an 'Image' from a lazy text value. The text value should be 120-- sanitized of escape sequences (ASCII 27) and carriage returns; 121-- otherwise layout and attribute problems may result. 122text :: Attr -> TL.Text -> Image 123text a txt = let displayWidth = safeWctlwidth txt 124 in HorizText a txt displayWidth (fromIntegral $! TL.length txt) 125 126-- | Make an 'Image' from a text value. The text value should be 127-- sanitized of escape sequences (ASCII 27) and carriage returns; 128-- otherwise layout and attribute problems may result. 129text' :: Attr -> T.Text -> Image 130text' a txt = let displayWidth = safeWctwidth txt 131 in HorizText a (TL.fromStrict txt) displayWidth (T.length txt) 132 133-- | Make an image from a single character. This is a standard Haskell 134-- 31-bit character assumed to be in the ISO-10646 encoding. 135char :: Attr -> Char -> Image 136char a c = 137 let displayWidth = safeWcwidth c 138 in HorizText a (TL.singleton c) displayWidth 1 139 140-- | Make an image from a string of characters layed out on a single 141-- row with the same display attribute. The string is assumed to be a 142-- sequence of ISO-10646 characters. The input string should be 143-- sanitized of escape sequences (ASCII 27) and carriage returns; 144-- otherwise layout and attribute problems may result. 145-- 146-- Note: depending on how the Haskell compiler represents string 147-- literals, a string literal in a UTF-8 encoded source file, for 148-- example, may be represented as a ISO-10646 string. That is, I think, 149-- the case with GHC 6.10. This means, for the most part, you don't need 150-- to worry about the encoding format when outputting string literals. 151-- Just provide the string literal directly to iso10646String or string. 152iso10646String :: Attr -> String -> Image 153iso10646String a str = 154 let displayWidth = safeWcswidth str 155 in HorizText a (TL.pack str) displayWidth (length str) 156 157-- | Make an 'Image' from a 'String'. 158-- 159-- This is an alias for iso10646String since the usual case is that a 160-- literal string like "foo" is represented internally as a list of ISO 161-- 10646 31 bit characters. 162-- 163-- Note: Keep in mind that GHC will compile source encoded as UTF-8 164-- but the literal strings, while UTF-8 encoded in the source, will be 165-- transcoded to a ISO 10646 31 bit characters runtime representation. 166string :: Attr -> String -> Image 167string = iso10646String 168 169-- | Make an 'Image' from a string of characters layed out on a single 170-- row. The input is assumed to be the bytes for UTF-8 encoded text. 171utf8String :: Attr -> [Word8] -> Image 172utf8String a bytes = utf8Bytestring a (BL.pack bytes) 173 174-- | Make an 'Image' from a UTF-8 encoded lazy bytestring. 175utf8Bytestring :: Attr -> BL.ByteString -> Image 176utf8Bytestring a bs = text a (TL.decodeUtf8 bs) 177 178-- | Make an 'Image' from a UTF-8 encoded strict bytestring. 179utf8Bytestring' :: Attr -> B.ByteString -> Image 180utf8Bytestring' a bs = text' a (T.decodeUtf8 bs) 181 182-- | Make an image filling a region with the specified character. 183-- 184-- If either the width or height are less than or equal to 0, then 185-- the result is the empty image. 186charFill :: Integral d 187 => Attr 188 -- ^ The attribute to use. 189 -> Char 190 -- ^ The character to use in filling the region. 191 -> d 192 -- ^ The region width. 193 -> d 194 -- ^ The region height. 195 -> Image 196charFill a c w h 197 | w <= 0 || h <= 0 = EmptyImage 198 | otherwise = vertCat 199 $ replicate (fromIntegral h) 200 $ HorizText a txt displayWidth charWidth 201 where 202 txt = TL.replicate charWidth (TL.singleton c) 203 displayWidth = safeWcwidth c * charWidth 204 205 charWidth :: Num a => a 206 charWidth = fromIntegral w 207 208-- | The empty image. Useful for fold combinators. These occupy no space 209-- and do not affect display attributes. 210emptyImage :: Image 211emptyImage = EmptyImage 212 213-- | Pad the given image. This adds background character fills to the 214-- left, top, right, bottom. 215pad :: Int 216 -- ^ How much padding to add to the left side of the image. 217 -> Int 218 -- ^ How much padding to add to the top of the image. 219 -> Int 220 -- ^ How much padding to add to the right side of the image. 221 -> Int 222 -- ^ How much padding to add to the bottom of the image. 223 -> Image 224 -- ^ The image to pad. 225 -> Image 226pad 0 0 0 0 i = i 227pad inL inT inR inB inImage 228 | inL < 0 || inT < 0 || inR < 0 || inB < 0 = error "cannot pad by negative amount" 229 | otherwise = go inL inT inR inB inImage 230 where 231 go 0 0 0 0 i = i 232 go 0 0 0 b i = VertJoin i (BGFill w b) w h 233 where w = imageWidth i 234 h = imageHeight i + b 235 go 0 0 r b i = go 0 0 0 b $ HorizJoin i (BGFill r h) w h 236 where w = imageWidth i + r 237 h = imageHeight i 238 go 0 t r b i = go 0 0 r b $ VertJoin (BGFill w t) i w h 239 where w = imageWidth i 240 h = imageHeight i + t 241 go l t r b i = go 0 t r b $ HorizJoin (BGFill l h) i w h 242 where w = imageWidth i + l 243 h = imageHeight i 244 245-- | Translates an image by padding or cropping the left and top. 246-- 247-- If translation offsets are negative then the image is cropped. 248translate :: Int 249 -- ^ The horizontal translation offset (can be negative) 250 -> Int 251 -- ^ The vertical translation offset (can be negative) 252 -> Image 253 -- ^ The image to translate. 254 -> Image 255translate x y i = translateX x (translateY y i) 256 257-- | Translates an image by padding or cropping its left side. 258translateX :: Int -> Image -> Image 259translateX x i 260 | x < 0 && (abs x > imageWidth i) = emptyImage 261 | x < 0 = let s = abs x in CropLeft i s (imageWidth i - s) (imageHeight i) 262 | x == 0 = i 263 | otherwise = let h = imageHeight i in HorizJoin (BGFill x h) i (imageWidth i + x) h 264 265-- | Translates an image by padding or cropping its top. 266translateY :: Int -> Image -> Image 267translateY y i 268 | y < 0 && (abs y > imageHeight i) = emptyImage 269 | y < 0 = let s = abs y in CropTop i s (imageWidth i) (imageHeight i - s) 270 | y == 0 = i 271 | otherwise = let w = imageWidth i in VertJoin (BGFill w y) i w (imageHeight i + y) 272 273-- | Ensure an image is no larger than the provided size. If the image 274-- is larger then crop the right or bottom. 275-- 276-- This is equivalent to a vertical crop from the bottom followed by 277-- horizontal crop from the right. 278crop :: Int 279 -- ^ Cropping width 280 -> Int 281 -- ^ Cropping height 282 -> Image 283 -- ^ The image to crop 284 -> Image 285crop 0 _ _ = EmptyImage 286crop _ 0 _ = EmptyImage 287crop w h i = cropBottom h (cropRight w i) 288 289-- | Crop an image's height. If the image's height is less than or equal 290-- to the specified height then this operation has no effect. Otherwise 291-- the image is cropped from the bottom. 292cropBottom :: Int -> Image -> Image 293cropBottom 0 _ = EmptyImage 294cropBottom h inI 295 | h < 0 = error "cannot crop height to less than zero" 296 | otherwise = go inI 297 where 298 go EmptyImage = EmptyImage 299 go i@(CropBottom {croppedImage, outputWidth, outputHeight}) 300 | outputHeight <= h = i 301 | otherwise = CropBottom croppedImage outputWidth h 302 go i 303 | h >= imageHeight i = i 304 | otherwise = CropBottom i (imageWidth i) h 305 306-- | Crop an image's width. If the image's width is less than or equal 307-- to the specified width then this operation has no effect. Otherwise 308-- the image is cropped from the right. 309cropRight :: Int -> Image -> Image 310cropRight 0 _ = EmptyImage 311cropRight w inI 312 | w < 0 = error "cannot crop width to less than zero" 313 | otherwise = go inI 314 where 315 go EmptyImage = EmptyImage 316 go i@(CropRight {croppedImage, outputWidth, outputHeight}) 317 | outputWidth <= w = i 318 | otherwise = CropRight croppedImage w outputHeight 319 go i 320 | w >= imageWidth i = i 321 | otherwise = CropRight i w (imageHeight i) 322 323-- | Crop an image's width. If the image's width is less than or equal 324-- to the specified width then this operation has no effect. Otherwise 325-- the image is cropped from the left. 326cropLeft :: Int -> Image -> Image 327cropLeft 0 _ = EmptyImage 328cropLeft w inI 329 | w < 0 = error "cannot crop the width to less than zero" 330 | otherwise = go inI 331 where 332 go EmptyImage = EmptyImage 333 go i@(CropLeft {croppedImage, leftSkip, outputWidth, outputHeight}) 334 | outputWidth <= w = i 335 | otherwise = 336 let leftSkip' = leftSkip + outputWidth - w 337 in CropLeft croppedImage leftSkip' w outputHeight 338 go i 339 | imageWidth i <= w = i 340 | otherwise = CropLeft i (imageWidth i - w) w (imageHeight i) 341 342-- | Crop an image's height. If the image's height is less than or equal 343-- to the specified height then this operation has no effect. Otherwise 344-- the image is cropped from the top. 345cropTop :: Int -> Image -> Image 346cropTop 0 _ = EmptyImage 347cropTop h inI 348 | h < 0 = error "cannot crop the height to less than zero" 349 | otherwise = go inI 350 where 351 go EmptyImage = EmptyImage 352 go i@(CropTop {croppedImage, topSkip, outputWidth, outputHeight}) 353 | outputHeight <= h = i 354 | otherwise = 355 let topSkip' = topSkip + outputHeight - h 356 in CropTop croppedImage topSkip' outputWidth h 357 go i 358 | imageHeight i <= h = i 359 | otherwise = CropTop i (imageHeight i - h) (imageWidth i) h 360 361-- | Generic resize. Pads and crops are added to ensure that the 362-- resulting image matches the specified dimensions. This is biased to 363-- pad/crop the right and bottom. 364resize :: Int -> Int -> Image -> Image 365resize w h i = resizeHeight h (resizeWidth w i) 366 367-- | Resize the width. Pads and crops as required to assure the given 368-- display width. This is biased to pad/crop on the right. 369resizeWidth :: Int -> Image -> Image 370resizeWidth w i = case w `compare` imageWidth i of 371 LT -> cropRight w i 372 EQ -> i 373 GT -> i <|> BGFill (w - imageWidth i) (imageHeight i) 374 375-- | Resize the height. Pads and crops as required to assure the given 376-- display height. This is biased to pad/crop on the bottom. 377resizeHeight :: Int -> Image -> Image 378resizeHeight h i = case h `compare` imageHeight i of 379 LT -> cropBottom h i 380 EQ -> i 381 GT -> i <-> BGFill (imageWidth i) (h - imageHeight i) 382