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