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