vty/test/VerifySimpleSpanGeneration.hs
2018-11-28 11:40:30 -08:00

189 lines
9.1 KiB
Haskell

{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
module VerifySimpleSpanGeneration where
import Verify.Graphics.Vty.Prelude
import Verify.Graphics.Vty.Image
import Verify.Graphics.Vty.Picture
import Verify.Graphics.Vty.Span
import Graphics.Vty.Debug
import Graphics.Vty.PictureToSpans
import Verify
import qualified Data.Vector as Vector
unitImageAndZeroWindow0 :: UnitImage -> EmptyWindow -> Bool
unitImageAndZeroWindow0 (UnitImage _ i) (EmptyWindow w) =
let p = picForImage i
ops = displayOpsForPic p (regionForWindow w)
in displayOpsColumns ops == 0 && displayOpsRows ops == 0
unitImageAndZeroWindow1 :: UnitImage -> EmptyWindow -> Bool
unitImageAndZeroWindow1 (UnitImage _ i) (EmptyWindow w) =
let p = picForImage i
ops = displayOpsForPic p (regionForWindow w)
in ( spanOpsAffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )
horizSpanImageAndZeroWindow0 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool
horizSpanImageAndZeroWindow0 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =
let p = picForImage i
ops = displayOpsForPic p (regionForWindow w)
in displayOpsColumns ops == 0 && displayOpsRows ops == 0
horizSpanImageAndZeroWindow1 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool
horizSpanImageAndZeroWindow1 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =
let p = picForImage i
ops = displayOpsForPic p (regionForWindow w)
in ( spanOpsAffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )
horizSpanImageAndEqualWindow0 :: SingleRowSingleAttrImage -> Result
horizSpanImageAndEqualWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =
let p = picForImage i
w = MockWindow c 1
ops = displayOpsForPic p (regionForWindow w)
in verifyAllSpansHaveWidth i ops c
horizSpanImageAndEqualWindow1 :: SingleRowSingleAttrImage -> Bool
horizSpanImageAndEqualWindow1 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =
let p = picForImage i
w = MockWindow c 1
ops = displayOpsForPic p (regionForWindow w)
in spanOpsAffectedRows ops == 1
horizSpanImageAndLesserWindow0 :: SingleRowSingleAttrImage -> Result
horizSpanImageAndLesserWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =
let p = picForImage i
lesserWidth = c `div` 2
w = MockWindow lesserWidth 1
ops = displayOpsForPic p (regionForWindow w)
in verifyAllSpansHaveWidth i ops lesserWidth
singleAttrSingleSpanStackCropped0 :: SingleAttrSingleSpanStack -> Result
singleAttrSingleSpanStackCropped0 stack =
let p = picForImage (stackImage stack)
w = MockWindow (stackWidth stack `div` 2) (stackHeight stack)
ops = displayOpsForPic p (regionForWindow w)
in verifyAllSpansHaveWidth (stackImage stack) ops (stackWidth stack `div` 2)
singleAttrSingleSpanStackCropped1 :: SingleAttrSingleSpanStack -> Bool
singleAttrSingleSpanStackCropped1 stack =
let p = picForImage (stackImage stack)
expectedRowCount = stackHeight stack `div` 2
w = MockWindow (stackWidth stack) expectedRowCount
ops = displayOpsForPic p (regionForWindow w)
actualRowCount = spanOpsAffectedRows ops
in expectedRowCount == actualRowCount
singleAttrSingleSpanStackCropped2 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result
singleAttrSingleSpanStackCropped2 stack0 stack1 =
let p = picForImage (stackImage stack0 <|> stackImage stack1)
w = MockWindow (stackWidth stack0) (imageHeight (picImage p))
ops = displayOpsForPic p (regionForWindow w)
in verifyAllSpansHaveWidth (picImage p) ops (stackWidth stack0)
singleAttrSingleSpanStackCropped3 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Bool
singleAttrSingleSpanStackCropped3 stack0 stack1 =
let p = picForImage (stackImage stack0 <|> stackImage stack1)
w = MockWindow (imageWidth (picImage p)) expectedRowCount
ops = displayOpsForPic p (regionForWindow w)
expectedRowCount = imageHeight (picImage p) `div` 2
actualRowCount = spanOpsAffectedRows ops
in expectedRowCount == actualRowCount
singleAttrSingleSpanStackCropped4 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result
singleAttrSingleSpanStackCropped4 stack0 stack1 =
let p = picForImage (stackImage stack0 <-> stackImage stack1)
w = MockWindow expectedWidth (imageHeight (picImage p))
ops = displayOpsForPic p (regionForWindow w)
expectedWidth = imageWidth (picImage p) `div` 2
in verifyAllSpansHaveWidth (picImage p) ops expectedWidth
singleAttrSingleSpanStackCropped5 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Bool
singleAttrSingleSpanStackCropped5 stack0 stack1 =
let p = picForImage (stackImage stack0 <-> stackImage stack1)
w = MockWindow (imageWidth (picImage p)) (stackHeight stack0)
ops = displayOpsForPic p (regionForWindow w)
expectedRowCount = stackHeight stack0
actualRowCount = spanOpsAffectedRows ops
in expectedRowCount == actualRowCount
horizSpanImageAndGreaterWindow0 :: SingleRowSingleAttrImage -> Result
horizSpanImageAndGreaterWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =
let p = picForImage i
-- SingleRowSingleAttrImage always has width >= 1
greaterWidth = c * 2
w = MockWindow greaterWidth 1
ops = displayOpsForPic p (regionForWindow w)
in verifyAllSpansHaveWidth i ops greaterWidth
arbImageIsCropped :: DefaultImage -> MockWindow -> Bool
arbImageIsCropped (DefaultImage image) win@(MockWindow w h) =
let pic = picForImage image
ops = displayOpsForPic pic (regionForWindow win)
in ( spanOpsAffectedRows ops == h ) && ( allSpansHaveWidth ops w )
spanOpsActuallyFillRows :: DefaultPic -> Bool
spanOpsActuallyFillRows (DefaultPic pic win) =
let ops = displayOpsForPic pic (regionForWindow win)
expectedRowCount = regionHeight (regionForWindow win)
actualRowCount = spanOpsAffectedRows ops
in expectedRowCount == actualRowCount
spanOpsActuallyFillColumns :: DefaultPic -> Bool
spanOpsActuallyFillColumns (DefaultPic pic win) =
let ops = displayOpsForPic pic (regionForWindow win)
expectedColumnCount = regionWidth (regionForWindow win)
in allSpansHaveWidth ops expectedColumnCount
firstSpanOpSetsAttr :: DefaultPic -> Bool
firstSpanOpSetsAttr DefaultPic { defaultPic = pic, defaultWin = win } =
let ops = displayOpsForPic pic (regionForWindow win)
in all ( isAttrSpanOp . Vector.head ) ( Vector.toList ops )
singleAttrSingleSpanStackOpCoverage :: SingleAttrSingleSpanStack -> Result
singleAttrSingleSpanStackOpCoverage stack =
let p = picForImage (stackImage stack)
w = MockWindow (stackWidth stack) (stackHeight stack)
ops = displayOpsForPic p (regionForWindow w)
in verifyAllSpansHaveWidth (stackImage stack) ops (stackWidth stack)
imageCoverageMatchesBounds :: Image -> Result
imageCoverageMatchesBounds i =
let p = picForImage i
r = (imageWidth i,imageHeight i)
ops = displayOpsForPic p r
in verifyAllSpansHaveWidth i ops (imageWidth i)
tests :: IO [Test]
tests = return
[ verify "unit image is cropped when window size == (0,0) [0]" unitImageAndZeroWindow0
, verify "unit image is cropped when window size == (0,0) [1]" unitImageAndZeroWindow1
, verify "horiz span image is cropped when window size == (0,0) [0]" horizSpanImageAndZeroWindow0
, verify "horiz span image is cropped when window size == (0,0) [1]" horizSpanImageAndZeroWindow1
, verify "horiz span image is not cropped when window size == size of image [width]" horizSpanImageAndEqualWindow0
, verify "horiz span image is not cropped when window size == size of image [height]" horizSpanImageAndEqualWindow1
, verify "horiz span image is not cropped when window size < size of image [width]" horizSpanImageAndLesserWindow0
, verify "horiz span image is not cropped when window size > size of image [width]" horizSpanImageAndGreaterWindow0
, verify "first span op is always to set the text attribute" firstSpanOpSetsAttr
, verify "a stack of single attr text spans should define content for all the columns [output region == size of stack]"
singleAttrSingleSpanStackOpCoverage
, verify "a single attr text span is cropped when window size < size of stack image [width]"
singleAttrSingleSpanStackCropped0
, verify "a single attr text span is cropped when window size < size of stack image [height]"
singleAttrSingleSpanStackCropped1
, verify "single attr text span <|> single attr text span display cropped. [width]"
singleAttrSingleSpanStackCropped2
, verify "single attr text span <|> single attr text span display cropped. [height]"
singleAttrSingleSpanStackCropped3
, verify "single attr text span <-> single attr text span display cropped. [width]"
singleAttrSingleSpanStackCropped4
, verify "single attr text span <-> single attr text span display cropped. [height]"
singleAttrSingleSpanStackCropped5
, verify "an arbitrary image when rendered to a window of the same size will cover the entire window"
imageCoverageMatchesBounds
]