module NameLayout(LName(..),placeNL,spaceNL,modNL,marginNL,sepNL,hvAlignNL,marginHVAlignNL,nullNL,hBoxNL,hBoxNL',vBoxNL, vBoxNL',leafNL, NameLayout, nameF,
 listNF, nameLayoutF) where

--import NonStdTrace(trace)
import LayoutRequest
import NullF
import Spops
--import Command
--import Event
import FRequest
--import Xtypes
import EitherUtils(plookup)
import Data.Maybe(fromJust)
import Fudget
import Path
import Geometry
import Placers
import Spacers
--import Message
import ListF
import Loopthrough
import Cont
--import LayoutDir
import AlignP
--import Alignment
import Utils
import Maptrace
import AutoLayout
import ParF

type LName = String
newtype NameLayout = NL (MLNode LName) -- abstract

-- The layout structure datatype
type MLNode a = (Maybe LayoutRequest, LNode a)
data LNode a = 
      LNode Int Placer (Maybe (Rect -> [Rect])) [MLNode a]
    | LLeaf (LLeaf a) deriving Int -> LNode a -> ShowS
forall a. Show a => Int -> LNode a -> ShowS
forall a. Show a => [LNode a] -> ShowS
forall a. Show a => LNode a -> LName
forall a.
(Int -> a -> ShowS) -> (a -> LName) -> ([a] -> ShowS) -> Show a
showList :: [LNode a] -> ShowS
$cshowList :: forall a. Show a => [LNode a] -> ShowS
show :: LNode a -> LName
$cshow :: forall a. Show a => LNode a -> LName
showsPrec :: Int -> LNode a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> LNode a -> ShowS
Show

data LLeaf a = Name a | Req LayoutRequest deriving Int -> LLeaf a -> ShowS
forall a. Show a => Int -> LLeaf a -> ShowS
forall a. Show a => [LLeaf a] -> ShowS
forall a. Show a => LLeaf a -> LName
forall a.
(Int -> a -> ShowS) -> (a -> LName) -> ([a] -> ShowS) -> Show a
showList :: [LLeaf a] -> ShowS
$cshowList :: forall a. Show a => [LLeaf a] -> ShowS
show :: LLeaf a -> LName
$cshow :: forall a. Show a => LLeaf a -> LName
showsPrec :: Int -> LLeaf a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> LLeaf a -> ShowS
Show

type NPath = [Int]

-----------------------------------------------------------------------------------
-- Exported functions

placeNL :: Placer -> [NameLayout] -> NameLayout
placeNL :: Placer -> [NameLayout] -> NameLayout
placeNL Placer
lter [NameLayout]
ns = let dns :: [MLNode LName]
dns = forall a b. (a -> b) -> [a] -> [b]
map NameLayout -> MLNode LName
deNL [NameLayout]
ns in
   LNode LName -> NameLayout
buildnl forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Placer -> Maybe (Rect -> [Rect]) -> [MLNode a] -> LNode a
LNode (forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter (forall {a}. Maybe a -> Bool
nothingforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) [MLNode LName]
dns)) Placer
lter forall a. Maybe a
Nothing [MLNode LName]
dns

spaceNL :: Spacer -> NameLayout -> NameLayout
spaceNL :: Spacer -> NameLayout -> NameLayout
spaceNL = (Placer -> Placer) -> NameLayout -> NameLayout
modNL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spacer -> Placer -> Placer
spacerP

modNL :: (Placer -> Placer) -> NameLayout -> NameLayout
modNL :: (Placer -> Placer) -> NameLayout -> NameLayout
modNL Placer -> Placer
ltermod (NL (Maybe LayoutRequest
req,LNode LName
n)) = MLNode LName -> NameLayout
NL forall a b. (a -> b) -> a -> b
$ case LNode LName
n of
   LNode Int
i Placer
lter Maybe (Rect -> [Rect])
f [MLNode LName]
ls -> (Maybe LayoutRequest
req,forall a.
Int -> Placer -> Maybe (Rect -> [Rect]) -> [MLNode a] -> LNode a
LNode Int
i (Placer -> Placer
ltermod Placer
lter) Maybe (Rect -> [Rect])
f [MLNode LName]
ls)
   LLeaf LLeaf LName
l -> 
      let lter :: Placer
lter = Placer -> Placer
ltermod Placer
idP
          P Placer1
lter' = Placer
lter in 
      case LLeaf LName
l of
	 Req LayoutRequest
r -> forall a. LayoutRequest -> MLNode a
leafReq forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ Placer1
lter' forall a b. (a -> b) -> a -> b
$ [LayoutRequest
r]
	 LLeaf LName
_ -> (forall a. Maybe a
Nothing,forall a.
Int -> Placer -> Maybe (Rect -> [Rect]) -> [MLNode a] -> LNode a
LNode Int
1 Placer
lter forall a. Maybe a
Nothing [(Maybe LayoutRequest
req,LNode LName
n)])

marginNL :: Int -> NameLayout -> NameLayout
marginNL = Spacer -> NameLayout -> NameLayout
spaceNL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Spacer
marginS
sepNL :: Size -> NameLayout -> NameLayout
sepNL = Spacer -> NameLayout -> NameLayout
spaceNL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size -> Spacer
sepS

hvAlignNL :: Alignment -> Alignment -> NameLayout -> NameLayout
hvAlignNL = Spacer -> NameLayout -> NameLayout
spaceNL forall {t1} {t2} {t3} {t4}.
(t1 -> t2) -> (t3 -> t4 -> t1) -> t3 -> t4 -> t2
`oo` Alignment -> Alignment -> Spacer
hvAlignS
marginHVAlignNL :: Int -> Alignment -> Alignment -> NameLayout -> NameLayout
marginHVAlignNL Int
sep Alignment
ha Alignment
va = Spacer -> NameLayout -> NameLayout
spaceNL (Int -> Alignment -> Alignment -> Spacer
marginHVAlignS Int
sep Alignment
ha Alignment
va)

hBoxNL :: [NameLayout] -> NameLayout
hBoxNL = Placer -> [NameLayout] -> NameLayout
placeNL forall a b. (a -> b) -> a -> b
$ Placer
horizontalP
hBoxNL' :: Int -> [NameLayout] -> NameLayout
hBoxNL' Int
d = Placer -> [NameLayout] -> NameLayout
placeNL forall a b. (a -> b) -> a -> b
$ Int -> Placer
horizontalP' Int
d
vBoxNL :: [NameLayout] -> NameLayout
vBoxNL = Placer -> [NameLayout] -> NameLayout
placeNL forall a b. (a -> b) -> a -> b
$ Placer
verticalP
vBoxNL' :: Int -> [NameLayout] -> NameLayout
vBoxNL' Int
d = Placer -> [NameLayout] -> NameLayout
placeNL forall a b. (a -> b) -> a -> b
$ Int -> Placer
verticalP' Int
d
leafNL :: LName -> NameLayout
leafNL LName
name = LNode LName -> NameLayout
buildnl forall a b. (a -> b) -> a -> b
$ forall a. LLeaf a -> LNode a
LLeaf forall a b. (a -> b) -> a -> b
$ forall a. a -> LLeaf a
Name LName
name
nullNL :: NameLayout
nullNL = MLNode LName -> NameLayout
NL forall a b. (a -> b) -> a -> b
$ forall a. LayoutRequest -> MLNode a
leafReq forall a b. (a -> b) -> a -> b
$ Size -> Bool -> Bool -> LayoutRequest
plainLayout (Int -> Int -> Size
Point Int
1 Int
1) Bool
False Bool
False

nameF :: LName -> F a b -> F a b
nameF :: forall a b. LName -> F a b -> F a b
nameF LName
n = forall {ho} {hi}. Message FRequest ho -> F hi ho -> F hi ho
putMessageFu (forall a b. a -> Message a b
Low (LayoutMessage -> FRequest
LCmd (LName -> LayoutMessage
LayoutName LName
n))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b}. F a b -> F a b
autoLayoutF

-- local

nothing :: Maybe a -> Bool
nothing Maybe a
Nothing = Bool
True
nothing Maybe a
_ = Bool
False

buildnl :: LNode LName -> NameLayout
buildnl :: LNode LName -> NameLayout
buildnl LNode LName
x = MLNode LName -> NameLayout
NL (forall a. Maybe a
Nothing,LNode LName
x)
deNL :: NameLayout -> MLNode LName
deNL (NL MLNode LName
x) = MLNode LName
x

leafReq :: LayoutRequest -> MLNode a
leafReq :: forall a. LayoutRequest -> MLNode a
leafReq LayoutRequest
req = (forall a. a -> Maybe a
Just LayoutRequest
req,forall a. LLeaf a -> LNode a
LLeaf forall a b. (a -> b) -> a -> b
$ forall a. LayoutRequest -> LLeaf a
Req forall a b. (a -> b) -> a -> b
$ LayoutRequest
req)

listNF :: (Eq a, Show a) => [(a, F b c)] -> F (a, b) (a, c)  
listNF :: forall a b c. (Eq a, Show a) => [(a, F b c)] -> F (a, b) (a, c)
listNF [(a, F b c)]
fs = forall a b c. Eq a => [(a, F b c)] -> F (a, b) (a, c)
listF [(a
t, forall a b. LName -> F a b -> F a b
nameF (forall a. Show a => a -> LName
show a
t) F b c
f) | (a
t, F b c
f) <- [(a, F b c)]
fs]

-- The main layout function
nameLayoutF :: NameLayout -> F a b -> F a b
nameLayoutF :: forall a b. NameLayout -> F a b -> F a b
nameLayoutF (NL MLNode LName
ltree) (F FSP a b
fsp) =
    let layoutSP :: SP
  (Either (FCommand a) (Message (Path, FResponse) b))
  (Either (Message (Path, FResponse) b) (FCommand a))
layoutSP =
            forall a b c.
Int
-> [(LName, Path)]
-> Cont (SP (Either (FCommand a) b) c) [(LName, Path)]
getAllPNames (forall a. MLNode a -> Int
countLNames MLNode LName
ltree) [] forall a b. (a -> b) -> a -> b
$ \[(LName, Path)]
pnames ->
            let ([(Path, NPath)]
pathTable, MLNode Path
ltree') = [(LName, Path)]
-> NPath -> MLNode LName -> ([(Path, NPath)], MLNode Path)
rebuildTree [(LName, Path)]
pnames [] MLNode LName
ltree
	    in forall {t :: * -> *} {b} {b}.
Foldable t =>
t (Path, NPath)
-> MLNode Path
-> SP
     (Either (Message (Path, FRequest) b) (Message (Path, FResponse) b))
     (Either (Message (Path, FResponse) b) (Message (Path, FRequest) b))
lSP [(Path, NPath)]
pathTable MLNode Path
ltree'
        lSP :: t (Path, NPath)
-> MLNode Path
-> SP
     (Either (Message (Path, FRequest) b) (Message (Path, FResponse) b))
     (Either (Message (Path, FResponse) b) (Message (Path, FRequest) b))
lSP t (Path, NPath)
pt MLNode Path
ltree = 
            let same :: SP
  (Either (Message (Path, FRequest) b) (Message (Path, FResponse) b))
  (Either (Message (Path, FResponse) b) (Message (Path, FRequest) b))
same = t (Path, NPath)
-> MLNode Path
-> SP
     (Either (Message (Path, FRequest) b) (Message (Path, FResponse) b))
     (Either (Message (Path, FResponse) b) (Message (Path, FRequest) b))
lSP t (Path, NPath)
pt MLNode Path
ltree in
            forall a b. Cont (SP a b) a
getSP forall a b. (a -> b) -> a -> b
$ \Either (Message (Path, FRequest) b) (Message (Path, FResponse) b)
msg ->
	    case Either (Message (Path, FRequest) b) (Message (Path, FResponse) b)
msg of
	      -- A message from the fudget
	      Left (Low (Path
path, LCmd (LayoutRequest LayoutRequest
lr))) ->
		  forall {a1} {a2}. Show a1 => LName -> a1 -> a2 -> a2
ctrace LName
"nameLayoutF" LayoutRequest
lr forall a b. (a -> b) -> a -> b
$
		  let ltree' :: MLNode Path
ltree' = Path -> Maybe NPath -> MLNode Path -> LayoutRequest -> MLNode Path
updateTree Path
path (forall {t :: * -> *} {b2}.
Foldable t =>
t (Path, b2) -> Path -> Maybe b2
pathlookup t (Path, NPath)
pt Path
path) MLNode Path
ltree LayoutRequest
lr
		  in case MLNode Path
ltree' of 
			(Just LayoutRequest
lreq, LNode Path
_) -> --trace (show ltree') $
			    forall b a. b -> SP a b -> SP a b
putSP (forall a b. b -> Either a b
Right (forall a b. a -> Message a b
Low ([], LayoutRequest -> FRequest
layoutRequestCmd LayoutRequest
lreq))) forall a b. (a -> b) -> a -> b
$
			    t (Path, NPath)
-> MLNode Path
-> SP
     (Either (Message (Path, FRequest) b) (Message (Path, FResponse) b))
     (Either (Message (Path, FResponse) b) (Message (Path, FRequest) b))
lSP t (Path, NPath)
pt MLNode Path
ltree'
			MLNode Path
_ -> t (Path, NPath)
-> MLNode Path
-> SP
     (Either (Message (Path, FRequest) b) (Message (Path, FResponse) b))
     (Either (Message (Path, FResponse) b) (Message (Path, FRequest) b))
lSP t (Path, NPath)
pt MLNode Path
ltree'
	      Left Message (Path, FRequest) b
x -> forall b a. b -> SP a b -> SP a b
putSP (forall a b. b -> Either a b
Right Message (Path, FRequest) b
x) forall a b. (a -> b) -> a -> b
$ SP
  (Either (Message (Path, FRequest) b) (Message (Path, FResponse) b))
  (Either (Message (Path, FResponse) b) (Message (Path, FRequest) b))
same
	      -- A message to the fudget
	      Right (Low (Path
path, LEvt (LayoutPlace Rect
r))) ->
		  forall b a. [b] -> SP a b -> SP a b
putsSP (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> Either a b
Leftforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Message a b
Low) forall a b. (a -> b) -> a -> b
$ Rect -> MLNode Path -> [(Path, FResponse)]
traverseTree Rect
r MLNode Path
ltree) forall a b. (a -> b) -> a -> b
$ SP
  (Either (Message (Path, FRequest) b) (Message (Path, FResponse) b))
  (Either (Message (Path, FResponse) b) (Message (Path, FRequest) b))
same
	      Right Message (Path, FResponse) b
x -> forall b a. b -> SP a b -> SP a b
putSP (forall a b. a -> Either a b
Left Message (Path, FResponse) b
x) forall a b. (a -> b) -> a -> b
$ SP
  (Either (Message (Path, FRequest) b) (Message (Path, FResponse) b))
  (Either (Message (Path, FResponse) b) (Message (Path, FRequest) b))
same
    in forall {c} {ho}. F c ho -> F c ho -> F c ho
parF forall {hi} {ho}. F hi ho
nullF forall a b. (a -> b) -> a -> b
$ forall hi ho. FSP hi ho -> F hi ho
F{-ff-} forall a b. (a -> b) -> a -> b
$ forall {a1} {b1} {a2} {b2}.
SP (Either a1 b1) (Either a2 b2) -> SP a2 a1 -> SP b1 b2
loopThroughRightSP forall {a} {b}.
SP
  (Either (FCommand a) (Message (Path, FResponse) b))
  (Either (Message (Path, FResponse) b) (FCommand a))
layoutSP FSP a b
fsp
--  fix for autolayout

-----------------------------------------------------------------------------------
-- Local functions

-- Counts the number of named leafs in a layout structure
countLNames :: MLNode a -> Int
countLNames :: forall a. MLNode a -> Int
countLNames (Maybe LayoutRequest
_, LLeaf (Name a
_)) = Int
1
countLNames (Maybe LayoutRequest
_, LLeaf LLeaf a
_) = Int
0
countLNames (Maybe LayoutRequest
_, LNode Int
_ Placer
_ Maybe (Rect -> [Rect])
_ [(Maybe LayoutRequest, LNode a)]
ns) = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map forall a. MLNode a -> Int
countLNames [(Maybe LayoutRequest, LNode a)]
ns)

-- Traverses the layout structure, returning a mapping from leaf names to paths
getAllPNames :: Int -> [(LName, Path)] -> 
	     Cont (SP (Either (FCommand a) b) c) [(LName,Path)]
getAllPNames :: forall a b c.
Int
-> [(LName, Path)]
-> Cont (SP (Either (FCommand a) b) c) [(LName, Path)]
getAllPNames Int
0 [(LName, Path)]
pnames [(LName, Path)] -> SP (Either (FCommand a) b) c
c = [(LName, Path)] -> SP (Either (FCommand a) b) c
c [(LName, Path)]
pnames
getAllPNames Int
n [(LName, Path)]
pnames [(LName, Path)] -> SP (Either (FCommand a) b) c
c =
    forall {a} {t} {b}. (a -> Maybe t) -> (t -> SP a b) -> SP a b
waitForSP forall {b} {b} {b}.
Either (Message (b, FRequest) b) b -> Maybe (LName, b)
layoutName forall a b. (a -> b) -> a -> b
$ \(LName, Path)
pname ->
    forall a b c.
Int
-> [(LName, Path)]
-> Cont (SP (Either (FCommand a) b) c) [(LName, Path)]
getAllPNames (Int
nforall a. Num a => a -> a -> a
-Int
1) ((LName, Path)
pnameforall a. a -> [a] -> [a]
:[(LName, Path)]
pnames) [(LName, Path)] -> SP (Either (FCommand a) b) c
c
    where layoutName :: Either (Message (b, FRequest) b) b -> Maybe (LName, b)
layoutName (Left (Low (b
path, LCmd (LayoutName LName
name)))) = 
              forall a. a -> Maybe a
Just(LName
name, b
path)
          layoutName Either (Message (b, FRequest) b) b
_ = forall a. Maybe a
Nothing

-- Rebuilds the layout structure. 
-- Returns also a mapping from ordinary paths to number paths.
rebuildTree :: [(LName, Path)] -> NPath -> MLNode LName ->
               ([(Path, NPath)], MLNode Path)
rebuildTree :: [(LName, Path)]
-> NPath -> MLNode LName -> ([(Path, NPath)], MLNode Path)
rebuildTree [(LName, Path)]
pnames NPath
np (Maybe LayoutRequest
_, LLeaf (Name LName
name)) = 
    case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LName
name [(LName, Path)]
pnames of
        Maybe Path
Nothing -> forall a. HasCallStack => LName -> a
error (LName
"Couldn't find name "forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> LName
show LName
name forall a. [a] -> [a] -> [a]
++ 
			  LName
" in (name, path) table.")
	Just Path
path -> ([(Path
path, NPath
np)], (forall a. Maybe a
Nothing, forall a. LLeaf a -> LNode a
LLeaf forall a b. (a -> b) -> a -> b
$ forall a. a -> LLeaf a
Name Path
path))
rebuildTree [(LName, Path)]
pnames NPath
np (Maybe LayoutRequest
_, (LLeaf (Req LayoutRequest
r))) = ([],(forall a. a -> Maybe a
Just LayoutRequest
r, (forall a. LLeaf a -> LNode a
LLeaf (forall a. LayoutRequest -> LLeaf a
Req LayoutRequest
r))))
rebuildTree [(LName, Path)]
pnames NPath
np (Maybe LayoutRequest
_, LNode Int
c Placer
lter Maybe (Rect -> [Rect])
Nothing [MLNode LName]
ns) =
    (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Path, NPath)]]
ts, (forall a. Maybe a
Nothing, forall a.
Int -> Placer -> Maybe (Rect -> [Rect]) -> [MLNode a] -> LNode a
LNode Int
c Placer
lter forall a. Maybe a
Nothing [MLNode Path]
ns'))
    where ([[(Path, NPath)]]
ts, [MLNode Path]
ns') = forall a b. [(a, b)] -> ([a], [b])
unzip (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([(LName, Path)]
-> NPath -> MLNode LName -> ([(Path, NPath)], MLNode Path)
rebuildTree [(LName, Path)]
pnames) 
                                     (forall a b. (a -> b) -> [a] -> [b]
map ((NPath
npforall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])) [Int
1..]) [MLNode LName]
ns)


-- Inserts layout requests in the layout structure.
-- Trigged by some fudget emitting a layout request
updateTree :: Path -> 
              Maybe NPath -> 
	      MLNode Path -> 
	      LayoutRequest -> 
              MLNode Path
updateTree :: Path -> Maybe NPath -> MLNode Path -> LayoutRequest -> MLNode Path
updateTree Path
path Maybe NPath
Nothing MLNode Path
_ LayoutRequest
lr = 
    forall a. HasCallStack => LName -> a
error (LName
"Hmmm. Couldn't find path " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> LName
show Path
path forall a. [a] -> [a] -> [a]
++
    LName
"in updateTree\nSomeone has probably forgotten to name a fudget.")
updateTree Path
path (Just NPath
npath) MLNode Path
lo LayoutRequest
lr = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ NPath -> MLNode Path -> LayoutRequest -> (Bool, MLNode Path)
upd NPath
npath MLNode Path
lo LayoutRequest
lr
    where upd :: NPath -> MLNode Path -> LayoutRequest -> (Bool, MLNode Path)
upd NPath
_ (Maybe LayoutRequest
mlr, LLeaf (Name Path
p)) LayoutRequest
lr = 
                 (forall {a}. Maybe a -> Bool
nothing Maybe LayoutRequest
mlr, (forall a. a -> Maybe a
Just LayoutRequest
lr, forall a. LLeaf a -> LNode a
LLeaf (forall a. a -> LLeaf a
Name Path
path)))
          upd (Int
n:NPath
np) (Maybe LayoutRequest
mlr, LNode Int
c lter :: Placer
lter@(P Placer1
lter') Maybe (Rect -> [Rect])
mr [MLNode Path]
ns) LayoutRequest
lr =
	      let ([MLNode Path]
before, MLNode Path
this:[MLNode Path]
after) = forall a. Int -> [a] -> ([a], [a])
splitAt (Int
nforall a. Num a => a -> a -> a
-Int
1) [MLNode Path]
ns
	          (Bool
ready, MLNode Path
child) = NPath -> MLNode Path -> LayoutRequest -> (Bool, MLNode Path)
upd NPath
np MLNode Path
this LayoutRequest
lr
	          c' :: Int
c' = if Bool
ready then forall a. Ord a => a -> a -> a
max (Int
cforall a. Num a => a -> a -> a
-Int
1) Int
0 else Int
c
		  ns' :: [MLNode Path]
ns' = [MLNode Path]
before forall a. [a] -> [a] -> [a]
++ [MLNode Path
child] forall a. [a] -> [a] -> [a]
++ [MLNode Path]
after
	      in if Int
c' forall a. Eq a => a -> a -> Bool
== Int
0 then
	             let (LayoutRequest
lreq, Rect -> [Rect]
rectf) = Placer1
lter' (forall a b. (a -> b) -> [a] -> [b]
map (forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [MLNode Path]
ns')
		     in (forall {a}. Maybe a -> Bool
nothing Maybe LayoutRequest
mlr, 
		         (forall a. a -> Maybe a
Just LayoutRequest
lreq, forall a.
Int -> Placer -> Maybe (Rect -> [Rect]) -> [MLNode a] -> LNode a
LNode Int
c' Placer
lter (forall a. a -> Maybe a
Just Rect -> [Rect]
rectf) [MLNode Path]
ns'))
		 else
		     (Bool
False, (forall a. Maybe a
Nothing, forall a.
Int -> Placer -> Maybe (Rect -> [Rect]) -> [MLNode a] -> LNode a
LNode Int
c' Placer
lter Maybe (Rect -> [Rect])
mr [MLNode Path]
ns'))
          upd NPath
_ MLNode Path
othernode LayoutRequest
_ = (Bool
False,MLNode Path
othernode)

-- We have got a rectangle. Emit commands to all subfudgets saying how large
-- they should be. 
traverseTree :: Rect -> MLNode Path -> [TEvent]
traverseTree :: Rect -> MLNode Path -> [(Path, FResponse)]
traverseTree Rect
r (Maybe LayoutRequest
_, LLeaf (Name Path
path)) = [(Path
path, LayoutResponse -> FResponse
LEvt forall a b. (a -> b) -> a -> b
$ Rect -> LayoutResponse
LayoutPlace Rect
r)]
traverseTree Rect
r (Maybe LayoutRequest
_, LLeaf LLeaf Path
_) = []
traverseTree Rect
r (Maybe LayoutRequest
_, LNode Int
_ Placer
_ (Just Rect -> [Rect]
rectf) [MLNode Path]
ns) =
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Rect -> MLNode Path -> [(Path, FResponse)]
traverseTree (Rect -> [Rect]
rectf Rect
r) [MLNode Path]
ns) 

pathlookup :: t (Path, b2) -> Path -> Maybe b2
pathlookup t (Path, b2)
table Path
p = forall {t :: * -> *} {b1} {b2}.
Foldable t =>
(b1 -> Bool) -> t (b1, b2) -> Maybe b2
plookup (forall a b c. (a -> b -> c) -> b -> a -> c
flip Path -> Path -> Bool
subPath Path
p) t (Path, b2)
table