# 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
    ]

 TODO: known benign failure.
 the right part is made by cropping the image from the left.
 the left part is made by cropping the image from the right
 the top part is made by cropping the image from the bottom.
 the bottom part is made by cropping the image from the top.
 TODO: known benign failure.
 , verify "the output of a stack is the same as that stack cropped left & right and joined together"
     cropRightAndLeftRejoinedEquivalence
# 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

cropRightAndLeftRejoinedEquivalence :: SingleAttrSingleSpanStack -> Property
cropRightAndLeftRejoinedEquivalence stack = imageWidth (stackImage stack) `mod` 2 == 0 ==>
    let i = stackImage stack
        iR = cropLeft (imageWidth i `div` 2) i
        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
        iT = cropBottom (imageHeight i `div` 2) i
        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
    , verify "the output of a stack is the same as that stack cropped top & bottom and joined together"
        cropTopAndBottomRejoinedEquivalence
    ]
