diff --git a/TODO.txt b/TODO.txt index 04e75ff7..d9146e3c 100644 --- a/TODO.txt +++ b/TODO.txt @@ -294,7 +294,7 @@ DONE-text box option that auto goes into edit text box ::NEWEST TODO:: --render testing utilities +DONE-render testing utilities -layers improvements -shift select in layers please ;__; -selecting multiple items and hitting new folder should put those items in folder maybe diff --git a/src/Potato/Flow/Controller/OwlLayers.hs b/src/Potato/Flow/Controller/OwlLayers.hs index 0f99c76f..18f74d21 100644 --- a/src/Potato/Flow/Controller/OwlLayers.hs +++ b/src/Potato/Flow/Controller/OwlLayers.hs @@ -109,7 +109,7 @@ layerEntriesToPrettyText lentries = foldr foldrfn "" lentries where then if _layerEntry_isCollapsed then ">" else "v" - else " " + else "●" hideText = case _layerEntry_hideState of LHS_True -> "▓" LHS_False -> " " diff --git a/src/Potato/Flow/Render.hs b/src/Potato/Flow/Render.hs index a0c65b86..239c7a85 100644 --- a/src/Potato/Flow/Render.hs +++ b/src/Potato/Flow/Render.hs @@ -18,6 +18,7 @@ module Potato.Flow.Render ( , printRenderedCanvasRegion , potatoRenderWithOwlTree , potatoRenderPFState + , renderedCanvasRegion_getAt , renderedCanvasToText , renderedCanvasRegionToText @@ -228,6 +229,9 @@ renderedCanvasToText :: RenderedCanvasRegion -> Text renderedCanvasToText rcr = renderedCanvasRegionToText (_renderedCanvasRegion_box rcr) rcr +renderedCanvasRegion_getAt :: RenderedCanvasRegion -> V2 Int -> MWidePChar +renderedCanvasRegion_getAt rcr = (V.!) (_renderedCanvasRegion_contents rcr) . toIndex (_renderedCanvasRegion_box rcr) + -- TODO this does not handle wide chars at all fack -- | assumes region LBox is strictly contained in _renderedCanvasRegion_box renderedCanvasRegionToText :: LBox -> RenderedCanvasRegion -> Text diff --git a/test/Potato/Flow/Controller/Manipulator/LayersSpec.hs b/test/Potato/Flow/Controller/Manipulator/LayersSpec.hs index 02992e6e..67047fca 100644 --- a/test/Potato/Flow/Controller/Manipulator/LayersSpec.hs +++ b/test/Potato/Flow/Controller/Manipulator/LayersSpec.hs @@ -444,6 +444,7 @@ drag_folder_depth_test = hSpecGoatTesterWithOwlPFState emptyOwlPFState $ do -- 1 + spec :: Spec spec = do describe "Layers" $ do diff --git a/test/Potato/Flow/GoatTester.hs b/test/Potato/Flow/GoatTester.hs index 4dd3b3d1..82a51a90 100644 --- a/test/Potato/Flow/GoatTester.hs +++ b/test/Potato/Flow/GoatTester.hs @@ -370,6 +370,26 @@ verifySelectionIsAndOnlyIs desc f = verifyState desc f' where then Just $ "failed, expected 1 selected 🦉, got " <> show nselection else (\m -> "failed with message: " <> m <> "\ngot:\n" <> potatoShow (_superOwl_elt sowl)) <$> f sowl + + +verifyRenderNonEmptyCount :: (Monad m) => Int -> GoatTesterT m () +verifyRenderNonEmptyCount expected = verifyState "verifyRenderNonEmptyCount" f where + f gs = if n == expected + then Nothing + else Just $ "got " <> show n <> " non-empty chars, expected " <> show expected + where n = renderedCanvasRegion_nonEmptyCount (_goatState_renderedCanvas gs) + +verifyCharRenderedAt :: (Monad m) => V2 Int -> Maybe Char -> GoatTesterT m () +verifyCharRenderedAt pos mchar = verifyState "verifyCharRenderedAt" f where + f gs = if mchar == mchar' + then Nothing + else Just $ "expected: " <> show mchar <> "\ngot: " <> show mchar' + where + mchar' = case renderedCanvasRegion_getAt (_goatState_renderedCanvas gs) pos of + (-1, _) -> Nothing + (_, c) -> Just c + + -- otheruseful stuff -- export as part of this module becaues it's super useful @@ -382,3 +402,16 @@ toMaybe True x = Just x alwaysFail :: (Monad m) => Text -> GoatTesterT m () alwaysFail msg = GoatTesterT $ do unGoatTesterT $ putRecord "this test always fails" (Just msg) + + +debugFailWithLayers :: (Monad m) => GoatTesterT m () +debugFailWithLayers = do + gs <- getGoatState + putRecord "debugFailWithLayers" (Just $ potatoShow $ _goatState_layersState gs) + +debugFailWithRenderedCanvas :: (Monad m) => GoatTesterT m () +debugFailWithRenderedCanvas = do + gs <- getGoatState + let + canvas = _goatState_renderedCanvas gs + putRecord "debugFailWithRenderedCanvas" (traceShow (renderedCanvas_box canvas) $ Just $ renderedCanvasToText canvas) diff --git a/test/Potato/Flow/RenderSpec.hs b/test/Potato/Flow/RenderSpec.hs index 6e3767e8..2a3b7392 100644 --- a/test/Potato/Flow/RenderSpec.hs +++ b/test/Potato/Flow/RenderSpec.hs @@ -14,6 +14,9 @@ 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)) @@ -33,8 +36,10 @@ potatoRenderWithSEltAndEmptyOwlTreeForTest selts rcr = potatoRenderWithOwlTree e testsstyle :: SuperStyle testsstyle = def { _superStyle_fill = FillStyle_Simple '@' } -spec :: Spec -spec = do + + +spec1 :: Spec +spec1 = do describe "Canvas" $ do it "potato renders blank text" $ do let @@ -164,3 +169,79 @@ spec = do canvas1 = _renderContext_renderedCanvasRegion rendercontext1 -- TODO test something canvas1 `shouldBe` canvas1 + + +emptyOwlStateWithSize :: (Int, Int) -> OwlPFState +emptyOwlStateWithSize (x, y) = OwlPFState emptyOwlTree (SCanvas (LBox 0 (V2 x y))) + +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 \ No newline at end of file