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

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 '@' }

spec :: Spec
spec = 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