git.iko.soy/vty
on master help sign in
vty/test/VerifyImageOps.hs
174 lines 7.7 kB history raw
1{-# LANGUAGE ScopedTypeVariables #-}
2module VerifyImageOps where
4import Graphics.Vty.Attributes
5import Graphics.Vty.Image.Internal
6import Verify.Graphics.Vty.Image
8import Verify
10import Control.DeepSeq
12twoSwHorizConcat :: SingleColumnChar -> SingleColumnChar -> Bool
13twoSwHorizConcat (SingleColumnChar c1) (SingleColumnChar c2) =
14 imageWidth (char defAttr c1 <|> char defAttr c2) == 2
16manySwHorizConcat :: [SingleColumnChar] -> Bool
17manySwHorizConcat cs =
18 let chars = [ char | SingleColumnChar char <- cs ]
19 l = fromIntegral $ length cs
20 in imageWidth ( horizCat $ map (char defAttr) chars ) == l
22twoSwVertConcat :: SingleColumnChar -> SingleColumnChar -> Bool
23twoSwVertConcat (SingleColumnChar c1) (SingleColumnChar c2) =
24 imageHeight (char defAttr c1 <-> char defAttr c2) == 2
26horizConcatSwAssoc :: SingleColumnChar -> SingleColumnChar -> SingleColumnChar -> Bool
27horizConcatSwAssoc (SingleColumnChar c0) (SingleColumnChar c1) (SingleColumnChar c2) =
28 (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2
29 ==
30 char defAttr c0 <|> (char defAttr c1 <|> char defAttr c2)
32twoDwHorizConcat :: DoubleColumnChar -> DoubleColumnChar -> Bool
33twoDwHorizConcat (DoubleColumnChar c1) (DoubleColumnChar c2) =
34 imageWidth (char defAttr c1 <|> char defAttr c2) == 4
36manyDwHorizConcat :: [DoubleColumnChar] -> Bool
37manyDwHorizConcat cs =
38 let chars = [ char | DoubleColumnChar char <- cs ]
39 l = fromIntegral $ length cs
40 in imageWidth ( horizCat $ map (char defAttr) chars ) == l * 2
42twoDwVertConcat :: DoubleColumnChar -> DoubleColumnChar -> Bool
43twoDwVertConcat (DoubleColumnChar c1) (DoubleColumnChar c2) =
44 imageHeight (char defAttr c1 <-> char defAttr c2) == 2
46horizConcatDwAssoc :: DoubleColumnChar -> DoubleColumnChar -> DoubleColumnChar -> Bool
47horizConcatDwAssoc (DoubleColumnChar c0) (DoubleColumnChar c1) (DoubleColumnChar c2) =
48 (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2
49 ==
50 char defAttr c0 <|> (char defAttr c1 <|> char defAttr c2)
52vertContatSingleRow :: NonEmptyList SingleRowSingleAttrImage -> Bool
53vertContatSingleRow (NonEmpty stack) =
54 let expectedHeight :: Int = length stack
55 stackImage = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack ]
56 in imageHeight stackImage == expectedHeight
58disjointHeightHorizJoin :: NonEmptyList SingleRowSingleAttrImage
59 -> NonEmptyList SingleRowSingleAttrImage
60 -> Bool
61disjointHeightHorizJoin (NonEmpty stack0) (NonEmpty stack1) =
62 let expectedHeight :: Int = max (length stack0) (length stack1)
63 stackImage0 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]
64 stackImage1 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]
65 in imageHeight (stackImage0 <|> stackImage1) == expectedHeight
68disjointHeightHorizJoinBgFill :: NonEmptyList SingleRowSingleAttrImage
69 -> NonEmptyList SingleRowSingleAttrImage
70 -> Bool
71disjointHeightHorizJoinBgFill (NonEmpty stack0) (NonEmpty stack1) =
72 let stackImage0 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]
73 stackImage1 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]
74 image = stackImage0 <|> stackImage1
75 expectedHeight = imageHeight image
76 in case image of
77 HorizJoin {} -> ( expectedHeight == (imageHeight $ partLeft image) )
78 &&
79 ( expectedHeight == (imageHeight $ partRight image) )
80 _ -> True
82disjointWidthVertJoin :: NonEmptyList SingleRowSingleAttrImage
83 -> NonEmptyList SingleRowSingleAttrImage
84 -> Bool
85disjointWidthVertJoin (NonEmpty stack0) (NonEmpty stack1) =
86 let expectedWidth = maximum $ map imageWidth (stack0Images ++ stack1Images)
87 stack0Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]
88 stack1Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]
89 stack0Image = vertCat stack0Images
90 stack1Image = vertCat stack1Images
91 image = stack0Image <-> stack1Image
92 in imageWidth image == expectedWidth
94disjointWidthVertJoinBgFill :: NonEmptyList SingleRowSingleAttrImage
95 -> NonEmptyList SingleRowSingleAttrImage
96 -> Bool
97disjointWidthVertJoinBgFill (NonEmpty stack0) (NonEmpty stack1) =
98 let expectedWidth = maximum $ map imageWidth (stack0Images ++ stack1Images)
99 stack0Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]
100 stack1Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]
101 stack0Image = vertCat stack0Images
102 stack1Image = vertCat stack1Images
103 image = stack0Image <-> stack1Image
104 in case image of
105 VertJoin {} -> ( expectedWidth == (imageWidth $ partTop image) )
106 &&
107 ( expectedWidth == (imageWidth $ partBottom image) )
108 _ -> True
110translationIsLinearOnOutSize :: Translation -> Bool
111translationIsLinearOnOutSize (Translation i (x,y) i') =
112 imageWidth i' == imageWidth i + x && imageHeight i' == imageHeight i + y
114paddingIsLinearOnOutSize :: Image -> Gen Bool
115paddingIsLinearOnOutSize i = do
116 l <- offset
117 t <- offset
118 r <- offset
119 b <- offset
120 let i' = pad l t r b i
121 return $ imageWidth i' == imageWidth i + l + r && imageHeight i' == imageHeight i + t + b
122 where offset = choose (1,1024)
124cropLeftLimitsWidth :: Image -> Int -> Property
125cropLeftLimitsWidth i v = v >= 0 ==>
126 v >= imageWidth (cropLeft v i)
128cropRightLimitsWidth :: Image -> Int -> Property
129cropRightLimitsWidth i v = v >= 0 ==>
130 v >= imageWidth (cropRight v i)
132cropTopLimitsHeight :: Image -> Int -> Property
133cropTopLimitsHeight i v = v >= 0 ==>
134 v >= imageHeight (cropTop v i)
136cropBottomLimitsHeight :: Image -> Int -> Property
137cropBottomLimitsHeight i v = v >= 0 ==>
138 v >= imageHeight (cropBottom v i)
140-- ridiculous tests just to satisfy my desire for nice code coverage :-P
141canShowImage :: Image -> Bool
142canShowImage i = length (show i) > 0
144canRnfImage :: Image -> Bool
145canRnfImage i = rnf i == ()
147canPpImage :: Image -> Bool
148canPpImage i = length (ppImageStructure i) > 0
150tests :: IO [Test]
151tests = return
152 [ verify "twoSwHorizConcat" twoSwHorizConcat
153 , verify "manySwHorizConcat" manySwHorizConcat
154 , verify "twoSwVertConcat" twoSwVertConcat
155 , verify "horizConcatSwAssoc" horizConcatSwAssoc
156 , verify "manyDwHorizConcat" manyDwHorizConcat
157 , verify "twoDwHorizConcat" twoDwHorizConcat
158 , verify "twoDwVertConcat" twoDwVertConcat
159 , verify "horizConcatDwAssoc" horizConcatDwAssoc
160 , verify "single row vert concats to correct height" vertContatSingleRow
161 , verify "disjointHeightHorizJoin" disjointHeightHorizJoin
162 , verify "disjointHeightHorizJoin BG fill" disjointHeightHorizJoinBgFill
163 , verify "disjointWidthVertJoin" disjointWidthVertJoin
164 , verify "disjointWidthVertJoin BG fill" disjointWidthVertJoinBgFill
165 , verify "translation effects output dimensions linearly" translationIsLinearOnOutSize
166 , verify "padding effects output dimensions linearly" paddingIsLinearOnOutSize
167 , verify "crop left limits width" cropLeftLimitsWidth
168 , verify "crop right limits width" cropRightLimitsWidth
169 , verify "crop top limits height" cropTopLimitsHeight
170 , verify "crop bottom limits height" cropBottomLimitsHeight
171 , verify "can show image" canShowImage
172 , verify "can rnf image" canRnfImage
173 , verify "can pp image" canPpImage
174 ]