module Testing.Unit.LayoutTests (tests, runU) where import Graphics.Rendering.Cairo hiding (translate) import Data.Tree as DT import System.Process import Test.HUnit import Data.Sifflet.Geometry import Data.Sifflet.Tree import Data.Sifflet.TreeLayout import Graphics.Rendering.Sifflet.DrawTreeGraph import Text.Sifflet.Repr () import Testing.TestUtil import Testing.Common.TestStyles import Testing.Unit.TreeTests hiding (tests, runU) testStyle :: Style testStyle = styleTest4 -- Is there a way to unify and generalize these, testF and testFIo? testF :: (Repr a, Repr b) => Tree a -> (Tree a -> Tree b) -> IO () testF t f = putTreeR t >> putStrLn "=>" >> putTreeR (f t) testFIo :: (Repr a, Repr b) => Tree a -> (Tree a -> IO (Tree b)) -> IO () testFIo t f = putTreeR t >> putStrLn "=>" >> f t >>= putTreeR treeLayoutAsTree :: TreeLayout e -> Tree (e, BBox, BBox) treeLayoutAsTree (DT.Node (LayoutNode gnode treeBB) sublayouts) = DT.Node (gnodeValue gnode, gnodeNodeBB gnode, treeBB) (map treeLayoutAsTree sublayouts) -- Illegal symbol '.' in type *** -- but this is the type that ghc infers! -- testLo :: forall a. (Repr a, Repr (LayoutNode a)) => -- Tree a -> IO () testLo t = testF t (treeLayout testStyle zeroIoletCounter) -- Illegal symbol '.' in type, *** -- testVi :: forall e. (Show e, Repr e) => -- Tree e -> IO () testVi t = putTree t >> putStrLn "=> tmp.png (type q or Esc to finish)" >> treeWriteImageFile testStyle zeroIoletCounter t "tmp.png" >> system "feh tmp.png" >> return () testNodeSize :: Test testNodeSize = TestCase $ do let gtree = treeGNodes testStyle zeroIoletCounter t2c -- Expected dimensions size = measureText testStyle Size w1' h1' = size "floor" Size w3' h3' = size "mat" Size w5' h5' = size "textile" m = 4.0 -- text margin mm = 2 * m -- Actual tree of GNodes DT.Node (GNode (Name "floor") [TextBox "floor" (BBox _ _ w1 h1) (BBox _ _ w2 h2)] _ _ _) [DT.Node (GNode (Name "mat") [TextBox "mat" (BBox _ _ w3 h3) (BBox _ _ w4 h4)] _ _ _) [], DT.Node (GNode (Name "textile") [TextBox "textile" (BBox _ _ w5 h5) (BBox _ _ w6 h6)] _ _ _) []] = gtree assertEqual "tree GNodes" -- [43, 26, 51, 34, 35, 26, 43, 34, 60, 26, 68, 34] [w1', h1', w1' + mm, h1' + mm, w3', h3', w3' + mm, h3' + mm, w5', h5', w5' + mm, h5' + mm] [w1, h1, w2, h2, w3, h3, w4, h4, w5, h5, w6, h6] -- 44 52 testTextCenter :: Test testTextCenter = let gtree = treeGNodes testStyle zeroIoletCounter t2c (DT.Node (GNode _ [tb1] _ _ _) [DT.Node (GNode _ [tb2] _ _ _) [], DT.Node (GNode _ [tb3] _ _ _) []]) = gtree tb2' = offsetTextBoxCenters (Position 15 20) tb1 tb2 Position cbx cby = tbBoxCenter tb1 Position cbx' cby' = tbBoxCenter tb2' Position ctx cty = tbTextCenter tb1 Position ctx' cty' = tbTextCenter tb2' -- tbCenter is tbBoxCenter; we should get the same xs using tbTextCenter, -- since the text should be horizontally centered in its box, -- but not the same ys, since the y's of text are strange! in assertAll [assertEqual "text box centers 1" (posX (tbCenter tb1)) (posX (tbTextCenter tb1)) , assertEqual "text box centers 2" (posX (tbCenter tb2)) (posX (tbTextCenter tb2)) , assertEqual "text box centers 3" (posX (tbCenter tb3)) (posX (tbTextCenter tb3)) , assertEqual "text box center box offset" (15, 20) (cbx' - cbx, cby' - cby) , assertEqual "text box center text offset" (15, 20) (ctx' - ctx, cty' - cty) ] testTreeSize :: Test testTreeSize = TestCase $ do let t = treeGNodes testStyle zeroIoletCounter t2c assertEqual "tree sizes t2c" CloseEnough (sizeTreeDiff (DT.Node Size {sizeW = 138.0, sizeH = 104.0} [leaf Size {sizeW = 43.0, sizeH = 34.0}, leaf Size {sizeW = 68.0, sizeH = 34.0} ]) (treeSizes testStyle t)) -- | This has to go into the IO monad to call treeLayout. -- How, if at all, can I get it out? Probably not. testLayout :: Test testLayout = let tlo = treeLayout testStyle zeroIoletCounter t2c DT.Node (LayoutNode (GNode _ [TextBox _ bb1 bb2] _ _ _) bb3) [DT.Node (LayoutNode (GNode _ [TextBox _ bb4 bb5] _ _ _) bb6) [], DT.Node (LayoutNode (GNode _ [TextBox _ bb7 bb8] _ _ _) bb9) []] = tlo -- *** Figuring this out from first principles is murderous!! -- -- now calculate some expected values -- mm = 2 * textMargin testStyle -- mx = hpad testStyle -- my = vpad testStyle -- mt = measureText testStyle -- Size w1 h1 = mt "floor" -- (x3, y3) = (mx, my) -- Size w4 h4 = mt "mat" -- (w2, h2) = (w1 + mm, h1 + mm) -- (w5, h5) = (w4 + mm, h4 + mm) -- Size w7 h7 = mt "textile" -- (w8, h8) = (w7 + mm, h7 + mm) -- fullWidth = (w4 + mm) + mx + (w7 + mm) -- fullHeight = (h1 + mm) + my + (h4 + mm) -- bb1' = BBox ? ? w1 h1 -- bb2' = BBox ? ? w2 h2 -- bb3' = BBox mx my fullWidth fullHeight -- bb4' = BBox (mx + mm) ? w4 h4 -- bb5' = BBox mx ? (w4 + mm) (h4 + mm) -- bb6' = bb5' -- bb7' = BBox (mx + w4 + mm + mx) ? w7 h7 -- bb8' = BBox (mx + w4 + mm + mx + mm) ? w8 h8 -- bb9' = bb8' -- in assertAll [assertEqual "tree tlo t2c floor text" CloseEnough (bboxDiff (BBox 74.0 58.5 44.0 26.0) bb1) , assertEqual "tree tlo t2c floor box" CloseEnough (bboxDiff (BBox 70.0 36.0 52.0 34.0) bb2) , assertEqual "tree tlo t2c floor tree" CloseEnough (bboxDiff (BBox 27.0 36.0 138.0 104.0) bb3) , assertEqual "tree tlo t2c mat text" CloseEnough (bboxDiff (BBox 31.0 128.5 35.0 26.0) bb4) , assertEqual "tree tlo t2c mat box" CloseEnough (bboxDiff (BBox 27.0 106.0 43.0 34.0) bb5) , assertEqual "tree tlo t2c mat tree" CloseEnough (bboxDiff (BBox 27.0 106.0 43.0 34.0) bb6) , assertEqual "tree tlo t2c textile text" CloseEnough (bboxDiff (BBox 101.0 128.5 58.0 26.0) bb7) , assertEqual "tree tlo t2c textile box" CloseEnough (bboxDiff (BBox 97.0 106.0 68.0 34.0) bb8) , assertEqual "tree tlo t2c textile tree" CloseEnough (bboxDiff (BBox 97.0 106.0 68.0 34.0) bb9) ] testBBMerge :: Test testBBMerge = assertAll [assertEqual "bbMerge, intersecting" (BBox 0 0 50 120) (bbMerge (BBox 0 0 50 100) (BBox 10 20 30 100)), assertEqual "bbMerge, non-intersecting" (BBox 0 0 130 140) (bbMerge (BBox 0 0 100 100) (BBox 110 110 20 30)), assertEqual "bbMerge, enclosed" (BBox 0 0 200 200) (bbMerge (BBox 0 0 200 200) (BBox 50 50 50 50)), assertEqual "bbMerge, reversed" (BBox 0.0 0.0 200.0 200.0) (bbMerge (BBox 50 50 50 50) (BBox 0 0 200 200)) ] testTranslate :: Test testTranslate = assertAll [assertEqual "translate Position" (Position 110 220) (translate 10 20 (Position 100 200)), assertEqual "translate BBox" (BBox 110 220 50 80) (translate 10 20 (BBox 100 200 50 80))] testCircleIolets :: Test testCircleIolets = let style = style0 {styleIoletRadius = 10} row n = makeIoletsRow style 100 200 n -- row of n iolets in assertAll [assertEqual "iolets, n = 1" [Iolet (Circle (Position 100 200) 10)] (row 1), assertEqual "iolets, n = 3" [Iolet (Circle (Position 80 200) 10), Iolet (Circle (Position 100 200) 10), Iolet (Circle (Position 120 200) 10)] (row 3), assertEqual "iolets, n = 2" [Iolet (Circle (Position 90 200) 10), Iolet (Circle (Position 110 200) 10)] (row 2), assertEqual "circle translate" (Circle (Position 120 280) 50) (translate 20 80 (Circle (Position 100 200) 50)), assertEqual "iolet translate" (Iolet (Circle (Position 30 50) 2)) (translate (-70) 25 (Iolet (Circle (Position 100 25) 2)))] testTreeWindowMargin :: Test testTreeWindowMargin = let styleA = styleTest0 {styleFont = VFont "serif" FontSlantNormal FontWeightNormal 18, lineWidth = 2, textMargin = 18.0, hpad = 27, vpad = 36, exomargin = 0, vtinypad = (4.5, 4.5), styleFramePad = 35} styleB = styleA {exomargin = 10} testTree = Node 1 [Node 2 [], Node 3 []] :: Tree Int nodeTextBB :: LayoutNode Int -> BBox nodeTextBB = tbTextBB . head . gnodeTextBoxes . nodeGNode node1 :: Tree (LayoutNode Int) -> LayoutNode Int node1 = rootLabel node3 :: Tree (LayoutNode Int) -> LayoutNode Int node3 = rootLabel . head . tail . subForest layoutA = treeLayout styleA zeroIoletCounter testTree layoutB = treeLayout styleB zeroIoletCounter testTree in assertAll [ -- Assertions re. root node (node 1) assertEqual "node 1 text bbox A" CloseEnough (bboxDiff (BBox 82 72.5 11 26) (nodeTextBB (node1 layoutA))) , assertEqual "node 1 text bbox B" CloseEnough (bboxDiff (BBox 92 82.5 11 26) (nodeTextBB (node1 layoutB))) , assertEqual "node 1 tree bbox A" CloseEnough (bboxDiff (BBox 27 36 121 160) (nodeTreeBB (node1 layoutA))) , assertEqual "node 1 tree bbox B" CloseEnough (bboxDiff (BBox 27 36 141 180) (nodeTreeBB (node1 layoutB))) , -- Assertions re. root's 2nd child (node 3) assertEqual "node 3 text bbox A" CloseEnough (bboxDiff (BBox 119 170.5 11 26) (nodeTextBB (node3 layoutA))) , assertEqual "node 3 text bbox B" CloseEnough (bboxDiff (BBox 129 180.5 11 26) (nodeTextBB (node3 layoutB))) , assertEqual "node 3 tree bbox A" CloseEnough (bboxDiff (BBox 101 134 47 62) (nodeTreeBB (node3 layoutA))) , assertEqual "node 3 tree bbox B" CloseEnough (bboxDiff (BBox 111 144 47 62) (nodeTreeBB (node3 layoutB))) ] tests :: Test tests = TestList [TestLabel "node size" testNodeSize, TestLabel "text center" testTextCenter, TestLabel "tree sizes" testTreeSize, TestLabel "tlo" testLayout, -- , TestLabel "tree tlo" testLayout' TestLabel "bbmerge" testBBMerge, TestLabel "translate" testTranslate, TestLabel "circles and iolets" testCircleIolets, TestLabel "tree window margin" testTreeWindowMargin ] runU :: IO Counts runU = runTestTT tests