mirror of
https://github.com/ilyakooo0/vty.git
synced 2024-10-04 11:17:08 +03:00
94 lines
3.9 KiB
Haskell
94 lines
3.9 KiB
Haskell
{-# LANGUAGE DisambiguateRecordFields #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
module VerifyCropSpanGeneration 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
|
|
|
|
cropOpDisplayOps :: (Int -> Image -> Image) ->
|
|
Int -> Image -> (DisplayOps, Image)
|
|
cropOpDisplayOps cropOp v i =
|
|
let iOut = cropOp v i
|
|
p = picForImage iOut
|
|
w = MockWindow (imageWidth iOut) (imageHeight iOut)
|
|
in (displayOpsForPic p (regionForWindow w), iOut)
|
|
|
|
widthCropOutputColumns :: (Int -> Image -> Image) ->
|
|
SingleAttrSingleSpanStack ->
|
|
NonNegative Int ->
|
|
Property
|
|
widthCropOutputColumns cropOp s (NonNegative w) = stackWidth s > w ==>
|
|
let (ops, iOut) = cropOpDisplayOps cropOp w (stackImage s)
|
|
in verifyAllSpansHaveWidth iOut ops w
|
|
|
|
heightCropOutputColumns :: (Int -> Image -> Image) ->
|
|
SingleAttrSingleSpanStack ->
|
|
NonNegative Int ->
|
|
Property
|
|
heightCropOutputColumns cropOp s (NonNegative h) = stackHeight s > h ==>
|
|
let (ops, _) = cropOpDisplayOps cropOp h (stackImage s)
|
|
in displayOpsRows ops == h
|
|
|
|
cropRightOutputColumns :: SingleAttrSingleSpanStack -> NonNegative Int -> Property
|
|
cropRightOutputColumns = widthCropOutputColumns cropRight
|
|
|
|
cropLeftOutputColumns :: SingleAttrSingleSpanStack -> NonNegative Int -> Property
|
|
cropLeftOutputColumns = widthCropOutputColumns cropLeft
|
|
|
|
cropTopOutputRows :: SingleAttrSingleSpanStack -> NonNegative Int -> Property
|
|
cropTopOutputRows = heightCropOutputColumns cropTop
|
|
|
|
cropBottomOutputRows :: SingleAttrSingleSpanStack -> NonNegative Int -> Property
|
|
cropBottomOutputRows = heightCropOutputColumns cropBottom
|
|
|
|
-- TODO: known benign failure.
|
|
cropRightAndLeftRejoinedEquivalence :: SingleAttrSingleSpanStack -> Property
|
|
cropRightAndLeftRejoinedEquivalence stack = imageWidth (stackImage stack) `mod` 2 == 0 ==>
|
|
let i = stackImage stack
|
|
-- the right part is made by cropping the image from the left.
|
|
iR = cropLeft (imageWidth i `div` 2) i
|
|
-- the left part is made by cropping the image from the right
|
|
iL = cropRight (imageWidth i `div` 2) i
|
|
iAlt = iL <|> iR
|
|
iOps = displayOpsForImage i
|
|
iAltOps = displayOpsForImage iAlt
|
|
in verifyOpsEquality iOps iAltOps
|
|
|
|
cropTopAndBottomRejoinedEquivalence :: SingleAttrSingleSpanStack -> Property
|
|
cropTopAndBottomRejoinedEquivalence stack = imageHeight (stackImage stack) `mod` 2 == 0 ==>
|
|
let i = stackImage stack
|
|
-- the top part is made by cropping the image from the bottom.
|
|
iT = cropBottom (imageHeight i `div` 2) i
|
|
-- the bottom part is made by cropping the image from the top.
|
|
iB = cropTop (imageHeight i `div` 2) i
|
|
iAlt = iT <-> iB
|
|
in displayOpsForImage i == displayOpsForImage iAlt
|
|
|
|
tests :: IO [Test]
|
|
tests = return
|
|
[ verify "cropping from the bottom produces display operations covering the expected rows"
|
|
cropBottomOutputRows
|
|
, verify "cropping from the top produces display operations covering the expected rows"
|
|
cropTopOutputRows
|
|
, verify "cropping from the left produces display operations covering the expected columns"
|
|
cropLeftOutputColumns
|
|
, verify "cropping from the right produces display operations covering the expected columns"
|
|
cropRightOutputColumns
|
|
-- TODO: known benign failure.
|
|
-- , verify "the output of a stack is the same as that stack cropped left & right and joined together"
|
|
-- cropRightAndLeftRejoinedEquivalence
|
|
, verify "the output of a stack is the same as that stack cropped top & bottom and joined together"
|
|
cropTopAndBottomRejoinedEquivalence
|
|
]
|
|
|