tinytools-0.1.0.6: test/Potato/Flow/Methods/LineDrawerSpec.hs

{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Methods.LineDrawerSpec(
  spec
) where

import           Relude           hiding (empty, fromList)

import           Test.Hspec


import Potato.Flow
import           Potato.Flow.Methods.LineDrawer
import           Potato.Flow.TestStates



import Data.Default
import Data.Tuple.Extra

generateTestCases :: [OwlPFState]
generateTestCases = r where

  -- MODIFY THESE TO TEST WHAT YOU NEED TO TEST :O
  --al1s = [AL_Left, AL_Right, AL_Top, AL_Bot, AL_Any]
  --al2s = [AL_Left, AL_Right, AL_Top, AL_Bot, AL_Any]
  al1s = [AL_Bot]
  al2s = [AL_Top]
  box1s = [LBox (V2 0 0) 10]
  box2s = [LBox (V2 0 12) 10]
  canvasbox = LBox (-5) (V2 25 25)


  boxpairs = [(b1,b2) | b1 <- box1s, b2 <- box2s]
  attachmentpairs = [(al1,al2) | al1 <- al1s, al2 <- al2s]



  makestree (b1,b2) (al1, al2) =
    [ (0, SEltLabel "b1" (SEltBox (def {_sBox_box = b1})))
    , (1, SEltLabel "b2" (SEltBox (def {_sBox_box = b2})))
    , (2, SEltLabel "l" (SEltLine (def {
          _sAutoLine_attachStart = Just (attachment_create_default 0 al1), _sAutoLine_attachEnd = Just (attachment_create_default 1 al2)
          , _sAutoLine_lineStyle = LineStyle "" "" "" ""
        })))
    --, (3, SEltLabel "lreverse" (SEltLine (def {_sAutoLine_attachStart = Just (Attachment 1 al2), _sAutoLine_attachEnd = Just (Attachment 0 al1)})))
    ]

  topfs ot = OwlPFState {
      _owlPFState_owlTree = ot
      , _owlPFState_canvas = SCanvas $ canvasbox
    }

  r = [topfs $ owlTree_fromSEltTree (makestree bp ap) | bp <- boxpairs, ap <- attachmentpairs]


validateTransformMe :: (Eq a, TransformMe a) => a -> Bool
validateTransformMe a =
  (transformMe_rotateLeft . transformMe_rotateRight $ a) == a
  && (transformMe_rotateRight . transformMe_rotateLeft $ a) == a
  && (transformMe_reflectHorizontally . transformMe_reflectHorizontally $ a) == a


emptyLineAnchorsForRender :: LineAnchorsForRender
emptyLineAnchorsForRender = LineAnchorsForRender {
    _lineAnchorsForRender_start = V2 (-123) 45
    , _lineAnchorsForRender_rest = []
  }

unsimplifiedLineAnchorsForRender :: LineAnchorsForRender
unsimplifiedLineAnchorsForRender = LineAnchorsForRender {
    _lineAnchorsForRender_start = 0
    , _lineAnchorsForRender_rest = [(CD_Up, 10, True),(CD_Up, 15, False),(CD_Up, 1, False),(CD_Right, 10, False)]
  }

someLineAnchorsForRender :: LineAnchorsForRender
someLineAnchorsForRender = LineAnchorsForRender {
    _lineAnchorsForRender_start = 0
    , _lineAnchorsForRender_rest = [(CD_Up, 10, True),(CD_Right, 15, False),(CD_Down, 1, False),(CD_Left, 10, False)]
  }


someSAutoLine_withLabels_label3 :: SAutoLineLabel
someSAutoLine_withLabels_label3 = SAutoLineLabel 0 (SAutoLineLabelPositionRelative 0) ""

someSAutoLine_withLabels :: SAutoLine
someSAutoLine_withLabels = def {
      _sAutoLine_start = 0
      , _sAutoLine_end = V2 100 0
      , _sAutoLine_midpoints = [SAutoLineConstraintFixed (V2 50 0)]
      , _sAutoLine_labels = [
          SAutoLineLabel 1 (SAutoLineLabelPositionRelative 0) ""
          , SAutoLineLabel 0 (SAutoLineLabelPositionRelative 0.5) ""
          , someSAutoLine_withLabels_label3
        ]
  }


spec :: Spec
spec = do
  describe "Lines - internal" $ do
    it "rotateMe" $ do
      let
        somelbx1 = LBox (V2 12 (-2)) (V2 12323 (143))
        somexy1 :: XY = V2 345 21
      validateTransformMe somelbx1 `shouldBe` True
      validateTransformMe somexy1 `shouldBe` True
    it "determineSeparation" $ do
      let
        lb1 = LBox (V2 0 0) (V2 10 10)
        lb2 = LBox (V2 11 11) (V2 10 10)
      determineSeparation (lb1, (0,0,0,0)) (lb2, (0,0,0,0)) `shouldBe` (True, True)
      determineSeparation (lb1, (2,2,0,0)) (lb2, (0,0,0,0)) `shouldBe` (False, True)
      determineSeparation (lb1, (1,1,1,1)) (lb2, (1,1,1,1)) `shouldBe` (False, False)
    it "lineAnchorsForRender_simplify" $ do
      _lineAnchorsForRender_rest (lineAnchorsForRender_simplify unsimplifiedLineAnchorsForRender) `shouldBe` [(CD_Up, 26, True),(CD_Right, 10, False)]
      lineAnchorsForRender_simplify someLineAnchorsForRender `shouldBe` someLineAnchorsForRender
    it "lineAnchorsForRender_length" $ do
      lineAnchorsForRender_length unsimplifiedLineAnchorsForRender `shouldBe` 36 + 1
      lineAnchorsForRender_length someLineAnchorsForRender `shouldBe` 36 + 1
      lineAnchorsForRender_length emptyLineAnchorsForRender `shouldBe` 1
    it "internal_getSAutoLineLabelPosition_walk" $ do
      let totall = lineAnchorsForRender_length someLineAnchorsForRender
      internal_getSAutoLineLabelPosition_walk someLineAnchorsForRender 0 `shouldBe` 0
      internal_getSAutoLineLabelPosition_walk someLineAnchorsForRender totall `shouldBe` V2 5 (-9)
    it "getSAutoLineLabelPosition" $ do
      -- use owlpfstate_zero OK because there are no attachments so state is never read
      getSAutoLineLabelPosition owlpfstate_zero someSAutoLine_withLabels someSAutoLine_withLabels_label3 `shouldBe` V2 0 0
    it "getSortedSAutoLineLabelPositions" $ do
      -- use owlpfstate_zero OK because there are no attachments so state is never read
      fmap fst3 (getSortedSAutoLineLabelPositions owlpfstate_zero someSAutoLine_withLabels) `shouldBe` [V2 0 0, V2 25 0, V2 50 0]


  describe "Lines - rendering" $ it "autorendercase" $ forM_ generateTestCases $ \_ -> do
    --putTextLn (renderedCanvasToText (potatoRenderPFState pfs))
    True `shouldBe` True

    -- TODO write a test such that reversing start/end parts of lines always renders the same thing
    -- (actually, this won't work because rotation messed with whether we go up/down for midpoint stuff)
    -- (you could fix this by keeping a rotation counter flag of course)