{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
module Eventloop.Utility.Trees.GeneralTree where
import GHC.Generics (Generic)
import Control.DeepSeq
import Eventloop.Module.BasicShapes.Types
import Eventloop.Utility.Vectors
import Eventloop.Utility.Trees.LayoutTree
data GeneralTree = GeneralTreeBox [GeneralNodeContent] [(GeneralLine, GeneralTree)]
deriving (Show, Eq, Generic, NFData)
data GeneralNodeContent = GeneralNodeText FillColor String
| GeneralNode FillColor Radius
deriving (Show, Eq, Generic, NFData)
data GeneralLine = GeneralLine StrokeColor
deriving (Show, Eq, Generic, NFData)
type LeftOffset = X
type TopOffset = Y
type RightOffset = X
type BottomOffset = Y
type Middle = GraphicalNumeric
type Pos = (X, Y)
class GeneralizeTree a where
generalizeTree :: a -> GeneralTree
instance GeneralizeTree GeneralTree where
generalizeTree a = a
textFont = "Courier"
textHeight = 16 :: Float
charWidth = 10 :: Float
marginBetweenTrees = 10 :: Float
marginBetweenNodeContent = 2 :: Float
marginBetweenNodeRows = 20 :: Float
marginBetweenNodeColumns = 20 :: Float
generalNodeDimension :: GeneralTree -> Dimensions
generalNodeDimension (GeneralTreeBox content _) = flattenDimensions contentDimensions
where
contentDimensions = map generalNodeContentDimension content
flattenDimensions :: [Dimensions] -> Dimensions
flattenDimensions [] = (0.0,0.0)
flattenDimensions [d] = d
flattenDimensions ((w,h):ds) = (max w wTotal, h + marginBetweenNodeContent + hTotal)
where
(wTotal, hTotal) = flattenDimensions ds
generalNodeContentDimension :: GeneralNodeContent -> Dimensions
generalNodeContentDimension (GeneralNodeText _ str) = textSize str
generalNodeContentDimension (GeneralNode _ r ) = (2*r, 2*r)
layoutGeneralTree :: LeftOffset -> TopOffset -> GeneralTree -> (LayoutTree, RightOffset, BottomOffset)
layoutGeneralTree leftOffset topOffset box@(GeneralTreeBox content children) = (LBox (Point (x, y)) topConnect bottomConnect lcs lchildrenWithLines, rightOffset, bottomOffsetChildren)
where
x = leftBorder
y = topOffset
middle = (rightOffset - leftOffset) / 2 + leftOffset
rightOffset = max rightOffsetChildren (leftOffset + width)
leftBorder = middle - (width / 2)
topConnect = Point (width / 2, 0)
bottomConnect = Point (width / 2, height)
(width, height) = generalNodeDimension box
lcs = layoutGeneralNodeContentList (width / 2) 0 content
(lchildrenWithLines, rightOffsetChildren, bottomOffsetChildren) = layoutGeneralTreeChildren leftOffset (topOffset + marginBetweenNodeRows + height) children
layoutGeneralTreeChildren :: LeftOffset -> TopOffset -> [(GeneralLine, GeneralTree)] -> ([(LayoutLine, LayoutTree)], RightOffset, BottomOffset)
layoutGeneralTreeChildren left top treesWithLines =(zip lLines lTrees, right, bottom)
where
lines = map fst treesWithLines
generalTrees = map snd treesWithLines
lLines = map layoutLine lines
(lTrees, right, bottom) = layoutGeneralTrees left top generalTrees
layoutLine :: GeneralLine -> LayoutLine
layoutLine (GeneralLine color) = LayoutLine color
layoutGeneralTrees :: LeftOffset -> TopOffset -> [GeneralTree] -> ([LayoutTree], RightOffset, BottomOffset)
layoutGeneralTrees left top [] = ([], left, top)
layoutGeneralTrees left top [box] = (\(a,b,c) -> ([a],b,c)) $ layoutGeneralTree left top box
layoutGeneralTrees left top (box:bs) = (lbox:lrest, rightRest, max bottom bottomRest)
where
(lbox, right , bottom) = layoutGeneralTree left top box
(lrest, rightRest, bottomRest) = (layoutGeneralTrees (right + marginBetweenNodeColumns) top bs)
layoutGeneralNodeContentList :: Middle -> Height -> [GeneralNodeContent] -> [LayoutNodeContent]
layoutGeneralNodeContentList _ _ [] = []
layoutGeneralNodeContentList middle height [nc] = [layoutGeneralNodeContent (middle, height) nc]
layoutGeneralNodeContentList middle height (nc:ncs) = lnc:(layoutGeneralNodeContentList middle height' ncs)
where
height' = height + ncHeight + marginBetweenNodeContent
(_, ncHeight) = generalNodeContentDimension nc
lnc = layoutGeneralNodeContent (middle, height) nc
layoutGeneralNodeContent :: Pos -> GeneralNodeContent -> LayoutNodeContent
layoutGeneralNodeContent (middle, top) gnc@(GeneralNodeText color str) = LayoutNodeText color (Point (x,y)) str (textSize str)
where
x = middle
y = top
(w, h) = generalNodeContentDimension gnc
layoutGeneralNodeContent (middle, top) gnc@(GeneralNode color rad) = LayoutNode color (Point (x,y)) rad
where
x = middle
y = top + h/2
(w, h) = generalNodeContentDimension gnc
textSize :: [Char] -> (Float, Float)
textSize str = (textWidth, textHeight)
where
textWidth = charWidth * (fromIntegral (length str))
treeIndex :: Int -> Offset -> (Shape, LeftOffset)
treeIndex i (x, y) = (text, x + wText)
where
iStr = show i
(wText, hText) = textSize iStr
p = Point (x, y)
text = Text iStr "Courier" 20 p AlignLeft (255,75,75, 255) 1 (0,0,0,0) Nothing