1{-# LANGUAGE DisambiguateRecordFields #-}
2{-# LANGUAGE NamedFieldPuns #-}
3module VerifyLayersSpanGeneration where
4
5import Verify.Graphics.Vty.Prelude
6
7import Verify.Graphics.Vty.Attributes
8import Verify.Graphics.Vty.Image
9import Verify.Graphics.Vty.Picture
10import Verify.Graphics.Vty.Span
11
12import Graphics.Vty.Debug
13import Graphics.Vty.PictureToSpans
14
15import Verify
16
17import qualified Data.Vector as Vector
18
19largerHorizSpanOcclusion :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result
20largerHorizSpanOcclusion row0 row1 =
21    let i0 = rowImage row0
22        i1 = rowImage row1
23        (iLarger, iSmaller) = if imageWidth i0 > imageWidth i1 then (i0, i1) else (i1, i0)
24        expectedOps = displayOpsForImage iLarger
25        p = picForLayers [iLarger, iSmaller]
26        ops = displayOpsForPic p (imageWidth iLarger,imageHeight iLarger)
27    in verifyOpsEquality expectedOps ops
28
29-- | Two rows stacked vertical is equivalent to the first row rendered
30-- as the top layer and the second row rendered as a bottom layer with a
31-- background fill where the first row would be.
32vertStackLayerEquivalence0 :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result
33vertStackLayerEquivalence0 row0 row1 =
34    let i0 = rowImage row0
35        i1 = rowImage row1
36        i = i0 <-> i1
37        p = picForImage i
38        iLower = backgroundFill (imageWidth i0) 1 <-> i1
39        pLayered = picForLayers [i0, iLower]
40        expectedOps = displayOpsForImage i
41        opsLayered = displayOpsForPic pLayered (imageWidth iLower,imageHeight iLower)
42    in verifyOpsEquality expectedOps opsLayered
43
44vertStackLayerEquivalence1 :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result
45vertStackLayerEquivalence1 row0 row1 =
46    let i0 = rowImage row0
47        i1 = rowImage row1
48        i = i0 <-> i1
49        p = picForImage i
50        iLower = i0 <-> backgroundFill (imageWidth i1) 1
51        iUpper = backgroundFill (imageWidth i0) 1 <-> i1
52        pLayered = picForLayers [iUpper, iLower]
53        expectedOps = displayOpsForImage i
54        opsLayered = displayOpsForPic pLayered (imageWidth iLower,imageHeight iLower)
55    in verifyOpsEquality expectedOps opsLayered
56
57-- | Two rows horiz joined is equivalent to the first row rendered as
58-- the top layer and the second row rendered as a bottom layer with a
59-- background fill where the first row would be.
60horizJoinLayerEquivalence0 :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result
61horizJoinLayerEquivalence0 row0 row1 =
62    let i0 = rowImage row0
63        i1 = rowImage row1
64        i = i0 <|> i1
65        p = picForImage i
66        iLower = backgroundFill (imageWidth i0) 1 <|> i1
67        pLayered = picForLayers [i0, iLower]
68        expectedOps = displayOpsForImage i
69        opsLayered = displayOpsForPic pLayered (imageWidth iLower,imageHeight iLower)
70    in verifyOpsEquality expectedOps opsLayered
71
72horizJoinLayerEquivalence1 :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result
73horizJoinLayerEquivalence1 row0 row1 =
74    let i0 = rowImage row0
75        i1 = rowImage row1
76        i = i0 <|> i1
77        p = picForImage i
78        iLower = i0 <|> backgroundFill (imageWidth i1) 1
79        iUpper = backgroundFill (imageWidth i0) 1 <|> i1
80        pLayered = picForLayers [iUpper, iLower]
81        expectedOps = displayOpsForImage i
82        opsLayered = displayOpsForPic pLayered (imageWidth iLower,imageHeight iLower)
83    in verifyOpsEquality expectedOps opsLayered
84
85horizJoinAlternate0 :: Result
86horizJoinAlternate0 =
87    let size = 4
88        str0 = replicate size 'a'
89        str1 = replicate size 'b'
90        i0 = string defAttr str0
91        i1 = string defAttr str1
92        i = horizCat $ zipWith horizJoin (replicate size i0) (replicate size i1)
93        layer0 = horizCat $ replicate size $ i0 <|> backgroundFill size 1
94        layer1 = horizCat $ replicate size $ backgroundFill size 1 <|> i1
95        expectedOps = displayOpsForImage i
96        opsLayered = displayOpsForPic (picForLayers [layer0, layer1])
97                                      (imageWidth i,imageHeight i)
98    in verifyOpsEquality expectedOps opsLayered
99
100horizJoinAlternate1 :: Result
101horizJoinAlternate1 =
102    let size = 4
103        str0 = replicate size 'a'
104        str1 = replicate size 'b'
105        i0 = string defAttr str0
106        i1 = string defAttr str1
107        i = horizCat $ zipWith horizJoin (replicate size i0) (replicate size i1)
108        layers = [l | b <- take 4 [0,size*2..], let l = backgroundFill b 1 <|> i0 <|> i1]
109        expectedOps = displayOpsForImage i
110        opsLayered = displayOpsForPic (picForLayers layers)
111                                      (imageWidth i,imageHeight i)
112    in verifyOpsEquality expectedOps opsLayered
113
114tests :: IO [Test]
115tests = return
116    [ verify "a larger horiz span occludes a smaller span on a lower layer"
117        largerHorizSpanOcclusion
118    , verify "two rows stack vertical equiv to first image layered on top of second with padding (0)"
119        vertStackLayerEquivalence0
120    , verify "two rows stack vertical equiv to first image layered on top of second with padding (1)"
121        vertStackLayerEquivalence1
122    -- , verify "two rows horiz joined equiv to first image layered on top of second with padding (0)"
123    --     horizJoinLayerEquivalence0
124    -- , verify "two rows horiz joined equiv to first image layered on top of second with padding (1)"
125    --     horizJoinLayerEquivalence1
126    -- , verify "alternating images using joins is the same as alternating images using layers (0)"
127    --     horizJoinAlternate0
128    -- , verify "alternating images using joins is the same as alternating images using layers (1)"
129    --     horizJoinAlternate1
130    ]
131