module RoseTree(RoseTree(..), showTree, showTreeList) where import FPPrac import EventLoop.Output.Single (outSingle) import EventLoop.Output import EventLoop.CommonTypes data RoseTree = RoseNode String [RoseTree] deriving (Show, Eq) marginBetweenTrees = 10 :: Number showTree :: RoseTree -> IO () showTree t = showTreeList [t] showTreeList :: [RoseTree] -> IO () showTreeList list = outSingle (OutGraphical (Draw (showTreeList' 0 0 0 0 list) "trees")) showTreeList' :: Number -> Number -> Number -> Number -> [RoseTree] -> GObject showTreeList' _ _ _ _ [] = Container [] showTreeList' left top maxBottom i (x:xs) | right <= 1024 = Container (text:gtree:gtrees) | width > 1024 = Container (text:gtree:gtrees) | otherwise = showTreeList' 0 maxBottom' maxBottom' i (x:xs) where maxBottom' = max maxBottom bottom (ltree, right, bottom) = layoutTree left top x gtree = printTree ltree Container gtrees = showTreeList' (right + marginBetweenTrees) top maxBottom' i' xs i' = i + 1 text = treeIndex i (left, top) width = right - left treeIndex :: Number -> Pos -> GObject treeIndex i pos = GObject "treeIndex" (Text (255, 125, 125) 0 (255,75,75) pos 20 "Courier" (show i) False) [] data LayoutTree = LNode LayoutText Pos [LayoutTree] deriving (Show) type LayoutText = (Pos, [Char]) radiusNode = 10 :: Number sizeOfText = 16 :: Number marginLine = 5 :: Number marginBetweenRows = 10 :: Number marginBetweenNodes = 20 :: Number testTree = (RoseNode "h" [(RoseNode "a" []), (RoseNode "a" [(RoseNode "a" [(RoseNode "a" []), (RoseNode "a" [])])]), (RoseNode "a" [])]) exampleTree = RoseNode "z" [ RoseNode "aaa" [ RoseNode "bbb" [ RoseNode "ccc" [], RoseNode "ddd" [] ], RoseNode "" [RoseNode "fff" [], RoseNode "ggg" [], RoseNode "hhh" [] ], RoseNode "iii" [RoseNode "" [] ] ], RoseNode "kkk" [RoseNode "lll" [], RoseNode "mmm" [RoseNode "nnn" [RoseNode "q" [], RoseNode "r" [] ], RoseNode "ooo" [], RoseNode "ppp" [] ] ] ] layoutTree :: Number -> Number -> RoseTree -> (LayoutTree, Number, Number) layoutTree leftBorder topBorder (RoseNode str []) = (lNode, rightBorder, bottom) where lNode = LNode lText (x, yNode) [] lText = layoutText (x, yText) str (widthText, heightText) = textSize str (widthNode, heightNode) = (2 * radiusNode, 2 * radiusNode) totalHeight = heightNode + heightText totalWidth = max widthNode widthText rightBorder = leftBorder + totalWidth bottom = topBorder' + totalHeight middleLine = (rightBorder - leftBorder) / 2 + leftBorder x = middleLine topBorder' = topBorder + marginBetweenRows yNode = topBorder' + radiusNode yText = topBorder' + heightNode + 0.5 * heightText layoutTree leftBorder topBorder (RoseNode str children) = ((LNode ((x', yText), str) (x', yNode) lChildren), rightBorder', bottom) where ((LNode ((_, yText), _) (_, yNode) _), _, _) = layoutTree leftBorder topBorder (RoseNode str []) (lChildren, rightBorder, bottom) = layoutChildren leftBorder (topBorder' + totalHeight) children topBorder' = topBorder + marginBetweenRows (widthText, heightText) = textSize str (widthNode, heightNode) = (2 * radiusNode, 2 * radiusNode) totalHeight = heightNode + heightText totalWidth = max widthNode widthText middleLine = (rightBorder - leftBorder) / 2 + leftBorder x' = middleLine rightBorder' = max rightBorder (leftBorder + totalWidth) layoutChildren :: Number -> Number -> [RoseTree] -> ([LayoutTree], Number, Number) layoutChildren leftBorder topBorder (n:[]) = ([lTree], rightBorder, bottom) where (lTree, rightBorder, bottom) = layoutTree leftBorder topBorder n layoutChildren leftBorder topBorder (n:ns) = ((lTree:ns'), rightestBorder, bottom') where (lTree, rightBorder, bottom1) = layoutTree leftBorder topBorder n (ns', rightestBorder, bottom2) = layoutChildren (rightBorder + marginBetweenNodes) topBorder ns bottom' = max bottom1 bottom2 layoutText :: Pos -> [Char] -> LayoutText layoutText pos str = (pos, str) printTree :: LayoutTree -> GObject printTree (LNode (strPos, str) nPos children) = Container (gChildren ++ gLines ++ [gNode, gText]) where gChildren = map printTree children gNode = printNode nPos gText = printText strPos str gLines = printLines nPos children printLines :: Pos -> [LayoutTree] -> [GObject] printLines _ [] = [] printLines pos ((LNode _ nPos _):ns) = gLine:(printLines pos ns) where gLine = printLine start end start = marginizePosition (marginLine + radiusNode) pos nPos end = marginizePosition (marginLine + radiusNode) nPos pos marginizePosition :: Number -> Pos -> Pos -> Pos marginizePosition margin (xStart, yStart) (xEnd, yEnd) = (xStart', yStart') where xStart' = xStart + fraction * xSize yStart' = yStart + fraction * ySize fraction = margin / size size = sqrt (xSize^2 + ySize^2) xSize = xEnd - xStart ySize = yEnd - yStart printLine :: Pos -> Pos -> GObject printLine start end = GObject "Line" lineP [] where lineP = Line (0,0,0) 1 [start, end] printNode :: Pos -> GObject printNode pos = GObject "Node" nodeOutputP [] where nodeOutputP = Arc (0, 0, 0) 0 (0, 0, 0) pos (round radiusNode) 0 360 printText :: Pos -> [Char] -> GObject printText pos str = GObject "Node Text" textOutputP [] where textOutputP = Text (75, 75, 255) 0 (75, 75, 255) pos sizeOfText "Courier" str True -- (width, height) textSize :: [Char] -> (Number, Number) textSize str = (textWidth, sizeOfText) where textWidth = charWidth * (FPPrac.length str) -- Courier 16px charWidth :: Number charWidth = 10 {- Calibri height 16px charWidth :: Char -> Number charWidth c = case c of 'a' -> 7.509259481 'b' -> 7.509259481 'c' -> 7.509259481 'd' -> 7.509259481 'e' -> 7.509259481 'f' -> 5.65740763 'g' -> 8.435185407 'h' -> 7.509259481 'i' -> 3.805555778 'j' -> 5.65740763 'k' -> 7.509259481 'l' -> 3.342592815 'm' -> 12.13888911 'n' -> 7.509259481 'o' -> 7.509259481 'p' -> 7.509259481 'q' -> 7.509259481 'r' -> 5.65740763 's' -> 6.583333556 't' -> 6.583333556 'u' -> 7.509259481 'v' -> 8.435185407 'w' -> 12.13888911 'x' -> 7.509259481 'y' -> 8.435185407 'z' -> 6.583333556 '0' -> 7.509259481 '1' -> 7.509259481 '2' -> 7.509259481 '3' -> 7.509259481 '4' -> 9.361111333 '5' -> 7.509259481 '6' -> 7.509259481 '7' -> 8.435185407 '8' -> 8.435185407 '9' -> 7.509259481 ' ' -> 5.65740763 _ -> 7.509259481 -}