Render UTs

Author: minimapletinytools

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

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             -> " "

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

test/Potato/Flow/Controller/Manipulator/LayersSpec.hs

@@ -444,6 +444,7 @@ drag_folder_depth_test = hSpecGoatTesterWithOwlPFState emptyOwlPFState $ do
   --         1<box>
 
 
+
 spec :: Spec
 spec = do
   describe "Layers" $ do

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)

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