sifflet-2.3.0: tests/Testing/Unit/LayoutTests.hs
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