on dc8be4e help sign in
vty/test/VerifyImageOps.hs
124 lines 6.2 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
10two_sw_horiz_concat :: SingleColumnChar -> SingleColumnChar -> Bool
11two_sw_horiz_concat (SingleColumnChar c1) (SingleColumnChar c2) =
12 image_width (char def_attr c1 <|> char def_attr c2) == 2
14many_sw_horiz_concat :: [SingleColumnChar] -> Bool
15many_sw_horiz_concat cs =
16 let chars = [ char | SingleColumnChar char <- cs ]
17 l = fromIntegral $ length cs
18 in image_width ( horiz_cat $ map (char def_attr) chars ) == l
20two_sw_vert_concat :: SingleColumnChar -> SingleColumnChar -> Bool
21two_sw_vert_concat (SingleColumnChar c1) (SingleColumnChar c2) =
22 image_height (char def_attr c1 <-> char def_attr c2) == 2
24horiz_concat_sw_assoc :: SingleColumnChar -> SingleColumnChar -> SingleColumnChar -> Bool
25horiz_concat_sw_assoc (SingleColumnChar c0) (SingleColumnChar c1) (SingleColumnChar c2) =
26 (char def_attr c0 <|> char def_attr c1) <|> char def_attr c2
27 ==
28 char def_attr c0 <|> (char def_attr c1 <|> char def_attr c2)
30two_dw_horiz_concat :: DoubleColumnChar -> DoubleColumnChar -> Bool
31two_dw_horiz_concat (DoubleColumnChar c1) (DoubleColumnChar c2) =
32 image_width (char def_attr c1 <|> char def_attr c2) == 4
34many_dw_horiz_concat :: [DoubleColumnChar] -> Bool
35many_dw_horiz_concat cs =
36 let chars = [ char | DoubleColumnChar char <- cs ]
37 l = fromIntegral $ length cs
38 in image_width ( horiz_cat $ map (char def_attr) chars ) == l * 2
40two_dw_vert_concat :: DoubleColumnChar -> DoubleColumnChar -> Bool
41two_dw_vert_concat (DoubleColumnChar c1) (DoubleColumnChar c2) =
42 image_height (char def_attr c1 <-> char def_attr c2) == 2
44horiz_concat_dw_assoc :: DoubleColumnChar -> DoubleColumnChar -> DoubleColumnChar -> Bool
45horiz_concat_dw_assoc (DoubleColumnChar c0) (DoubleColumnChar c1) (DoubleColumnChar c2) =
46 (char def_attr c0 <|> char def_attr c1) <|> char def_attr c2
47 ==
48 char def_attr c0 <|> (char def_attr c1 <|> char def_attr c2)
50vert_contat_single_row :: NonEmptyList SingleRowSingleAttrImage -> Bool
51vert_contat_single_row (NonEmpty stack) =
52 let expected_height :: Int = length stack
53 stack_image = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- stack ]
54 in image_height stack_image == expected_height
56disjoint_height_horiz_join :: NonEmptyList SingleRowSingleAttrImage
57 -> NonEmptyList SingleRowSingleAttrImage
58 -> Bool
59disjoint_height_horiz_join (NonEmpty stack_0) (NonEmpty stack_1) =
60 let expected_height :: Int = max (length stack_0) (length stack_1)
61 stack_image_0 = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- stack_0 ]
62 stack_image_1 = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- stack_1 ]
63 in image_height (stack_image_0 <|> stack_image_1) == expected_height
66disjoint_height_horiz_join_bg_fill :: NonEmptyList SingleRowSingleAttrImage
67 -> NonEmptyList SingleRowSingleAttrImage
68 -> Bool
69disjoint_height_horiz_join_bg_fill (NonEmpty stack_0) (NonEmpty stack_1) =
70 let stack_image_0 = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- stack_0 ]
71 stack_image_1 = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- stack_1 ]
72 image = stack_image_0 <|> stack_image_1
73 expected_height = image_height image
74 in case image of
75 HorizJoin {} -> ( expected_height == (image_height $ part_left image) )
76 &&
77 ( expected_height == (image_height $ part_right image) )
78 _ -> True
80disjoint_width_vert_join :: NonEmptyList SingleRowSingleAttrImage
81 -> NonEmptyList SingleRowSingleAttrImage
82 -> Bool
83disjoint_width_vert_join (NonEmpty stack_0) (NonEmpty stack_1) =
84 let expected_width = maximum $ map image_width (stack_0_images ++ stack_1_images)
85 stack_0_images = [ i | SingleRowSingleAttrImage { row_image = i } <- stack_0 ]
86 stack_1_images = [ i | SingleRowSingleAttrImage { row_image = i } <- stack_1 ]
87 stack_0_image = vert_cat stack_0_images
88 stack_1_image = vert_cat stack_1_images
89 image = stack_0_image <-> stack_1_image
90 in image_width image == expected_width
92disjoint_width_vert_join_bg_fill :: NonEmptyList SingleRowSingleAttrImage
93 -> NonEmptyList SingleRowSingleAttrImage
94 -> Bool
95disjoint_width_vert_join_bg_fill (NonEmpty stack_0) (NonEmpty stack_1) =
96 let expected_width = maximum $ map image_width (stack_0_images ++ stack_1_images)
97 stack_0_images = [ i | SingleRowSingleAttrImage { row_image = i } <- stack_0 ]
98 stack_1_images = [ i | SingleRowSingleAttrImage { row_image = i } <- stack_1 ]
99 stack_0_image = vert_cat stack_0_images
100 stack_1_image = vert_cat stack_1_images
101 image = stack_0_image <-> stack_1_image
102 in case image of
103 VertJoin {} -> ( expected_width == (image_width $ part_top image) )
104 &&
105 ( expected_width == (image_width $ part_bottom image) )
106 _ -> True
108tests :: IO [Test]
109tests = return
110 [ verify "two_sw_horiz_concat" two_sw_horiz_concat
111 , verify "many_sw_horiz_concat" many_sw_horiz_concat
112 , verify "two_sw_vert_concat" two_sw_vert_concat
113 , verify "horiz_concat_sw_assoc" horiz_concat_sw_assoc
114 , verify "many_dw_horiz_concat" many_dw_horiz_concat
115 , verify "two_dw_horiz_concat" two_dw_horiz_concat
116 , verify "two_dw_vert_concat" two_dw_vert_concat
117 , verify "horiz_concat_dw_assoc" horiz_concat_dw_assoc
118 , verify "single row vert concats to correct height" vert_contat_single_row
119 , verify "disjoint_height_horiz_join" disjoint_height_horiz_join
120 , verify "disjoint_height_horiz_join BG fill" disjoint_height_horiz_join_bg_fill
121 , verify "disjoint_width_vert_join" disjoint_width_vert_join
122 , verify "disjoint_width_vert_join BG fill" disjoint_width_vert_join_bg_fill
123 ]