module Eventloop.Module.DrawTrees.DrawTrees where import Eventloop.Module.DrawTrees.Types import Eventloop.Utility.Trees.LayoutTree import Eventloop.Utility.Trees.GeneralTree import Eventloop.Module.BasicShapes.Types import Eventloop.Types.EventTypes defaultDrawTreesModuleConfiguration :: EventloopModuleConfiguration defaultDrawTreesModuleConfiguration = ( EventloopModuleConfiguration drawTreesModuleIdentifier defaultDrawTreesModuleIOState Nothing Nothing Nothing (Just drawTreesPostProcessor) Nothing Nothing ) defaultDrawTreesModuleIOState :: IOState defaultDrawTreesModuleIOState = NoState drawTreesModuleIdentifier :: EventloopModuleIdentifier drawTreesModuleIdentifier = "parseTree" drawTreesPostProcessor :: PostProcessor drawTreesPostProcessor shared iostate (OutDrawTrees (DrawTrees canvasId trees)) = return (shared, iostate, [OutBasicShapes $ DrawShapes canvasId [shapeTrees]]) where shapeTrees = showGeneralTreeList (map generalizeTree trees) drawTreesPostProcessor shared iostate out = return (shared, iostate, [out]) showGeneralTreeList :: [GeneralTree] -> Shape showGeneralTreeList list = showGeneralTreeList' 0 0 0 0 list showGeneralTreeList' :: LeftOffset -> TopOffset -> Float -> Int -> [GeneralTree] -> Shape showGeneralTreeList' _ _ _ _ [] = CompositeShape [] Nothing Nothing showGeneralTreeList' left top maxBottom i (x:xs) | right <= 1024 = CompositeShape (text:gtree:gtrees) Nothing Nothing | width > 1024 = CompositeShape (text:gtree:gtrees) Nothing Nothing | otherwise = showGeneralTreeList' 0 maxBottom' maxBottom' i (x:xs) where maxBottom' = max maxBottom bottom (ltree, right, bottom) = layoutGeneralTree left top x gtree = printTree ltree CompositeShape gtrees _ _ = showGeneralTreeList' (right + marginBetweenTrees) top maxBottom' i' xs i' = i + 1 text = treeIndex i (left, top) width = right - left instance GeneralizeTree Tree where generalizeTree (TRBTree tree) = generalizeTree tree generalizeTree (TRoseTree tree) = generalizeTree tree instance GeneralizeTree RBTree where generalizeTree (RBNode col _ []) = GeneralTreeBox content [] where content = [GeneralNode (nodeColorToFillColor col) 5] generalizeTree (RBNode col str children) = GeneralTreeBox content children'WithLines where content = [GeneralNode (nodeColorToFillColor col) 20, GeneralNodeText (0,0,0, 255) str] children' = map generalizeTree children line = GeneralLine (0,0,0, 255) children'WithLines = zip (repeat line) children' nodeColorToFillColor :: NodeColor -> FillColor nodeColorToFillColor NodeRed = (255, 0, 0, 255) nodeColorToFillColor NodeBlack = (0, 0, 0, 255) nodeColorToFillColor NodeGrey = (125, 125, 125, 255) instance GeneralizeTree RoseTree where generalizeTree (RoseNode str children) = GeneralTreeBox content children'WithLines where content = [GeneralNodeText (0,0,0, 255) str] children'WithLines = zip (repeat line) (map generalizeTree children) line = GeneralLine (0,0,0, 255) rbExampleTree = RBNode NodeBlack "12" [ RBNode NodeRed "11" [ RBNode NodeBlack "16" [ RBNode NodeBlack "" [], RBNode NodeBlack "" [] ], RBNode NodeBlack "24" [RBNode NodeBlack "" [], RBNode NodeBlack "" [] ] ], RBNode NodeRed "13" [RBNode NodeBlack "36" [], RBNode NodeBlack "28" [RBNode NodeRed "36" [RBNode NodeBlack "" [], RBNode NodeBlack "" [] ], RBNode NodeBlack "" [] ] ] ] roseExampleTree = 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" [] ] ] ]