module Data.Tree.Draw where

import           Data.Ext
import           Data.Geometry.LineSegment
import           Data.Geometry.Point
import           Data.Geometry.Ipe
import           Data.Tree

--------------------------------------------------------------------------------

-- | Draws a tree
drawTree' :: IpeOut (Tree (Point 2 r :+ p)) Group r
drawTree' :: IpeOut (Tree (Point 2 r :+ p)) Group r
drawTree' = [IpeObject r]
-> Group r
   :+ Attributes
        (AttrMapSym1 r) '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Clip]
forall (f :: * -> *) r.
Foldable f =>
IpeOut (f (IpeObject r)) Group r
ipeGroup ([IpeObject r]
 -> Group r
    :+ Attributes
         (AttrMapSym1 r) '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Clip])
-> (Tree (Point 2 r :+ p) -> [IpeObject r])
-> Tree (Point 2 r :+ p)
-> Group r
   :+ Attributes
        (AttrMapSym1 r) '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Clip]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Point 2 r :+ p, Point 2 r :+ p) -> IpeObject r)
-> [(Point 2 r :+ p, Point 2 r :+ p)] -> [IpeObject r]
forall a b. (a -> b) -> [a] -> [b]
map ((Path r
 :+ Attributes
      (AttrMapSym1 r)
      '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
         'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow, 'Opacity,
         'Tiling, 'Gradient])
-> IpeObject r
forall (i :: * -> *) r. ToObject i => IpeObject' i r -> IpeObject r
iO ((Path r
  :+ Attributes
       (AttrMapSym1 r)
       '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
          'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow, 'Opacity,
          'Tiling, 'Gradient])
 -> IpeObject r)
-> ((Point 2 r :+ p, Point 2 r :+ p)
    -> Path r
       :+ Attributes
            (AttrMapSym1 r)
            '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
               'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow, 'Opacity,
               'Tiling, 'Gradient])
-> (Point 2 r :+ p, Point 2 r :+ p)
-> IpeObject r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineSegment 2 p r
-> Path r
   :+ Attributes
        (AttrMapSym1 r)
        '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
           'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow, 'Opacity,
           'Tiling, 'Gradient]
forall g.
HasDefaultIpeOut g =>
IpeOut g (DefaultIpeOut g) (NumType g)
defIO  (LineSegment 2 p r
 -> Path r
    :+ Attributes
         (AttrMapSym1 r)
         '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
            'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow, 'Opacity,
            'Tiling, 'Gradient])
-> ((Point 2 r :+ p, Point 2 r :+ p) -> LineSegment 2 p r)
-> (Point 2 r :+ p, Point 2 r :+ p)
-> Path r
   :+ Attributes
        (AttrMapSym1 r)
        '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
           'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow, 'Opacity,
           'Tiling, 'Gradient]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r)
-> (Point 2 r :+ p, Point 2 r :+ p) -> LineSegment 2 p r
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment) ([(Point 2 r :+ p, Point 2 r :+ p)] -> [IpeObject r])
-> (Tree (Point 2 r :+ p) -> [(Point 2 r :+ p, Point 2 r :+ p)])
-> Tree (Point 2 r :+ p)
-> [IpeObject r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (Point 2 r :+ p) -> [(Point 2 r :+ p, Point 2 r :+ p)]
forall a. Tree a -> [(a, a)]
treeEdges


treeEdges              :: Tree a -> [(a,a)]
treeEdges :: Tree a -> [(a, a)]
treeEdges (Node a
v Forest a
chs) = (Tree a -> (a, a)) -> Forest a -> [(a, a)]
forall a b. (a -> b) -> [a] -> [b]
map ((a
v,) (a -> (a, a)) -> (Tree a -> a) -> Tree a -> (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> a
forall a. Tree a -> a
rootLabel) Forest a
chs [(a, a)] -> [(a, a)] -> [(a, a)]
forall a. [a] -> [a] -> [a]
++ (Tree a -> [(a, a)]) -> Forest a -> [(a, a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree a -> [(a, a)]
forall a. Tree a -> [(a, a)]
treeEdges Forest a
chs