tinytools-0.1.0.7: test/Potato/Flow/RenderSpec.hs
{-# LANGUAGE RecordWildCards #-}
module Potato.Flow.RenderSpec(
spec
) where
import Relude hiding (empty, fromList)
import Test.Hspec
import Data.Default (def)
import qualified Data.IntMap as IM
import qualified Data.Text as T
import Potato.Flow
import Potato.Flow.TestStates
import Potato.Flow.GoatTester
import Potato.Flow.Controller.Manipulator.TestHelpers
testCanvas :: Int -> Int -> Int -> Int -> RenderedCanvasRegion
testCanvas x y w h = emptyRenderedCanvasRegion (LBox (V2 x y) (V2 w h))
makeRenderContextForTest :: (HasOwlTree a) => a -> BroadPhaseState -> RenderedCanvasRegion -> RenderContext
makeRenderContextForTest a bps rc = RenderContext {
_renderContext_owlTree = hasOwlTree_owlTree a
, _renderContext_layerMetaMap = IM.empty
, _renderContext_broadPhase = bps
, _renderContext_renderedCanvasRegion = rc
, _renderContext_cache = emptyRenderCache
}
potatoRenderWithSEltAndEmptyOwlTreeForTest :: [SElt] -> RenderedCanvasRegion -> RenderedCanvasRegion
potatoRenderWithSEltAndEmptyOwlTreeForTest selts rcr = potatoRenderWithOwlTree emptyOwlTree (fmap sElt_to_owlSubItem selts) rcr
testsstyle :: SuperStyle
testsstyle = def { _superStyle_fill = FillStyle_Simple '@' }
spec1 :: Spec
spec1 = do
describe "Canvas" $ do
it "potato renders blank text" $ do
let
(w,h) = (1003, 422)
canvasText = renderedCanvasToText (testCanvas (-540) 33 w h)
T.length canvasText `shouldBe` w * h + h - 1
it "potato renders stuff" $ do
let
canvas1 = testCanvas (-12) (-44) 100 100
n = 10
selts = flip map [1..n] $ \i ->
SEltBox $ def {
_sBox_box = LBox (V2 (i*2) 0) (V2 2 2)
, _sBox_superStyle = testsstyle
}
canvas2 = potatoRenderWithSEltAndEmptyOwlTreeForTest selts canvas1
canvas2Text = renderedCanvasToText canvas2
--putTextLn $ canvas2Text
T.length (T.filter (\x -> x /= ' ' && x /= '\n') canvas2Text) `shouldBe` n*4
it "renders negative LBox" $ do
let
canvas1 = testCanvas 0 0 20 20
selt = SEltBox $ def {
_sBox_box = LBox (V2 10 10) (V2 (-10) (-10))
, _sBox_superStyle = testsstyle
}
canvas2 = potatoRenderWithSEltAndEmptyOwlTreeForTest [selt] canvas1
canvas2Text = renderedCanvasToText canvas2
T.length (T.filter (\x -> x /= ' ' && x /= '\n') canvas2Text) `shouldBe` 100
it "renders to a region" $ do
let
fillBox = LBox (V2 (-12) (-44)) (V2 100 100)
renderBox = LBox (V2 (-1) 10) (V2 10 10)
canvas1 = emptyRenderedCanvasRegion fillBox
rendercontext1 = (emptyRenderContext fillBox) {
_renderContext_renderedCanvasRegion = canvas1
}
selt = SEltBox $ def {
_sBox_box = fillBox
, _sBox_superStyle = testsstyle
}
canvas2 = _renderContext_renderedCanvasRegion $ render renderBox [sElt_to_owlSubItem selt] rendercontext1
canvas2Text = renderedCanvasToText canvas2
canvas2TextRegion = renderedCanvasRegionToText renderBox canvas2
--putTextLn $ canvas2Text
T.length (T.filter (\x -> x /= ' ' && x /= '\n') canvas2Text) `shouldBe` lBox_area renderBox
T.length (T.filter (\x -> x /= ' ' && x /= '\n') canvas2TextRegion) `shouldBe` lBox_area renderBox
it "moveRenderedCanvasRegionNoReRender - translate" $ do
let
-- fill the whole canvas
canvas1 = testCanvas 0 0 100 100
selt = SEltBox $ def {
_sBox_box = LBox (V2 0 0) (V2 100 100)
, _sBox_superStyle = testsstyle
}
canvas2 = potatoRenderWithSEltAndEmptyOwlTreeForTest [selt] canvas1
target = LBox (V2 (-50) (-50)) (V2 100 100)
canvas3 = moveRenderedCanvasRegionNoReRender target canvas2
canvas3Text = renderedCanvasToText canvas3
T.length (T.filter (\x -> x /= ' ' && x /= '\n') canvas3Text) `shouldBe` 50*50
it "moveRenderedCanvasRegionNoReRender - resize" $ do
let
canvas1 = testCanvas 0 0 50 100
-- fill the whole canvas and then some
selt = SEltBox $ def {
_sBox_box = LBox (V2 0 0) (V2 100 100)
, _sBox_superStyle = testsstyle
}
canvas2 = potatoRenderWithSEltAndEmptyOwlTreeForTest [selt] canvas1
target = LBox (V2 0 0) (V2 100 50)
canvas3 = moveRenderedCanvasRegionNoReRender target canvas2
canvas3Text = renderedCanvasToText canvas3
T.length (T.filter (\x -> x /= ' ' && x /= '\n') canvas3Text) `shouldBe` 50*50
it "moveRenderedCanvasRegion" $ do
let
initial = LBox (V2 0 0) (V2 50 100)
target = LBox (V2 0 0) (V2 100 50)
selt = SEltBox $ def {
_sBox_box = LBox (V2 0 0) (V2 100 100)
, _sBox_superStyle = testsstyle
}
state0 = owlPFState_fromSElts [selt] initial
bps0 = BroadPhaseState $ bPTreeFromOwlPFState state0
canvas0 = potatoRenderPFState state0
rendercontext0 = makeRenderContextForTest state0 bps0 canvas0
rendercontext1 = moveRenderedCanvasRegion target rendercontext0
--canvas1 = _renderContext_renderedCanvasRegion rendercontext1
-- only thing changed is the canvas size, so we can keep using rendercontext
rendercontext2 = moveRenderedCanvasRegion initial rendercontext1
canvas2 = _renderContext_renderedCanvasRegion rendercontext2
--liftIO $ printRenderedCanvasRegion canvas0
--liftIO $ printRenderedCanvasRegion canvas1
-- TODO test something
canvas0 `shouldBe` canvas2
it "moveRenderedCanvasRegion - from zero" $ do
let
initial = LBox (V2 0 0) (V2 0 0)
target = LBox (V2 0 0) (V2 50 50)
selt = SEltBox $ def {
_sBox_box = LBox (V2 0 0) (V2 100 100)
, _sBox_superStyle = testsstyle
}
state0 = owlPFState_fromSElts [selt] initial
bps0 = BroadPhaseState $ bPTreeFromOwlPFState state0
canvas0 = potatoRenderPFState state0
rendercontext0 = makeRenderContextForTest state0 bps0 canvas0
-- only thing changed is the canvas size
rendercontext1 = moveRenderedCanvasRegion target rendercontext0
canvas1 = _renderContext_renderedCanvasRegion rendercontext1
canvas1Text = renderedCanvasToText canvas1
--liftIO $ printRenderedCanvasRegion canvas0
--liftIO $ printRenderedCanvasRegion canvas1
T.length (T.filter (\x -> x /= ' ' && x /= '\n') canvas1Text) `shouldBe` 50*50
it "updateCanvas - basic" $ do
let
--makeChange rid lb = IM.singleton rid $ Just (SEltLabel (show rid) (SEltBox $ SBox lb def def def SBoxType_Box))
canvas0 = testCanvas 0 0 100 100
state0 = owlpfstate_basic1
bpt0 = bPTreeFromOwlPFState state0
-- TODO actual changes
changes1 = IM.empty
(aabbs1, bps1) = update_bPTree emptyOwlTree IM.empty bpt0
state1 = state0
rendercontext0 = makeRenderContextForTest state1 bps1 canvas0
rendercontext1 = updateCanvas changes1 aabbs1 rendercontext0
canvas1 = _renderContext_renderedCanvasRegion rendercontext1
-- TODO test something
canvas1 `shouldBe` canvas1
render_basic :: Spec
render_basic = hSpecGoatTesterWithOwlPFState (emptyOwlStateWithSize (20,20)) $ do
setMarker "verify empty initial state"
verifyRenderNonEmptyCount 0
setMarker "draw a box"
drawCanvasBox (0, 0, 2, 2)
verifyRenderNonEmptyCount 4
setMarker "hide the box"
layerMouseDownUpRel LMO_Hide 0 0
verifyRenderNonEmptyCount 0
setMarker "unhide the box"
layerMouseDownUpRel LMO_Hide 0 0
verifyRenderNonEmptyCount 4
setMarker "delete the box"
pressBackspace
verifyRenderNonEmptyCount 0
render_hide_basic :: Spec
render_hide_basic = hSpecGoatTesterWithOwlPFState (emptyOwlStateWithSize (20,20)) $ do
setMarker "verify empty initial state"
verifyRenderNonEmptyCount 0
setMarker "make a folder"
addFolder "hide me"
setMarker "draw a box"
drawCanvasBox (0, 0, 2, 2)
verifyRenderNonEmptyCount 4
setMarker "hide the folder"
layerMouseDownUpRel LMO_Hide 0 0
verifyRenderNonEmptyCount 0
setMarker "deselect evertyhing"
pressEscape
verifySelectionCount 0
setMarker "drag the box out of the folder"
layerMouseDownUpRel LMO_Normal 1 1
verifySelectionCount 1
layerMouseDownRel LMO_Normal 1 1
layerMouseDownUpRel (LMO_DropInFolder 0) 2 0
verifyRenderNonEmptyCount 4
setMarker "drag the box into the folder"
layerMouseDownRel LMO_Normal 1 0
layerMouseDownUpRel (LMO_DropInFolder 0) 1 1
verifyRenderNonEmptyCount 0
spec2 :: Spec
spec2 = do
describe "Render" $ do
describe "render_basic" $ render_basic
describe "render_hide_basic" $ render_hide_basic
spec :: Spec
spec = do
spec1
spec2