{-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE DeriveGeneric #-} {-# OPTIONS_HADDOCK hide #-} module Graphics.Vty.Image.Internal where import Graphics.Vty.Attributes import Graphics.Text.Width import GHC.Generics import Control.DeepSeq #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup (Semigroup(..)) #endif import qualified Data.Text.Lazy as TL -- | A display text is a Data.Text.Lazy type DisplayText = TL.Text clipText :: DisplayText -> Int -> Int -> DisplayText clipText txt leftSkip rightClip = -- CPS would clarify this I think let (toDrop,padPrefix) = clipForCharWidth leftSkip txt 0 txt' = if padPrefix then TL.cons '…' (TL.drop (toDrop+1) txt) else TL.drop toDrop txt (toTake,padSuffix) = clipForCharWidth rightClip txt' 0 txt'' = TL.append (TL.take toTake txt') (if padSuffix then TL.singleton '…' else TL.empty) -- Note: some characters and zero-width and combining characters -- combine to the left, so keep taking characters even if the -- width is zero. clipForCharWidth w t n | TL.null t = (n, False) | w < cw = (n, w /= 0) | otherwise = clipForCharWidth (w - cw) (TL.tail t) (n + 1) where cw = safeWcwidth (TL.head t) in txt'' -- | This is the internal representation of Images. Use the constructors -- in "Graphics.Vty.Image" to create instances. -- -- Images are: -- -- * a horizontal span of text -- -- * a horizontal or vertical join of two images -- -- * a two dimensional fill of the 'Picture's background character -- -- * a cropped image -- -- * an empty image of no size or content. data Image = -- | A horizontal text span has a row height of 1. HorizText { attr :: Attr -- | The text to display. The display width of the text is always -- outputWidth. , displayText :: DisplayText -- | The number of display columns for the text. , outputWidth :: Int -- | the number of characters in the text. , charWidth :: Int } -- | A horizontal join can be constructed between any two images. -- However a HorizJoin instance is required to be between two images -- of equal height. The horizJoin constructor adds background fills -- to the provided images that assure this is true for the HorizJoin -- value produced. | HorizJoin { partLeft :: Image , partRight :: Image , outputWidth :: Int -- ^ imageWidth partLeft == imageWidth partRight. Always > 0 , outputHeight :: Int -- ^ imageHeight partLeft == imageHeight partRight. Always > 0 } -- | A veritical join can be constructed between any two images. -- However a VertJoin instance is required to be between two images -- of equal width. The vertJoin constructor adds background fills -- to the provides images that assure this is true for the VertJoin -- value produced. | VertJoin { partTop :: Image , partBottom :: Image , outputWidth :: Int -- ^ imageWidth partTop == imageWidth partBottom. always > 0 , outputHeight :: Int -- ^ imageHeight partTop == imageHeight partBottom. always > 1 } -- | A background fill will be filled with the background char. The -- background char is defined as a property of the Picture this -- Image is used to form. | BGFill { outputWidth :: Int -- ^ always > 0 , outputHeight :: Int -- ^ always > 0 } -- | Crop an image horizontally to a size by reducing the size from -- the right. | CropRight { croppedImage :: Image -- | Always < imageWidth croppedImage > 0 , outputWidth :: Int , outputHeight :: Int -- ^ imageHeight croppedImage } -- | Crop an image horizontally to a size by reducing the size from -- the left. | CropLeft { croppedImage :: Image -- | Always < imageWidth croppedImage > 0 , leftSkip :: Int -- | Always < imageWidth croppedImage > 0 , outputWidth :: Int , outputHeight :: Int } -- | Crop an image vertically to a size by reducing the size from -- the bottom | CropBottom { croppedImage :: Image -- | imageWidth croppedImage , outputWidth :: Int -- | height image is cropped to. Always < imageHeight croppedImage > 0 , outputHeight :: Int } -- | Crop an image vertically to a size by reducing the size from -- the top | CropTop { croppedImage :: Image -- | Always < imageHeight croppedImage > 0 , topSkip :: Int -- | imageWidth croppedImage , outputWidth :: Int -- | Always < imageHeight croppedImage > 0 , outputHeight :: Int } -- | The empty image -- -- The combining operators identity constant. -- EmptyImage <|> a = a -- EmptyImage <-> a = a -- -- Any image of zero size equals the empty image. | EmptyImage deriving (Eq, Generic, Show, Read) -- | pretty print just the structure of an image. ppImageStructure :: Image -> String ppImageStructure inImg = go 0 inImg where go indent img = tab indent ++ pp indent img tab indent = concat $ replicate indent " " pp _ (HorizText {outputWidth}) = "HorizText(" ++ show outputWidth ++ ")" pp _ (BGFill {outputWidth, outputHeight}) = "BGFill(" ++ show outputWidth ++ "," ++ show outputHeight ++ ")" pp i (HorizJoin {partLeft = l, partRight = r, outputWidth = c}) = "HorizJoin(" ++ show c ++ ")\n" ++ go (i+1) l ++ "\n" ++ go (i+1) r pp i (VertJoin {partTop = t, partBottom = b, outputWidth = c, outputHeight = r}) = "VertJoin(" ++ show c ++ ", " ++ show r ++ ")\n" ++ go (i+1) t ++ "\n" ++ go (i+1) b pp i (CropRight {croppedImage, outputWidth, outputHeight}) = "CropRight(" ++ show outputWidth ++ "," ++ show outputHeight ++ ")\n" ++ go (i+1) croppedImage pp i (CropLeft {croppedImage, leftSkip, outputWidth, outputHeight}) = "CropLeft(" ++ show leftSkip ++ "->" ++ show outputWidth ++ "," ++ show outputHeight ++ ")\n" ++ go (i+1) croppedImage pp i (CropBottom {croppedImage, outputWidth, outputHeight}) = "CropBottom(" ++ show outputWidth ++ "," ++ show outputHeight ++ ")\n" ++ go (i+1) croppedImage pp i (CropTop {croppedImage, topSkip, outputWidth, outputHeight}) = "CropTop("++ show outputWidth ++ "," ++ show topSkip ++ "->" ++ show outputHeight ++ ")\n" ++ go (i+1) croppedImage pp _ EmptyImage = "EmptyImage" instance NFData Image where rnf EmptyImage = () rnf (CropRight i w h) = i `deepseq` w `seq` h `seq` () rnf (CropLeft i s w h) = i `deepseq` s `seq` w `seq` h `seq` () rnf (CropBottom i w h) = i `deepseq` w `seq` h `seq` () rnf (CropTop i s w h) = i `deepseq` s `seq` w `seq` h `seq` () rnf (BGFill w h) = w `seq` h `seq` () rnf (VertJoin t b w h) = t `deepseq` b `deepseq` w `seq` h `seq` () rnf (HorizJoin l r w h) = l `deepseq` r `deepseq` w `seq` h `seq` () rnf (HorizText a s w cw) = a `seq` s `deepseq` w `seq` cw `seq` () -- | The width of an Image. This is the number display columns the image -- will occupy. imageWidth :: Image -> Int imageWidth HorizText { outputWidth = w } = w imageWidth HorizJoin { outputWidth = w } = w imageWidth VertJoin { outputWidth = w } = w imageWidth BGFill { outputWidth = w } = w imageWidth CropRight { outputWidth = w } = w imageWidth CropLeft { outputWidth = w } = w imageWidth CropBottom { outputWidth = w } = w imageWidth CropTop { outputWidth = w } = w imageWidth EmptyImage = 0 -- | The height of an Image. This is the number of display rows the -- image will occupy. imageHeight :: Image -> Int imageHeight HorizText {} = 1 imageHeight HorizJoin { outputHeight = h } = h imageHeight VertJoin { outputHeight = h } = h imageHeight BGFill { outputHeight = h } = h imageHeight CropRight { outputHeight = h } = h imageHeight CropLeft { outputHeight = h } = h imageHeight CropBottom { outputHeight = h } = h imageHeight CropTop { outputHeight = h } = h imageHeight EmptyImage = 0 -- | Append in the 'Semigroup' instance is equivalent to '<->'. instance Semigroup Image where (<>) = vertJoin -- | Append in the 'Monoid' instance is equivalent to '<->'. instance Monoid Image where mempty = EmptyImage #if !(MIN_VERSION_base(4,11,0)) mappend = (<>) #endif -- | combines two images side by side -- -- Combines text chunks where possible. Assures outputWidth and -- outputHeight properties are not violated. -- -- The result image will have a width equal to the sum of the two images -- width. And the height will equal the largest height of the two -- images. The area not defined in one image due to a height missmatch -- will be filled with the background pattern. horizJoin :: Image -> Image -> Image horizJoin EmptyImage i = i horizJoin i EmptyImage = i horizJoin i0@(HorizText a0 t0 w0 cw0) i1@(HorizText a1 t1 w1 cw1) | a0 == a1 = HorizText a0 (TL.append t0 t1) (w0 + w1) (cw0 + cw1) -- assumes horiz text height is always 1 | otherwise = HorizJoin i0 i1 (w0 + w1) 1 horizJoin i0 i1 -- If the images are of the same height then no padding is required | h0 == h1 = HorizJoin i0 i1 w h0 -- otherwise one of the images needs to be padded to the right size. | h0 < h1 -- Pad i0 = let padAmount = h1 - h0 in HorizJoin (VertJoin i0 (BGFill w0 padAmount) w0 h1) i1 w h1 | h0 > h1 -- Pad i1 = let padAmount = h0 - h1 in HorizJoin i0 (VertJoin i1 (BGFill w1 padAmount) w1 h0) w h0 where w0 = imageWidth i0 w1 = imageWidth i1 w = w0 + w1 h0 = imageHeight i0 h1 = imageHeight i1 horizJoin _ _ = error "horizJoin applied to undefined values." -- | combines two images vertically -- -- The result image will have a height equal to the sum of the heights -- of both images. The width will equal the largest width of the two -- images. The area not defined in one image due to a width missmatch -- will be filled with the background pattern. vertJoin :: Image -> Image -> Image vertJoin EmptyImage i = i vertJoin i EmptyImage = i vertJoin i0 i1 -- If the images are of the same width then no background padding is -- required | w0 == w1 = VertJoin i0 i1 w0 h -- Otherwise one of the images needs to be padded to the size of the -- other image. | w0 < w1 = let padAmount = w1 - w0 in VertJoin (HorizJoin i0 (BGFill padAmount h0) w1 h0) i1 w1 h | w0 > w1 = let padAmount = w0 - w1 in VertJoin i0 (HorizJoin i1 (BGFill padAmount h1) w0 h1) w0 h where w0 = imageWidth i0 w1 = imageWidth i1 h0 = imageHeight i0 h1 = imageHeight i1 h = h0 + h1 vertJoin _ _ = error "vertJoin applied to undefined values."