module TreeBrowser(Tree(..),treeBrowserF',treeDisplayF') where
import AllFudgets hiding (Tree(..))
import qualified ReactiveF as R

data Tree leaf node
  = Leaf leaf
  | Node node [Tree leaf node]
  deriving (Int -> Tree leaf node -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall leaf node.
(Show leaf, Show node) =>
Int -> Tree leaf node -> ShowS
forall leaf node.
(Show leaf, Show node) =>
[Tree leaf node] -> ShowS
forall leaf node.
(Show leaf, Show node) =>
Tree leaf node -> String
showList :: [Tree leaf node] -> ShowS
$cshowList :: forall leaf node.
(Show leaf, Show node) =>
[Tree leaf node] -> ShowS
show :: Tree leaf node -> String
$cshow :: forall leaf node.
(Show leaf, Show node) =>
Tree leaf node -> String
showsPrec :: Int -> Tree leaf node -> ShowS
$cshowsPrec :: forall leaf node.
(Show leaf, Show node) =>
Int -> Tree leaf node -> ShowS
Show)


--treeBrowserF = treeBrowserF standard

treeDisplayF' :: Tree leaf node -> F (Tree leaf node) (Tree leaf node)
treeDisplayF' Tree leaf node
t = forall {node} {lbl} {lbl} {i} {leaf}.
Graphic node =>
((FlexibleDrawing -> Drawing lbl Gfx,
  FlexibleDrawing -> Drawing lbl Gfx)
 -> i -> Drawing (Either Bool (Tree leaf node)) Gfx)
-> i -> F i (Tree leaf node)
treeBrowserF'' forall {a} {a}.
(Graphic a, Graphic a) =>
(FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx,
 FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx)
-> Tree a a -> Drawing (Either Bool (Tree a a)) Gfx
drawStaticTree Tree leaf node
t
treeBrowserF' :: Tree leaf node -> F (Tree leaf node) (Tree leaf node)
treeBrowserF' Tree leaf node
t = forall {node} {lbl} {lbl} {i} {leaf}.
Graphic node =>
((FlexibleDrawing -> Drawing lbl Gfx,
  FlexibleDrawing -> Drawing lbl Gfx)
 -> i -> Drawing (Either Bool (Tree leaf node)) Gfx)
-> i -> F i (Tree leaf node)
treeBrowserF'' forall {a} {a}.
(Graphic a, Graphic a) =>
(FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx,
 FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx)
-> Tree a a -> Drawing (Either Bool (Tree a a)) Gfx
drawTree Tree leaf node
t

--treeBrowserF' ::Tree n l -> F (Tree n l) ([n],Maybe l)
treeBrowserF'' :: ((FlexibleDrawing -> Drawing lbl Gfx,
  FlexibleDrawing -> Drawing lbl Gfx)
 -> i -> Drawing (Either Bool (Tree leaf node)) Gfx)
-> i -> F i (Tree leaf node)
treeBrowserF'' (FlexibleDrawing -> Drawing lbl Gfx,
 FlexibleDrawing -> Drawing lbl Gfx)
-> i -> Drawing (Either Bool (Tree leaf node)) Gfx
drawTree i
t =
    forall {a1} {f :: * -> * -> *} {a2} {i} {o}.
(ColorGen a1, FudgetIO f, FontGen a2, Show a1, Show a2) =>
GCtx -> [GCAttributes a1 a2] -> (GCtx -> f i o) -> f i o
wCreateGCtx GCtx
rootGCtx (forall c. c -> [GCAttributes c FontSpec]
gcFgA String
linecolor) forall a b. (a -> b) -> a -> b
$ \ GCtx
lgc ->
    forall {a1} {f :: * -> * -> *} {a2} {i} {o}.
(ColorGen a1, FudgetIO f, FontGen a2, Show a1, Show a2) =>
GCtx -> [GCAttributes a1 a2] -> (GCtx -> f i o) -> f i o
wCreateGCtx GCtx
rootGCtx (forall c. c -> [GCAttributes c FontSpec]
gcFgA String
paperColor) forall a b. (a -> b) -> a -> b
$ \ GCtx
bggc ->
    forall {node} {lbl} {lbl} {b} {leaf}.
Graphic node =>
((FlexibleDrawing -> Drawing lbl Gfx,
  FlexibleDrawing -> Drawing lbl Gfx)
 -> b -> Drawing (Either Bool (Tree leaf node)) Gfx)
-> (GCtx, GCtx) -> b -> F b (Tree leaf node)
treeBrowserF''' (FlexibleDrawing -> Drawing lbl Gfx,
 FlexibleDrawing -> Drawing lbl Gfx)
-> i -> Drawing (Either Bool (Tree leaf node)) Gfx
drawTree (GCtx
bggc,GCtx
lgc) i
t


treeBrowserF''' :: ((FlexibleDrawing -> Drawing lbl Gfx,
  FlexibleDrawing -> Drawing lbl Gfx)
 -> b -> Drawing (Either Bool (Tree leaf node)) Gfx)
-> (GCtx, GCtx) -> b -> F b (Tree leaf node)
treeBrowserF''' (FlexibleDrawing -> Drawing lbl Gfx,
 FlexibleDrawing -> Drawing lbl Gfx)
-> b -> Drawing (Either Bool (Tree leaf node)) Gfx
drawTree gcs :: (GCtx, GCtx)
gcs@(GCtx
bggc,GCtx
lgc) b
t =
   forall a b c d. F (Either a b) (Either c d) -> F c a -> F b d
loopThroughRightF (forall {a} {t} {b} {a2}. (a -> ReactionM t b a2) -> t -> F a b
R.reactiveF Either (GfxEvent DPath) b
-> ReactionM
     (Drawing (Either Bool (Tree leaf node)) Gfx)
     (Either
        (GfxCommand DPath (Drawing (Either Bool (Tree leaf node)) Gfx))
        (Tree leaf node))
     ()
ctrl Drawing (Either Bool (Tree leaf node)) Gfx
d0) (forall gfx.
Graphic gfx =>
Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) (GfxEvent DPath)
graphicsDispF' GraphicsF (Drawing (Either Bool (Tree leaf node)) Gfx)
-> GraphicsF (Drawing (Either Bool (Tree leaf node)) Gfx)
pm)
  where
    pm1 :: Graphic a => Customiser (GraphicsF a)
    pm1 :: forall a. Graphic a => Customiser (GraphicsF a)
pm1 = forall {xxx} {p}.
(HasBgColorSpec xxx, Show p, ColorGen p) =>
p -> Customiser xxx
setBgColor String
bgColor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall xxx. HasSizing xxx => Sizing -> Customiser xxx
setSizing Sizing
Dynamic
    pm :: GraphicsF (Drawing (Either Bool (Tree leaf node)) Gfx)
-> GraphicsF (Drawing (Either Bool (Tree leaf node)) Gfx)
pm = forall a. Graphic a => Customiser (GraphicsF a)
pm1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (xxx :: * -> *) a.
HasInitDisp xxx =>
a -> Customiser (xxx a)
setInitDisp Drawing (Either Bool (Tree leaf node)) Gfx
d0
    d0 :: Drawing (Either Bool (Tree leaf node)) Gfx
d0 = (FlexibleDrawing -> Drawing lbl Gfx,
 FlexibleDrawing -> Drawing lbl Gfx)
-> b -> Drawing (Either Bool (Tree leaf node)) Gfx
drawTree forall {lbl} {lbl}.
(FlexibleDrawing -> Drawing lbl Gfx,
 FlexibleDrawing -> Drawing lbl Gfx)
gs b
t
    ctrl :: Either (GfxEvent DPath) b
-> ReactionM
     (Drawing (Either Bool (Tree leaf node)) Gfx)
     (Either
        (GfxCommand DPath (Drawing (Either Bool (Tree leaf node)) Gfx))
        (Tree leaf node))
     ()
ctrl = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {node} {leaf}.
Graphic node =>
GfxEvent DPath
-> ReactionM
     (Drawing (Either Bool (Tree leaf node)) Gfx)
     (Either
        (GfxCommand DPath (Drawing (Either Bool (Tree leaf node)) Gfx))
        (Tree leaf node))
     ()
fromLoop forall {a} {b}.
b
-> ReactionM
     (Drawing (Either Bool (Tree leaf node)) Gfx)
     (Either
        (GfxCommand [a] (Drawing (Either Bool (Tree leaf node)) Gfx)) b)
     ()
fromOutside
      where
	fromOutside :: b
-> ReactionM
     (Drawing (Either Bool (Tree leaf node)) Gfx)
     (Either
        (GfxCommand [a] (Drawing (Either Bool (Tree leaf node)) Gfx)) b)
     ()
fromOutside b
t = do let d :: Drawing (Either Bool (Tree leaf node)) Gfx
d = (FlexibleDrawing -> Drawing lbl Gfx,
 FlexibleDrawing -> Drawing lbl Gfx)
-> b -> Drawing (Either Bool (Tree leaf node)) Gfx
drawTree forall {lbl} {lbl}.
(FlexibleDrawing -> Drawing lbl Gfx,
 FlexibleDrawing -> Drawing lbl Gfx)
gs b
t 
			   forall {s} {o}. s -> ReactionM s o ()
R.set Drawing (Either Bool (Tree leaf node)) Gfx
d
			   forall {o} {s}. o -> ReactionM s o ()
R.put (forall {a} {b}. a -> Either a b
toLoop forall a b. (a -> b) -> a -> b
$ forall {gfx} {a}. gfx -> GfxCommand [a] gfx
replaceAllGfx Drawing (Either Bool (Tree leaf node)) Gfx
d)

	fromLoop :: GfxEvent DPath
-> ReactionM
     (Drawing (Either Bool (Tree leaf node)) Gfx)
     (Either
        (GfxCommand DPath (Drawing (Either Bool (Tree leaf node)) Gfx))
        (Tree leaf node))
     ()
fromLoop GfxEvent DPath
gfxevent =
	  do (DPath
path,Either Bool (Tree leaf node)
lbl) <- forall {b} {leaf} {o}.
GfxEvent DPath -> ReactionM (Drawing b leaf) o (DPath, b)
clickedpart GfxEvent DPath
gfxevent
	     case Either Bool (Tree leaf node)
lbl of
	       Left Bool
vis -> forall {node} {leaf} {b}.
Graphic node =>
DPath
-> Bool
-> ReactionM
     (Drawing (Either Bool (Tree leaf node)) Gfx)
     (Either
        (GfxCommand DPath (Drawing (Either Bool (Tree leaf node)) Gfx)) b)
     ()
toggle DPath
path (Bool -> Bool
not Bool
vis)
	       Right Tree leaf node
part -> forall {o} {s}. o -> ReactionM s o ()
R.put (forall {b} {a}. b -> Either a b
toOutside Tree leaf node
part)

	toggle :: DPath
-> Bool
-> ReactionM
     (Drawing (Either Bool (Tree leaf node)) Gfx)
     (Either
        (GfxCommand DPath (Drawing (Either Bool (Tree leaf node)) Gfx)) b)
     ()
toggle DPath
path Bool
vis =
	  do (DPath
ppath,LabelD rt :: Either Bool (Tree leaf node)
rt@(Right (Node node
n [Tree leaf node]
_))
	                   (ComposedD Int
_ (Drawing (Either Bool (Tree leaf node)) Gfx
_:[Drawing (Either Bool (Tree leaf node)) Gfx]
ds))) <- forall {lbl} {leaf} {o}.
DPath -> ReactionM (Drawing lbl leaf) o (DPath, Drawing lbl leaf)
parentpathpart DPath
path
	     let td' :: Drawing (Either Bool (Tree leaf node)) Gfx
td' = forall lbl leaf. lbl -> Drawing lbl leaf -> Drawing lbl leaf
LabelD Either Bool (Tree leaf node)
rt (forall {a} {b}.
Graphic a =>
(FlexibleDrawing -> Drawing (Either Bool b) Gfx,
 FlexibleDrawing -> Drawing (Either Bool b) Gfx)
-> Bool
-> a
-> [Drawing (Either Bool b) Gfx]
-> Drawing (Either Bool b) Gfx
nodeD forall {lbl} {lbl}.
(FlexibleDrawing -> Drawing lbl Gfx,
 FlexibleDrawing -> Drawing lbl Gfx)
gs Bool
vis node
n [Drawing (Either Bool (Tree leaf node)) Gfx]
ds)
	     forall {t} {o}. (t -> t) -> ReactionM t o ()
R.update forall a b. (a -> b) -> a -> b
$ \ Drawing (Either Bool (Tree leaf node)) Gfx
d -> forall {lbl} {leaf}.
Drawing lbl leaf -> DPath -> Drawing lbl leaf -> Drawing lbl leaf
replacePart Drawing (Either Bool (Tree leaf node)) Gfx
d DPath
ppath Drawing (Either Bool (Tree leaf node)) Gfx
td'
	     forall {o} {s}. o -> ReactionM s o ()
R.put (forall {a} {b}. a -> Either a b
toLoop forall a b. (a -> b) -> a -> b
$ forall {path} {gfx}. path -> gfx -> GfxCommand path gfx
replaceGfx DPath
ppath Drawing (Either Bool (Tree leaf node)) Gfx
td')

    toLoop :: a -> Either a b
toLoop = forall {a} {b}. a -> Either a b
Left
    toOutside :: b -> Either a b
toOutside = forall a b. b -> Either a b
Right

    --gd = softAttribD [GCLineStyle LineOnOffDash] . g
    --gd x = g x
    gl :: FlexibleDrawing -> Drawing lbl Gfx
gl = forall {lbl} {leaf}. GCtx -> Drawing lbl leaf -> Drawing lbl leaf
hardAttribD GCtx
lgc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {lbl}. Graphic a => a -> Drawing lbl Gfx
g
    gbg :: FlexibleDrawing -> Drawing lbl Gfx
gbg = forall {lbl} {leaf}. GCtx -> Drawing lbl leaf -> Drawing lbl leaf
hardAttribD GCtx
bggc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {lbl}. Graphic a => a -> Drawing lbl Gfx
g
    gs :: (FlexibleDrawing -> Drawing lbl Gfx,
 FlexibleDrawing -> Drawing lbl Gfx)
gs = (forall {lbl}. FlexibleDrawing -> Drawing lbl Gfx
gbg,forall {lbl}. FlexibleDrawing -> Drawing lbl Gfx
gl)

clickedpart :: GfxEvent DPath -> ReactionM (Drawing b leaf) o (DPath, b)
clickedpart GfxEvent DPath
gfxevent =
  case GfxEvent DPath
gfxevent of
    GfxButtonEvent{gfxType :: forall path. GfxEvent path -> Pressed
gfxType=Pressed
Pressed, gfxPaths :: forall path. GfxEvent path -> [(path, (Point, Rect))]
gfxPaths=(DPath
path,(Point, Rect)
_):[(DPath, (Point, Rect))]
_} -> forall {b} {leaf} {o}.
DPath -> ReactionM (Drawing b leaf) o (DPath, b)
pathlbl DPath
path
    GfxEvent DPath
_ -> forall {s} {o} {a}. ReactionM s o a
R.rfail

pathlbl :: DPath -> ReactionM (Drawing b leaf) o (DPath, b)
pathlbl DPath
path =
  do (DPath
lpath,LabelD b
lbl Drawing b leaf
_) <- forall {lbl} {leaf} {o}.
DPath -> ReactionM (Drawing lbl leaf) o (DPath, Drawing lbl leaf)
pathpart DPath
path
     forall (m :: * -> *) a. Monad m => a -> m a
return (DPath
lpath,b
lbl)

pathpart :: DPath -> ReactionM (Drawing lbl leaf) o (DPath, Drawing lbl leaf)
pathpart DPath
path =
  do Drawing lbl leaf
drawing <- forall {a} {o}. ReactionM a o a
R.get
     let lpath :: DPath
lpath = forall {t} {leaf}. Drawing t leaf -> DPath -> DPath
drawingAnnotPart Drawing lbl leaf
drawing DPath
path
     Drawing lbl leaf
part <- forall {a} {s} {o}. Maybe a -> ReactionM s o a
R.lift forall a b. (a -> b) -> a -> b
$ forall {lbl} {leaf}.
Drawing lbl leaf -> DPath -> Maybe (Drawing lbl leaf)
maybeDrawingPart Drawing lbl leaf
drawing DPath
lpath
     forall (m :: * -> *) a. Monad m => a -> m a
return (DPath
lpath,Drawing lbl leaf
part)

parentpathpart :: DPath -> ReactionM (Drawing lbl leaf) o (DPath, Drawing lbl leaf)
parentpathpart = forall {lbl} {leaf} {o}.
DPath -> ReactionM (Drawing lbl leaf) o (DPath, Drawing lbl leaf)
pathpart forall b c a. (b -> c) -> (a -> b) -> a -> c
. DPath -> DPath
up

drawStaticTree :: (FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx,
 FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx)
-> Tree a a -> Drawing (Either Bool (Tree a a)) Gfx
drawStaticTree (FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx,
 FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx)
gs Tree a a
t = forall {lbl} {leaf}. Placer -> Drawing lbl leaf -> Drawing lbl leaf
placedD (Int -> Placer
verticalLeftP' Int
0) forall a b. (a -> b) -> a -> b
$ forall {a} {a} {b}.
(Graphic a, Graphic a, Ord b, Num b) =>
(FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx,
 FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx)
-> Maybe b -> Tree a a -> Drawing (Either Bool (Tree a a)) Gfx
drawTree' (FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx,
 FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx)
gs forall a. Maybe a
Nothing Tree a a
t
drawTree :: (FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx,
 FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx)
-> Tree a a -> Drawing (Either Bool (Tree a a)) Gfx
drawTree (FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx,
 FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx)
gs Tree a a
t = forall {lbl} {leaf}. Placer -> Drawing lbl leaf -> Drawing lbl leaf
placedD (Int -> Placer
verticalLeftP' Int
0) forall a b. (a -> b) -> a -> b
$ forall {a} {a} {b}.
(Graphic a, Graphic a, Ord b, Num b) =>
(FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx,
 FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx)
-> Maybe b -> Tree a a -> Drawing (Either Bool (Tree a a)) Gfx
drawTree' (FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx,
 FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx)
gs Maybe Int
opendepthlimit Tree a a
t

staticNodeD :: (FlexibleDrawing -> Drawing lbl Gfx,
 FlexibleDrawing -> Drawing lbl Gfx)
-> a -> [Drawing lbl Gfx] -> Drawing lbl Gfx
staticNodeD (FlexibleDrawing -> Drawing lbl Gfx,
 FlexibleDrawing -> Drawing lbl Gfx)
gs a
n [Drawing lbl Gfx]
ds = forall {lbl} {leaf}. [Drawing lbl leaf] -> Drawing lbl leaf
boxD (forall {lbl} {leaf}. Int -> [Drawing lbl leaf] -> Drawing lbl leaf
hboxD' Int
0 [forall {lbl} {leaf}.
Int
-> (FlexibleDrawing -> Drawing lbl leaf,
    FlexibleDrawing -> Drawing lbl leaf)
-> Drawing lbl leaf
-> Drawing lbl leaf
sframeD Int
3 (FlexibleDrawing -> Drawing lbl Gfx,
 FlexibleDrawing -> Drawing lbl Gfx)
gs (forall {a} {lbl}. Graphic a => a -> Drawing lbl Gfx
g a
n)]forall a. a -> [a] -> [a]
:[Drawing lbl Gfx]
ds)

nodeD :: (FlexibleDrawing -> Drawing (Either Bool b) Gfx,
 FlexibleDrawing -> Drawing (Either Bool b) Gfx)
-> Bool
-> a
-> [Drawing (Either Bool b) Gfx]
-> Drawing (Either Bool b) Gfx
nodeD gs :: (FlexibleDrawing -> Drawing (Either Bool b) Gfx,
 FlexibleDrawing -> Drawing (Either Bool b) Gfx)
gs@(FlexibleDrawing -> Drawing (Either Bool b) Gfx
gbg,FlexibleDrawing -> Drawing (Either Bool b) Gfx
gl) Bool
vis a
n [Drawing (Either Bool b) Gfx]
ds =
    forall {lbl} {leaf}. Int -> [Drawing lbl leaf] -> Drawing lbl leaf
boxVisibleD Int
vcnt (forall {lbl} {leaf}. Int -> [Drawing lbl leaf] -> Drawing lbl leaf
hboxD' Int
0 [forall {lbl} {leaf}.
Int
-> (FlexibleDrawing -> Drawing lbl leaf,
    FlexibleDrawing -> Drawing lbl leaf)
-> Drawing lbl leaf
-> Drawing lbl leaf
sframeD Int
3 (FlexibleDrawing -> Drawing (Either Bool b) Gfx,
 FlexibleDrawing -> Drawing (Either Bool b) Gfx)
gs (forall {a} {lbl}. Graphic a => a -> Drawing lbl Gfx
g a
n),FlexibleDrawing -> Drawing (Either Bool b) Gfx
gl FlexibleDrawing
hLineFD,Drawing (Either Bool b) Gfx
markD]forall a. a -> [a] -> [a]
:[Drawing (Either Bool b) Gfx]
ds)
  where
    vcnt :: Int
vcnt = Int
1forall a. Num a => a -> a -> a
+(if Bool
vis then forall (t :: * -> *) a. Foldable t => t a -> Int
length [Drawing (Either Bool b) Gfx]
ds else Int
0)
    markD :: Drawing (Either Bool b) Gfx
markD = forall lbl leaf. lbl -> Drawing lbl leaf -> Drawing lbl leaf
labelD (forall {a} {b}. a -> Either a b
Left Bool
vis) forall a b. (a -> b) -> a -> b
$ Drawing (Either Bool b) Gfx -> Drawing (Either Bool b) Gfx
circleD (if Bool
vis then forall {a} {lbl}. Graphic a => a -> Drawing lbl Gfx
g String
"-" else forall {a} {lbl}. Graphic a => a -> Drawing lbl Gfx
g String
"+")

    circleD :: Drawing (Either Bool b) Gfx -> Drawing (Either Bool b) Gfx
circleD Drawing (Either Bool b) Gfx
d =
        forall {lbl} {leaf}. Spacer -> Drawing lbl leaf -> Drawing lbl leaf
spacedD Spacer
centerS forall a b. (a -> b) -> a -> b
$
	forall {lbl} {leaf}. [Drawing lbl leaf] -> Drawing lbl leaf
stackD [FlexibleDrawing -> Drawing (Either Bool b) Gfx
gbg FlexibleDrawing
filledEllipse,FlexibleDrawing -> Drawing (Either Bool b) Gfx
gl FlexibleDrawing
ellipse,forall {lbl} {leaf}. Spacer -> Drawing lbl leaf -> Drawing lbl leaf
spacedD Spacer
sqpadS Drawing (Either Bool b) Gfx
d]
      where sqpadS :: Spacer
sqpadS  = (Point -> Point) -> Spacer
resizeS Point -> Point
sq Spacer -> Spacer -> Spacer
`compS` Spacer
centerS
	    sq :: Point -> Point
sq (Point Int
w Int
h) = Int -> Int -> Point
Point Int
m Int
m where m :: Int
m = forall a. Ord a => a -> a -> a
max Int
w Int
h

sframeD :: Int
-> (FlexibleDrawing -> Drawing lbl leaf,
    FlexibleDrawing -> Drawing lbl leaf)
-> Drawing lbl leaf
-> Drawing lbl leaf
sframeD Int
sep (FlexibleDrawing -> Drawing lbl leaf,
 FlexibleDrawing -> Drawing lbl leaf)
gs Drawing lbl leaf
d = forall {lbl} {leaf}. Spacer -> Drawing lbl leaf -> Drawing lbl leaf
spacedD (Int -> Int -> Spacer
vMarginS Int
sep Int
0) forall a b. (a -> b) -> a -> b
$ forall {lbl} {leaf}.
(FlexibleDrawing -> Drawing lbl leaf,
 FlexibleDrawing -> Drawing lbl leaf)
-> Drawing lbl leaf -> Drawing lbl leaf
frameD (FlexibleDrawing -> Drawing lbl leaf,
 FlexibleDrawing -> Drawing lbl leaf)
gs Drawing lbl leaf
d

frameD :: (FlexibleDrawing -> Drawing lbl leaf,
 FlexibleDrawing -> Drawing lbl leaf)
-> Drawing lbl leaf -> Drawing lbl leaf
frameD (FlexibleDrawing -> Drawing lbl leaf
gbg,FlexibleDrawing -> Drawing lbl leaf
gl) Drawing lbl leaf
d =
   forall {lbl} {leaf}. [Drawing lbl leaf] -> Drawing lbl leaf
stackD [FlexibleDrawing -> Drawing lbl leaf
gbg forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Int -> FlexibleDrawing
filler Bool
False Bool
False Int
1,FlexibleDrawing -> Drawing lbl leaf
gl FlexibleDrawing
frame,forall {lbl} {leaf}. Int -> Drawing lbl leaf -> Drawing lbl leaf
padD Int
2 Drawing lbl leaf
d]


nodeD' :: (FlexibleDrawing -> Drawing (Either Bool b) Gfx,
 FlexibleDrawing -> Drawing (Either Bool b) Gfx)
-> Maybe a
-> a
-> [Drawing (Either Bool b) Gfx]
-> Drawing (Either Bool b) Gfx
nodeD' (FlexibleDrawing -> Drawing (Either Bool b) Gfx,
 FlexibleDrawing -> Drawing (Either Bool b) Gfx)
gs Maybe a
Nothing = forall {a} {lbl}.
Graphic a =>
(FlexibleDrawing -> Drawing lbl Gfx,
 FlexibleDrawing -> Drawing lbl Gfx)
-> a -> [Drawing lbl Gfx] -> Drawing lbl Gfx
staticNodeD (FlexibleDrawing -> Drawing (Either Bool b) Gfx,
 FlexibleDrawing -> Drawing (Either Bool b) Gfx)
gs
nodeD' (FlexibleDrawing -> Drawing (Either Bool b) Gfx,
 FlexibleDrawing -> Drawing (Either Bool b) Gfx)
gs (Just a
d) = forall {a} {b}.
Graphic a =>
(FlexibleDrawing -> Drawing (Either Bool b) Gfx,
 FlexibleDrawing -> Drawing (Either Bool b) Gfx)
-> Bool
-> a
-> [Drawing (Either Bool b) Gfx]
-> Drawing (Either Bool b) Gfx
nodeD (FlexibleDrawing -> Drawing (Either Bool b) Gfx,
 FlexibleDrawing -> Drawing (Either Bool b) Gfx)
gs (a
dforall a. Ord a => a -> a -> Bool
>a
0)

drawTree' :: (FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx,
 FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx)
-> Maybe b -> Tree a a -> Drawing (Either Bool (Tree a a)) Gfx
drawTree' gs :: (FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx,
 FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx)
gs@(FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx
_,FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx
gl) Maybe b
depth Tree a a
t =
    forall {lbl} {leaf}. Spacer -> Drawing lbl leaf -> Drawing lbl leaf
spacedD Spacer
leftS forall a b. (a -> b) -> a -> b
$
    forall lbl leaf. lbl -> Drawing lbl leaf -> Drawing lbl leaf
labelD (forall a b. b -> Either a b
Right Tree a a
t) forall a b. (a -> b) -> a -> b
$
    case Tree a a
t of
      Leaf a
l -> --hboxD' 0 [gl hLineFD,frameD gs $ g l]
		forall {lbl} {leaf}.
Int
-> (FlexibleDrawing -> Drawing lbl leaf,
    FlexibleDrawing -> Drawing lbl leaf)
-> Drawing lbl leaf
-> Drawing lbl leaf
sframeD Int
1 (FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx,
 FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx)
gs forall a b. (a -> b) -> a -> b
$ forall {a} {lbl}. Graphic a => a -> Drawing lbl Gfx
g a
l
      Node a
n [Tree a a]
ts -> forall {a} {a} {b}.
(Graphic a, Ord a, Num a) =>
(FlexibleDrawing -> Drawing (Either Bool b) Gfx,
 FlexibleDrawing -> Drawing (Either Bool b) Gfx)
-> Maybe a
-> a
-> [Drawing (Either Bool b) Gfx]
-> Drawing (Either Bool b) Gfx
nodeD' (FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx,
 FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx)
gs Maybe b
depth a
n [(FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx,
 FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx)
-> Maybe b -> [Tree a a] -> Drawing (Either Bool (Tree a a)) Gfx
drawTrees (FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx,
 FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx)
gs (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
+(-b
1)) Maybe b
depth) [Tree a a]
ts]

drawTrees :: (FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx,
 FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx)
-> Maybe b -> [Tree a a] -> Drawing (Either Bool (Tree a a)) Gfx
drawTrees gs :: (FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx,
 FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx)
gs@(FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx
_,FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx
gl) Maybe b
depth [Tree a a]
ts = forall {lbl} {leaf}. Int -> [Drawing lbl leaf] -> Drawing lbl leaf
vboxlD' Int
0 forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}.
(Eq a, Num a) =>
a -> Tree a a -> Drawing (Either Bool (Tree a a)) Gfx
drawSubTree [Int
nforall a. Num a => a -> a -> a
-Int
1,Int
nforall a. Num a => a -> a -> a
-Int
2..Int
0] [Tree a a]
ts
  where
    n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tree a a]
ts
    drawSubTree :: a -> Tree a a -> Drawing (Either Bool (Tree a a)) Gfx
drawSubTree a
i Tree a a
t = forall {lbl} {leaf}. Placer -> Drawing lbl leaf -> Drawing lbl leaf
placedD (Int -> LayoutDir -> Int -> Placer
tableP' Int
2 LayoutDir
Vertical Int
0) forall a b. (a -> b) -> a -> b
$
		      forall {lbl} {leaf}. [Drawing lbl leaf] -> Drawing lbl leaf
boxD [forall {a}.
(Eq a, Num a) =>
a -> Drawing (Either Bool (Tree a a)) Gfx
fork a
i,forall {a}.
(Eq a, Num a) =>
a -> Drawing (Either Bool (Tree a a)) Gfx
line a
i,(FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx,
 FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx)
-> Maybe b -> Tree a a -> Drawing (Either Bool (Tree a a)) Gfx
drawTree' (FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx,
 FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx)
gs Maybe b
depth Tree a a
t]
    --drawSubTree i t = hboxD' 0 [fork i,drawTree' gs depth t]
    fork :: a -> Drawing (Either Bool (Tree a a)) Gfx
fork a
0 = FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx
gl FlexibleDrawing
lowerRightFD
    fork a
_ = FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx
gl FlexibleDrawing
forkRightFD
    line :: a -> Drawing (Either Bool (Tree a a)) Gfx
line a
0 = forall {lbl}. Point -> Drawing lbl Gfx
blankD Point
0
    line a
_ = FlexibleDrawing -> Drawing (Either Bool (Tree a a)) Gfx
gl FlexibleDrawing
vLineFD


---

lowerRightFD :: FlexibleDrawing
lowerRightFD = Point -> (Rect -> [DrawCommand]) -> FlexibleDrawing
flex' (Int -> Int -> Point
pP Int
14 Int
10) Rect -> [DrawCommand]
f
  where f :: Rect -> [DrawCommand]
f (Rect Point
p Point
s) =
	    [CoordMode -> [Point] -> DrawCommand
DrawLines CoordMode
CoordModePrevious [Point
pforall a. Num a => a -> a -> a
+Int -> Int -> Point
pP Int
mw Int
0,Int -> Int -> Point
pP Int
0 Int
mh,Int -> Int -> Point
pP Int
mw Int
0]]
	  where Point Int
mw Int
mh = Rect -> Point
rectMiddle (Point -> Point -> Rect
Rect Point
0 Point
s)

forkRightFD :: FlexibleDrawing
forkRightFD = Point -> (Rect -> [DrawCommand]) -> FlexibleDrawing
flex' (Int -> Int -> Point
pP Int
14 Int
10) Rect -> [DrawCommand]
f
  where f :: Rect -> [DrawCommand]
f (Rect Point
p s :: Point
s@(Point Int
w Int
h)) =
	    [Line -> DrawCommand
DrawLine (Point -> Point -> Line
Line (Point
pforall a. Num a => a -> a -> a
+Int -> Int -> Point
pP Int
mw Int
0) (Point
pforall a. Num a => a -> a -> a
+Int -> Int -> Point
pP Int
mw Int
h)),
	     Line -> DrawCommand
DrawLine (Point -> Point -> Line
Line (Point
pforall a. Num a => a -> a -> a
+Point
m) (Point
pforall a. Num a => a -> a -> a
+Int -> Int -> Point
pP Int
w Int
mh))]
	  where m :: Point
m@(Point Int
mw Int
mh) = Rect -> Point
rectMiddle (Point -> Point -> Rect
Rect Point
0 Point
s)

vLineFD :: FlexibleDrawing
vLineFD = Point -> (Rect -> [DrawCommand]) -> FlexibleDrawing
flex' (Int -> Int -> Point
pP Int
10 Int
1) Rect -> [DrawCommand]
f
  where f :: Rect -> [DrawCommand]
f (Rect Point
p s :: Point
s@(Point Int
_ Int
h)) = [Line -> DrawCommand
DrawLine (Point -> Point -> Line
Line (Point
pforall a. Num a => a -> a -> a
+Int -> Int -> Point
pP Int
mw Int
0) (Point
pforall a. Num a => a -> a -> a
+Int -> Int -> Point
pP Int
mw Int
h))]
	  where Point Int
mw Int
_ = Rect -> Point
rectMiddle (Point -> Point -> Rect
Rect Point
0 Point
s)

hLineFD :: FlexibleDrawing
hLineFD = Point -> (Rect -> [DrawCommand]) -> FlexibleDrawing
flex' Point
10 Rect -> [DrawCommand]
f
  where f :: Rect -> [DrawCommand]
f (Rect Point
p s :: Point
s@(Point Int
w Int
_)) = [Line -> DrawCommand
DrawLine (Point -> Point -> Line
Line (Point
pforall a. Num a => a -> a -> a
+Int -> Int -> Point
pP Int
0 Int
mh) (Point
pforall a. Num a => a -> a -> a
+Int -> Int -> Point
pP Int
w Int
mh))]
	  where Point Int
_ Int
mh = Rect -> Point
rectMiddle (Point -> Point -> Rect
Rect Point
0 Point
s)

linecolor :: String
linecolor = String -> ShowS
argKey String
"linecolor" String
"blue"
opendepthlimit :: Maybe Int
opendepthlimit = forall {p}. (Read p, Show p) => String -> p -> p
argReadKey String
"opendepthlimit" (forall a. a -> Maybe a
Just Int
opendepth) -- not a good name
opendepth :: Int
opendepth = forall {p}. (Read p, Show p) => String -> p -> p
argReadKey String
"opendepth" Int
1::Int