1{-# LANGUAGE CPP #-} 2{-# LANGUAGE NamedFieldPuns #-} 3{-# LANGUAGE DeriveGeneric #-} 4{-# OPTIONS_HADDOCK hide #-} 5 6module Graphics.Vty.Image.Internal where 7 8import Graphics.Vty.Attributes 9import Graphics.Text.Width 10 11import GHC.Generics 12 13import Control.DeepSeq 14 15#if !(MIN_VERSION_base(4,11,0)) 16import Data.Semigroup (Semigroup(..)) 17#endif 18import qualified Data.Text.Lazy as TL 19 20-- | A display text is a Data.Text.Lazy 21type DisplayText = TL.Text 22 23clipText :: DisplayText -> Int -> Int -> DisplayText 24clipText txt leftSkip rightClip = 25 -- CPS would clarify this I think 26 let (toDrop,padPrefix) = clipForCharWidth leftSkip txt 0 27 txt' = if padPrefix then TL.cons '…' (TL.drop (toDrop+1) txt) else TL.drop toDrop txt 28 (toTake,padSuffix) = clipForCharWidth rightClip txt' 0 29 txt'' = TL.append (TL.take toTake txt') (if padSuffix then TL.singleton '…' else TL.empty) 30 -- Note: some characters and zero-width and combining characters 31 -- combine to the left, so keep taking characters even if the 32 -- width is zero. 33 clipForCharWidth w t n 34 | TL.null t = (n, False) 35 | w < cw = (n, w /= 0) 36 | otherwise = clipForCharWidth (w - cw) (TL.tail t) (n + 1) 37 where cw = safeWcwidth (TL.head t) 38 in txt'' 39 40-- | This is the internal representation of Images. Use the constructors 41-- in "Graphics.Vty.Image" to create instances. 42-- 43-- Images are: 44-- 45-- * a horizontal span of text 46-- 47-- * a horizontal or vertical join of two images 48-- 49-- * a two dimensional fill of the 'Picture's background character 50-- 51-- * a cropped image 52-- 53-- * an empty image of no size or content. 54data Image = 55 -- | A horizontal text span has a row height of 1. 56 HorizText 57 { attr :: Attr 58 -- | The text to display. The display width of the text is always 59 -- outputWidth. 60 , displayText :: DisplayText 61 -- | The number of display columns for the text. 62 , outputWidth :: Int 63 -- | the number of characters in the text. 64 , charWidth :: Int 65 } 66 -- | A horizontal join can be constructed between any two images. 67 -- However a HorizJoin instance is required to be between two images 68 -- of equal height. The horizJoin constructor adds background fills 69 -- to the provided images that assure this is true for the HorizJoin 70 -- value produced. 71 | HorizJoin 72 { partLeft :: Image 73 , partRight :: Image 74 , outputWidth :: Int 75 -- ^ imageWidth partLeft == imageWidth partRight. Always > 0 76 , outputHeight :: Int 77 -- ^ imageHeight partLeft == imageHeight partRight. Always > 0 78 } 79 -- | A veritical join can be constructed between any two images. 80 -- However a VertJoin instance is required to be between two images 81 -- of equal width. The vertJoin constructor adds background fills 82 -- to the provides images that assure this is true for the VertJoin 83 -- value produced. 84 | VertJoin 85 { partTop :: Image 86 , partBottom :: Image 87 , outputWidth :: Int 88 -- ^ imageWidth partTop == imageWidth partBottom. always > 0 89 , outputHeight :: Int 90 -- ^ imageHeight partTop == imageHeight partBottom. always > 1 91 } 92 -- | A background fill will be filled with the background char. The 93 -- background char is defined as a property of the Picture this 94 -- Image is used to form. 95 | BGFill 96 { outputWidth :: Int -- ^ always > 0 97 , outputHeight :: Int -- ^ always > 0 98 } 99 -- | Crop an image horizontally to a size by reducing the size from 100 -- the right. 101 | CropRight 102 { croppedImage :: Image 103 -- | Always < imageWidth croppedImage > 0 104 , outputWidth :: Int 105 , outputHeight :: Int -- ^ imageHeight croppedImage 106 } 107 -- | Crop an image horizontally to a size by reducing the size from 108 -- the left. 109 | CropLeft 110 { croppedImage :: Image 111 -- | Always < imageWidth croppedImage > 0 112 , leftSkip :: Int 113 -- | Always < imageWidth croppedImage > 0 114 , outputWidth :: Int 115 , outputHeight :: Int 116 } 117 -- | Crop an image vertically to a size by reducing the size from 118 -- the bottom 119 | CropBottom 120 { croppedImage :: Image 121 -- | imageWidth croppedImage 122 , outputWidth :: Int 123 -- | height image is cropped to. Always < imageHeight croppedImage > 0 124 , outputHeight :: Int 125 } 126 -- | Crop an image vertically to a size by reducing the size from 127 -- the top 128 | CropTop 129 { croppedImage :: Image 130 -- | Always < imageHeight croppedImage > 0 131 , topSkip :: Int 132 -- | imageWidth croppedImage 133 , outputWidth :: Int 134 -- | Always < imageHeight croppedImage > 0 135 , outputHeight :: Int 136 } 137 -- | The empty image 138 -- 139 -- The combining operators identity constant. 140 -- EmptyImage <|> a = a 141 -- EmptyImage <-> a = a 142 -- 143 -- Any image of zero size equals the empty image. 144 | EmptyImage 145 deriving (Eq, Generic, Show, Read) 146 147-- | pretty print just the structure of an image. 148ppImageStructure :: Image -> String 149ppImageStructure = go 0 150 where 151 go indent img = tab indent ++ pp indent img 152 tab indent = concat $ replicate indent " " 153 pp _ (HorizText {outputWidth}) = "HorizText(" ++ show outputWidth ++ ")" 154 pp _ (BGFill {outputWidth, outputHeight}) 155 = "BGFill(" ++ show outputWidth ++ "," ++ show outputHeight ++ ")" 156 pp i (HorizJoin {partLeft = l, partRight = r, outputWidth = c}) 157 = "HorizJoin(" ++ show c ++ ")\n" ++ go (i+1) l ++ "\n" ++ go (i+1) r 158 pp i (VertJoin {partTop = t, partBottom = b, outputWidth = c, outputHeight = r}) 159 = "VertJoin(" ++ show c ++ ", " ++ show r ++ ")\n" 160 ++ go (i+1) t ++ "\n" 161 ++ go (i+1) b 162 pp i (CropRight {croppedImage, outputWidth, outputHeight}) 163 = "CropRight(" ++ show outputWidth ++ "," ++ show outputHeight ++ ")\n" 164 ++ go (i+1) croppedImage 165 pp i (CropLeft {croppedImage, leftSkip, outputWidth, outputHeight}) 166 = "CropLeft(" ++ show leftSkip ++ "->" ++ show outputWidth ++ "," ++ show outputHeight ++ ")\n" 167 ++ go (i+1) croppedImage 168 pp i (CropBottom {croppedImage, outputWidth, outputHeight}) 169 = "CropBottom(" ++ show outputWidth ++ "," ++ show outputHeight ++ ")\n" 170 ++ go (i+1) croppedImage 171 pp i (CropTop {croppedImage, topSkip, outputWidth, outputHeight}) 172 = "CropTop("++ show outputWidth ++ "," ++ show topSkip ++ "->" ++ show outputHeight ++ ")\n" 173 ++ go (i+1) croppedImage 174 pp _ EmptyImage = "EmptyImage" 175 176instance NFData Image where 177 rnf EmptyImage = () 178 rnf (CropRight i w h) = i `deepseq` w `seq` h `seq` () 179 rnf (CropLeft i s w h) = i `deepseq` s `seq` w `seq` h `seq` () 180 rnf (CropBottom i w h) = i `deepseq` w `seq` h `seq` () 181 rnf (CropTop i s w h) = i `deepseq` s `seq` w `seq` h `seq` () 182 rnf (BGFill w h) = w `seq` h `seq` () 183 rnf (VertJoin t b w h) = t `deepseq` b `deepseq` w `seq` h `seq` () 184 rnf (HorizJoin l r w h) = l `deepseq` r `deepseq` w `seq` h `seq` () 185 rnf (HorizText a s w cw) = a `seq` s `deepseq` w `seq` cw `seq` () 186 187-- | The width of an Image. This is the number display columns the image 188-- will occupy. 189imageWidth :: Image -> Int 190imageWidth HorizText { outputWidth = w } = w 191imageWidth HorizJoin { outputWidth = w } = w 192imageWidth VertJoin { outputWidth = w } = w 193imageWidth BGFill { outputWidth = w } = w 194imageWidth CropRight { outputWidth = w } = w 195imageWidth CropLeft { outputWidth = w } = w 196imageWidth CropBottom { outputWidth = w } = w 197imageWidth CropTop { outputWidth = w } = w 198imageWidth EmptyImage = 0 199 200-- | The height of an Image. This is the number of display rows the 201-- image will occupy. 202imageHeight :: Image -> Int 203imageHeight HorizText {} = 1 204imageHeight HorizJoin { outputHeight = h } = h 205imageHeight VertJoin { outputHeight = h } = h 206imageHeight BGFill { outputHeight = h } = h 207imageHeight CropRight { outputHeight = h } = h 208imageHeight CropLeft { outputHeight = h } = h 209imageHeight CropBottom { outputHeight = h } = h 210imageHeight CropTop { outputHeight = h } = h 211imageHeight EmptyImage = 0 212 213-- | Append in the 'Semigroup' instance is equivalent to '<->'. 214instance Semigroup Image where 215 (<>) = vertJoin 216 217-- | Append in the 'Monoid' instance is equivalent to '<->'. 218instance Monoid Image where 219 mempty = EmptyImage 220#if !(MIN_VERSION_base(4,11,0)) 221 mappend = (<>) 222#endif 223 224-- | combines two images side by side 225-- 226-- Combines text chunks where possible. Assures outputWidth and 227-- outputHeight properties are not violated. 228-- 229-- The result image will have a width equal to the sum of the two images 230-- width. And the height will equal the largest height of the two 231-- images. The area not defined in one image due to a height missmatch 232-- will be filled with the background pattern. 233horizJoin :: Image -> Image -> Image 234horizJoin EmptyImage i = i 235horizJoin i EmptyImage = i 236horizJoin i0@(HorizText a0 t0 w0 cw0) i1@(HorizText a1 t1 w1 cw1) 237 | a0 == a1 = HorizText a0 (TL.append t0 t1) (w0 + w1) (cw0 + cw1) 238 -- assumes horiz text height is always 1 239 | otherwise = HorizJoin i0 i1 (w0 + w1) 1 240horizJoin i0 i1 241 -- If the images are of the same height then no padding is required 242 | h0 == h1 = HorizJoin i0 i1 w h0 243 -- otherwise one of the images needs to be padded to the right size. 244 | h0 < h1 -- Pad i0 245 = let padAmount = h1 - h0 246 in HorizJoin (VertJoin i0 (BGFill w0 padAmount) w0 h1) i1 w h1 247 | h0 > h1 -- Pad i1 248 = let padAmount = h0 - h1 249 in HorizJoin i0 (VertJoin i1 (BGFill w1 padAmount) w1 h0) w h0 250 where 251 w0 = imageWidth i0 252 w1 = imageWidth i1 253 w = w0 + w1 254 h0 = imageHeight i0 255 h1 = imageHeight i1 256horizJoin _ _ = error "horizJoin applied to undefined values." 257 258-- | combines two images vertically 259-- 260-- The result image will have a height equal to the sum of the heights 261-- of both images. The width will equal the largest width of the two 262-- images. The area not defined in one image due to a width missmatch 263-- will be filled with the background pattern. 264vertJoin :: Image -> Image -> Image 265vertJoin EmptyImage i = i 266vertJoin i EmptyImage = i 267vertJoin i0 i1 268 -- If the images are of the same width then no background padding is 269 -- required 270 | w0 == w1 = VertJoin i0 i1 w0 h 271 -- Otherwise one of the images needs to be padded to the size of the 272 -- other image. 273 | w0 < w1 274 = let padAmount = w1 - w0 275 in VertJoin (HorizJoin i0 (BGFill padAmount h0) w1 h0) i1 w1 h 276 | w0 > w1 277 = let padAmount = w0 - w1 278 in VertJoin i0 (HorizJoin i1 (BGFill padAmount h1) w0 h1) w0 h 279 where 280 w0 = imageWidth i0 281 w1 = imageWidth i1 282 h0 = imageHeight i0 283 h1 = imageHeight i1 284 h = h0 + h1 285vertJoin _ _ = error "vertJoin applied to undefined values." 286