1{-# LANGUAGE DisambiguateRecordFields #-}
2{-# LANGUAGE NamedFieldPuns #-}
3module VerifyCropSpanGeneration where
4
5import Verify.Graphics.Vty.Prelude
6
7import Verify.Graphics.Vty.Image
8import Verify.Graphics.Vty.Picture
9import Verify.Graphics.Vty.Span
10
11import Graphics.Vty.Debug
12import Graphics.Vty.PictureToSpans
13
14import Verify
15
16import qualified Data.Vector as Vector
17
18cropOpDisplayOps :: (Int -> Image -> Image) ->
19                    Int -> Image -> (DisplayOps, Image)
20cropOpDisplayOps cropOp v i =
21    let iOut = cropOp v i
22        p = picForImage iOut
23        w = MockWindow (imageWidth iOut) (imageHeight iOut)
24    in (displayOpsForPic p (regionForWindow w), iOut)
25
26widthCropOutputColumns :: (Int -> Image -> Image) ->
27                          SingleAttrSingleSpanStack ->
28                          NonNegative Int ->
29                          Property
30widthCropOutputColumns cropOp s (NonNegative w) = stackWidth s > w ==>
31    let (ops, iOut) = cropOpDisplayOps cropOp w (stackImage s)
32    in verifyAllSpansHaveWidth iOut ops w
33
34heightCropOutputColumns :: (Int -> Image -> Image) ->
35                           SingleAttrSingleSpanStack ->
36                           NonNegative Int ->
37                           Property
38heightCropOutputColumns cropOp s (NonNegative h) = stackHeight s > h ==>
39    let (ops, _) = cropOpDisplayOps cropOp h (stackImage s)
40    in displayOpsRows ops == h
41
42cropRightOutputColumns :: SingleAttrSingleSpanStack -> NonNegative Int -> Property
43cropRightOutputColumns = widthCropOutputColumns cropRight
44
45cropLeftOutputColumns :: SingleAttrSingleSpanStack -> NonNegative Int -> Property
46cropLeftOutputColumns = widthCropOutputColumns cropLeft
47
48cropTopOutputRows :: SingleAttrSingleSpanStack -> NonNegative Int -> Property
49cropTopOutputRows = heightCropOutputColumns cropTop
50
51cropBottomOutputRows :: SingleAttrSingleSpanStack -> NonNegative Int -> Property
52cropBottomOutputRows = heightCropOutputColumns cropBottom
53
54-- TODO: known benign failure.
55cropRightAndLeftRejoinedEquivalence :: SingleAttrSingleSpanStack -> Property
56cropRightAndLeftRejoinedEquivalence stack = imageWidth (stackImage stack) `mod` 2 == 0 ==>
57    let i = stackImage stack
58        -- the right part is made by cropping the image from the left.
59        iR = cropLeft (imageWidth i `div` 2) i
60        -- the left part is made by cropping the image from the right
61        iL = cropRight (imageWidth i `div` 2) i
62        iAlt = iL <|> iR
63        iOps = displayOpsForImage i
64        iAltOps = displayOpsForImage iAlt
65    in verifyOpsEquality iOps iAltOps
66
67cropTopAndBottomRejoinedEquivalence :: SingleAttrSingleSpanStack -> Property
68cropTopAndBottomRejoinedEquivalence stack = imageHeight (stackImage stack) `mod` 2 == 0 ==>
69    let i = stackImage stack
70        -- the top part is made by cropping the image from the bottom.
71        iT = cropBottom (imageHeight i `div` 2) i
72        -- the bottom part is made by cropping the image from the top.
73        iB = cropTop (imageHeight i `div` 2) i
74        iAlt = iT <-> iB
75    in displayOpsForImage i == displayOpsForImage iAlt
76
77tests :: IO [Test]
78tests = return
79    [ verify "cropping from the bottom produces display operations covering the expected rows"
80        cropBottomOutputRows
81    , verify "cropping from the top produces display operations covering the expected rows"
82        cropTopOutputRows
83    , verify "cropping from the left produces display operations covering the expected columns"
84        cropLeftOutputColumns
85    , verify "cropping from the right produces display operations covering the expected columns"
86        cropRightOutputColumns
87    -- TODO: known benign failure.
88    -- , verify "the output of a stack is the same as that stack cropped left & right and joined together"
89    --     cropRightAndLeftRejoinedEquivalence
90    , verify "the output of a stack is the same as that stack cropped top & bottom and joined together"
91        cropTopAndBottomRejoinedEquivalence
92    ]
93