BoxSpec.hs

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo     #-}

module Potato.Flow.Controller.Manipulator.BoxSpec (
  spec
) where

import           Relude                                         hiding (empty,
                                                                 fromList)

import           Test.Hspec

import           Potato.Flow.GoatTester

import           Potato.Flow
import           Potato.Flow.Controller.Manipulator.TestHelpers


constrainDeltaLBox_test :: Spec
constrainDeltaLBox_test = do
  it "constrains as expected" $ do
    constrainDeltaLBox 1 (DeltaLBox 0 (V2 (-10) (-10))) ((LBox 0 (V2 5 5))) `shouldBe` DeltaLBox 0 (V2 (-4) (-4))
    constrainDeltaLBox 1 (DeltaLBox 0 (V2 (-10) 5)) ((LBox 0 (V2 5 5))) `shouldBe` DeltaLBox 0 (V2 (-4) 5)
    constrainDeltaLBox 1 (DeltaLBox (V2 10 0) (V2 (-10) 0)) ((LBox 0 (V2 5 5))) `shouldBe` DeltaLBox (V2 4 0) (V2 (-4) 0)

fetchLatestBox :: OwlPFState -> Either Text SBox
fetchLatestBox pfs = do
  sowl <- case maybeGetMostRecentlyCreatedOwl' pfs of
    Nothing -> Left "failed, no 🦉s"
    Just x  -> Right x
  case _owlItem_subItem (_superOwl_elt sowl) of
    OwlSubItemBox x -> Right x
    x                -> Left $ "expected SBox got: " <> show x

verifyMostRecentlyCreatedBoxLabelHasSize :: (Int, Int) -> GoatTester ()
verifyMostRecentlyCreatedBoxLabelHasSize (x, y) = verifyStateObjectHasProperty "verifyMostRecentlyCreatedBoxLabelHasSize" fetchLatestBox checkfn where 
  checkfn sbox = r where
    LBox _ (V2 x' y') = _sBox_box sbox
    r = if x == x' && y == y'
      then Nothing
      else Just $ "got size " <> show (x', y') <> " expected " <> show (x, y)

verifyMostRecentlyCreatedBoxHasText :: Maybe Text -> GoatTester ()
verifyMostRecentlyCreatedBoxHasText mt = verifyStateObjectHasProperty "verifyMostRecentlyCreatedBoxHasText" fetchLatestBox checkfn where
  checkfn sbox = r where
    istext = sBoxType_isText (_sBox_boxType sbox)
    r = case 
      mt of 
        Nothing -> if istext then Just "expected no text" else Nothing
        Just t -> if not istext 
          then Just "expected text" 
          else if t == _sBoxText_text (_sBox_text sbox)
            then Nothing 
            else Just $ "got text " <> show (_sBox_text sbox) <> " expected " <> t

initSimpleBox :: GoatTester ()
initSimpleBox = drawCanvasBox (0, 0, 100, 100)

basic_test :: Spec
basic_test = hSpecGoatTesterWithOwlPFState emptyOwlPFState $ do

  initSimpleBox

  -- TODO

basic_cancel_test :: Spec
basic_cancel_test = hSpecGoatTesterWithOwlPFState emptyOwlPFState $ do

  setMarker "mouse down and cancel and ensure no box is created"
  setTool Tool_Box
  canvasMouseDown (0, 0)
  pressEscape
  canvasMouseDown (100, 100)
  canvasMouseUp (100, 100)
  verifyOwlCount 0

  setMarker "draw a line and cancel after moving it"
  setTool Tool_Box
  canvasMouseDown (0, 0)
  canvasMouseDown (100, 100)
  verifyOwlCount 1
  pressEscape
  verifyOwlCount 0
  canvasMouseDown (110, 90)
  canvasMouseUp (110, 90)
  verifyOwlCount 0

  initSimpleBox

noinvert_test :: Spec
noinvert_test = hSpecGoatTesterWithOwlPFState emptyOwlPFState $ do

  setMarker "draw a box"
  drawCanvasBox (0, 0, 101, 101)

  setMarker "resize the box"
  canvasMouseDown (101,101)
  canvasMouseDown (-10,-10)
  canvasMouseUp (-10,-10)
  verifyMostRecentlyCreatedBoxLabelHasSize (1, 1)

  
boxtext_test :: Spec
boxtext_test = hSpecGoatTesterWithOwlPFState emptyOwlPFState $ do

  setMarker "draw a box"
  drawCanvasBox (0, 0, 101, 101)

  verifyMostRecentlyCreatedBoxHasText Nothing

  setMarker "click in the box to convert it to a text box"
  canvasMouseDown (50,50)
  canvasMouseUp (50,50)
  verifyMostRecentlyCreatedBoxHasText (Just "")

  setMarker "write some text"
  pressKeys "meow meow meow meow"
  verifyMostRecentlyCreatedBoxHasText (Just "meow meow meow meow")


spec :: Spec
spec = do
  describe "Box" $ do
    describe "basic" $ basic_test
    describe "basic_cancel" $ basic_cancel_test
    describe "constrainDeltaLBox" $ constrainDeltaLBox_test
    describe "noinvert" $ noinvert_test
    describe "boxtext" $ boxtext_test