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
textSize :: [Char] -> (Number, Number)
textSize str = (textWidth, sizeOfText)
where
textWidth = charWidth * (FPPrac.length str)
charWidth :: Number
charWidth = 10