module LayoutSP(layoutMgrF,dynLayoutMgrF) where
--import Command
import Data.List(sortBy)
--import Direction
--import Event
import FRequest
import Fudget
import CompOps((>=^<))
import Geometry(Rect,rR)
import LayoutRequest
import Path(here,showPath{-,Path(..),subPath-})
import Spops
--import EitherUtils(mapMaybe)
--import Utils(number, replace)
import HbcUtils(apFst)
--import Xtypes
--import NonStdTrace(trace)
--import CmdLineEnv(argKey)
import LayoutF(LayoutDirection(..))
import Maptrace(ctrace)

default (Int)

mytrace :: a1 -> a2 -> a2
mytrace a1
x = forall {a1} {a2}. Show a1 => [Char] -> a1 -> a2 -> a2
ctrace [Char]
"layoutftrace" a1
x

layoutMgrF :: Int -> LayoutDirection -> Placer -> F (Path, LayoutMessage) (Path, Rect)
layoutMgrF :: Int
-> LayoutDirection
-> Placer
-> F (Path, LayoutMessage) (Path, Rect)
layoutMgrF Int
fudgetCnt LayoutDirection
dir Placer
lter1 = Int
-> LayoutDirection
-> Placer
-> F (Either (Path, LayoutMessage) (Int, Bool)) (Path, Rect)
dynLayoutMgrF Int
fudgetCnt LayoutDirection
dir Placer
lter1 forall c d e. F c d -> (e -> c) -> F e d
>=^< forall a b. a -> Either a b
Left

dynLayoutMgrF :: Int -> LayoutDirection -> Placer -> F (Either (Path, LayoutMessage) (Int,Bool)) (Path, Rect)
dynLayoutMgrF :: Int
-> LayoutDirection
-> Placer
-> F (Either (Path, LayoutMessage) (Int, Bool)) (Path, Rect)
dynLayoutMgrF Int
fudgetCnt0 LayoutDirection
dir (P Placer1
lter1) = forall hi ho. FSP hi ho -> F hi ho
F{-ff-} forall a b. (a -> b) -> a -> b
$ forall {a} {a}.
(Eq a, Num a) =>
a
-> [(Path, LayoutRequest)]
-> SP
     (Message
        (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
     (Message (Path, FRequest) (Path, Rect))
getNLimits Int
fudgetCnt0 []
  where
   sortTags :: [(Path, b)] -> [(Path, b)]
sortTags = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall {t} {b} {b}.
Ord t =>
LayoutDirection -> (t, b) -> (t, b) -> Ordering
order LayoutDirection
dir)
     where
       order :: LayoutDirection -> (t, b) -> (t, b) -> Ordering
order LayoutDirection
Forward = forall {t} {t} {t} {b} {b}. (t -> t -> t) -> (t, b) -> (t, b) -> t
ofst forall a. Ord a => a -> a -> Ordering
compare
       order LayoutDirection
Backward = forall {t} {t} {t} {b} {b}. (t -> t -> t) -> (t, b) -> (t, b) -> t
ofst (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> a -> Ordering
compare)
       ofst :: (t -> t -> t) -> (t, b) -> (t, b) -> t
ofst t -> t -> t
r (t
x,b
_) (t
y,b
_) = t -> t -> t
r t
x t
y
   getNLimits :: a
-> [(Path, LayoutRequest)]
-> SP
     (Message
        (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
     (Message (Path, FRequest) (Path, Rect))
getNLimits a
0 [(Path, LayoutRequest)]
l = Maybe (Rect, [Rect])
-> [(Path, LayoutRequest)]
-> SP
     (Message
        (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
     (Message (Path, FRequest) (Path, Rect))
doLter1 forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall {b}. [(Path, b)] -> [(Path, b)]
sortTags [(Path, LayoutRequest)]
l
   getNLimits a
n [(Path, LayoutRequest)]
l =
    let same :: SP
  (Message
     (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
  (Message (Path, FRequest) (Path, Rect))
same = a
-> [(Path, LayoutRequest)]
-> SP
     (Message
        (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
     (Message (Path, FRequest) (Path, Rect))
getNLimits a
n [(Path, LayoutRequest)]
l in
    forall a b. Cont (SP a b) a
getSP forall a b. (a -> b) -> a -> b
$ \Message (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool))
msg -> case Message (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool))
msg of
      High (Left (Path
path,LayoutMessage
lmsg)) ->
        case LayoutMessage
lmsg of
	 LayoutRequest LayoutRequest
lr -> a
-> [(Path, LayoutRequest)]
-> SP
     (Message
        (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
     (Message (Path, FRequest) (Path, Rect))
getNLimits (a
nforall a. Num a => a -> a -> a
-a
1) ((Path
path,LayoutRequest
lr)forall a. a -> [a] -> [a]
:[(Path, LayoutRequest)]
l)
	 LayoutMessage
_ -> forall b a. b -> SP a b -> SP a b
putSP (forall a b. a -> Message a b
Low (Path
path,LayoutMessage -> FRequest
LCmd LayoutMessage
lmsg)) SP
  (Message
     (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
  (Message (Path, FRequest) (Path, Rect))
same -- !!!
      High (Right (a
dyn,Bool
created)) ->
        if Bool
created
	then a
-> [(Path, LayoutRequest)]
-> SP
     (Message
        (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
     (Message (Path, FRequest) (Path, Rect))
getNLimits (a
nforall a. Num a => a -> a -> a
+a
1) [(Path, LayoutRequest)]
l
	else forall {a1} {a2}. Show a1 => a1 -> a2 -> a2
mytrace [Char]
"fudget destroyed during getNLimits in layoutMgrF" forall a b. (a -> b) -> a -> b
$
	     --let l' =
	     -- if {-already received layout request from the destoyed fudget-}
	     -- then {-remove it from l-}
	     -- else l
	     -- in getNLimits (n-1) l'
	     SP
  (Message
     (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
  (Message (Path, FRequest) (Path, Rect))
same
      Low (Path, FResponse)
_ -> forall {a1} {a2}. Show a1 => a1 -> a2 -> a2
mytrace [Char]
"unexpected event in getNLimits in layoutMgrF" forall a b. (a -> b) -> a -> b
$
               SP
  (Message
     (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
  (Message (Path, FRequest) (Path, Rect))
same
   doLter1 :: Maybe (Rect, [Rect])
-> [(Path, LayoutRequest)]
-> SP
     (Message
        (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
     (Message (Path, FRequest) (Path, Rect))
doLter1 Maybe (Rect, [Rect])
oplace [(Path, LayoutRequest)]
slims =
     let (LayoutRequest
req,Rect -> [Rect]
lter2) = Placer1
lter1 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Path, LayoutRequest)]
slims)
     in forall {a1} {a2}. Show a1 => a1 -> a2 -> a2
mytrace ([Char]
"req is"forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show LayoutRequest
req) forall a b. (a -> b) -> a -> b
$ 
        forall b a. b -> SP a b -> SP a b
putSP (forall a b. a -> Message a b
Low (Path
here,LayoutRequest -> FRequest
layoutRequestCmd LayoutRequest
req)) forall a b. (a -> b) -> a -> b
$
	forall {a1} {a2}. Show a1 => a1 -> a2 -> a2
mytrace ([Char]
"enter loop with "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Path, LayoutRequest)]
slims)) forall a b. (a -> b) -> a -> b
$
	(Rect -> [Rect])
-> [(Path, LayoutRequest)]
-> Maybe (Rect, [Rect])
-> SP
     (Message
        (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
     (Message (Path, FRequest) (Path, Rect))
loop Rect -> [Rect]
lter2 [(Path, LayoutRequest)]
slims Maybe (Rect, [Rect])
oplace
   loop :: (Rect -> [Rect])
-> [(Path, LayoutRequest)]
-> Maybe (Rect, [Rect])
-> SP
     (Message
        (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
     (Message (Path, FRequest) (Path, Rect))
loop Rect -> [Rect]
lter2 [(Path, LayoutRequest)]
slims Maybe (Rect, [Rect])
oplace =
    let same :: SP
  (Message
     (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
  (Message (Path, FRequest) (Path, Rect))
same = (Rect -> [Rect])
-> [(Path, LayoutRequest)]
-> Maybe (Rect, [Rect])
-> SP
     (Message
        (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
     (Message (Path, FRequest) (Path, Rect))
loop Rect -> [Rect]
lter2 [(Path, LayoutRequest)]
slims Maybe (Rect, [Rect])
oplace
    in
    forall a b. Cont (SP a b) a
getSP forall a b. (a -> b) -> a -> b
$ \Message (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool))
msg -> case Message (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool))
msg of
      High (Left (Path
path,LayoutRequest LayoutRequest
lr)) ->
	 case forall {b}. Show b => [(Path, b)] -> Path -> b -> Maybe [(Path, b)]
upd [(Path, LayoutRequest)]
slims Path
path LayoutRequest
lr of
	   Maybe [(Path, LayoutRequest)]
Nothing -> case (Maybe (Rect, [Rect])
oplace forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Rect, [Rect])
place ->
			    forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Path, LayoutRequest)]
slims) (forall a b. (a, b) -> b
snd (Rect, [Rect])
place)) Path
path) of
			Maybe Rect
Nothing -> SP
  (Message
     (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
  (Message (Path, FRequest) (Path, Rect))
same
			Just Rect
r -> forall b a. b -> SP a b -> SP a b
putSP (forall a b. b -> Message a b
High (Path
path,Rect
r)) SP
  (Message
     (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
  (Message (Path, FRequest) (Path, Rect))
same
	   Just [(Path, LayoutRequest)]
slims' -> forall {a1} {a2}. Show a1 => a1 -> a2 -> a2
mytrace ([Char]
"reenter: "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Path, LayoutRequest)]
slims')) forall a b. (a -> b) -> a -> b
$
	                  Maybe (Rect, [Rect])
-> [(Path, LayoutRequest)]
-> SP
     (Message
        (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
     (Message (Path, FRequest) (Path, Rect))
doLter1 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {t} {a} {b}. (t -> a) -> (t, b) -> (a, b)
apFst (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Rect
rR Int
0 Int
0 Int
0 Int
0)) Maybe (Rect, [Rect])
oplace) [(Path, LayoutRequest)]
slims'
         where upd :: [(Path, b)] -> Path -> b -> Maybe [(Path, b)]
upd [(Path, b)]
slims Path
path b
lr =
	         Path -> Maybe Path -> Maybe [(Path, b)] -> Maybe [(Path, b)]
try Path
path forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$
		 forall {a1} {a2}. Show a1 => a1 -> a2 -> a2
mytrace ([Char]
"lF: trying subPath"forall a. [a] -> [a] -> [a]
++
		          forall a. Show a => a -> [Char]
show(Path
path,[(Path, b)]
slims,forall {a}. Eq a => [a] -> [[a]] -> [a]
longesteq Path
path (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Path, b)]
slims)::Path)) forall a b. (a -> b) -> a -> b
$
		 Path -> Maybe Path -> Maybe [(Path, b)] -> Maybe [(Path, b)]
try (forall {a}. Eq a => [a] -> [[a]] -> [a]
longesteq Path
path (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Path, b)]
slims)) (forall a. a -> Maybe a
Just Path
path) forall a. Maybe a
Nothing
                 where try :: Path -> Maybe Path -> Maybe [(Path, b)] -> Maybe [(Path, b)]
try Path
path Maybe Path
orepl Maybe [(Path, b)]
fail = [(Path, b)] -> [(Path, b)] -> Maybe [(Path, b)]
u [(Path, b)]
slims []
			  where u :: [(Path, b)] -> [(Path, b)] -> Maybe [(Path, b)]
u [] [(Path, b)]
_ = Maybe [(Path, b)]
fail
				u (pl :: (Path, b)
pl@(Path
path',b
lr'):[(Path, b)]
rest) [(Path, b)]
l = 
				  let nslims :: Path -> Maybe [(Path, b)]
nslims Path
p = forall a. a -> Maybe a
Just (forall a. [a] -> [a]
reverse [(Path, b)]
l forall a. [a] -> [a] -> [a]
++ ((Path
p,b
lr)forall a. a -> [a] -> [a]
:[(Path, b)]
rest)) in
				  if Path
path'forall a. Eq a => a -> a -> Bool
==Path
path then case Maybe Path
orepl of
				       Maybe Path
Nothing -> {-if lr == lr' then Nothing else -} Path -> Maybe [(Path, b)]
nslims Path
path
				       Just Path
repl -> Path -> Maybe [(Path, b)]
nslims Path
repl

				  else [(Path, b)] -> [(Path, b)] -> Maybe [(Path, b)]
u [(Path, b)]
rest ((Path, b)
plforall a. a -> [a] -> [a]
:[(Path, b)]
l)
      High (Left (Path
path,LayoutMessage
lr)) -> forall b a. b -> SP a b -> SP a b
putSP (forall a b. a -> Message a b
Low (Path
path,LayoutMessage -> FRequest
LCmd LayoutMessage
lr)) SP
  (Message
     (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
  (Message (Path, FRequest) (Path, Rect))
same -- !!!
      High (Right (a
dyn,Bool
created)) ->
        if Bool
created
	then a
-> [(Path, LayoutRequest)]
-> SP
     (Message
        (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
     (Message (Path, FRequest) (Path, Rect))
getNLimits a
1 [(Path, LayoutRequest)]
slims
	else forall {a1} {a2}. Show a1 => a1 -> a2 -> a2
mytrace [Char]
"fudget destroyed in loop in layoutMgrF" forall a b. (a -> b) -> a -> b
$
	     -- remove it!
	     SP
  (Message
     (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
  (Message (Path, FRequest) (Path, Rect))
same
      Low (Path
path,LEvt (LayoutPlace Rect
r)) -> forall {a1} {a2}. Show a1 => a1 -> a2 -> a2
mytrace ([Char]
"Layoutplace "forall a. [a] -> [a] -> [a]
++Path -> [Char]
showPath Path
pathforall a. [a] -> [a] -> [a]
++[Char]
","forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show Rect
r) forall a b. (a -> b) -> a -> b
$
	case Maybe (Rect, [Rect])
oplace of 
	  Just (Rect
r',[Rect]
_) | Rect
r forall a. Eq a => a -> a -> Bool
== Rect
r' -> forall {a1} {a2}. Show a1 => a1 -> a2 -> a2
mytrace ([Char]
"lF: same rect "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show Rect
r) SP
  (Message
     (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
  (Message (Path, FRequest) (Path, Rect))
same
	  Maybe (Rect, [Rect])
_ -> let rects :: [Rect]
rects = Rect -> [Rect]
lter2 Rect
r
		   slims' :: [(Path, LayoutRequest)]
slims' = [(Path, LayoutRequest)]
slims {-map (\((path,Layout s v h),Rect p s') ->
				   mytrace (show (showPath path,s,s'))$(path,Layout s' v h)) $ zip slims rects-}
		   paths :: [Path]
paths = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Path, LayoutRequest)]
slims
		   crects :: [(Path, Rect)]
crects = forall a b. [a] -> [b] -> [(a, b)]
zip [Path]
paths [Rect]
rects {- case oplace of
		    Nothing -> zip paths rects
		    Just (_,orects) -> 
			   [(path,r) | 
			    (path,r,r') <- zip3 paths rects orects, r /= r']-}
	       in --mytrace (show$slims'==slims') $
		  forall b a. [b] -> SP a b -> SP a b
putsSP [forall {a1} {a2}. Show a1 => a1 -> a2 -> a2
mytrace ([Char]
"putsSP "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show (Path -> [Char]
showPath Path
path,Rect
r))forall a b. (a -> b) -> a -> b
$forall a b. b -> Message a b
High (Path, Rect)
pr | pr :: (Path, Rect)
pr@(Path
path,Rect
r) <- [(Path, Rect)]
crects] forall a b. (a -> b) -> a -> b
$
		  (Rect -> [Rect])
-> [(Path, LayoutRequest)]
-> Maybe (Rect, [Rect])
-> SP
     (Message
        (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
     (Message (Path, FRequest) (Path, Rect))
loop (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Placer1
lter1 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Path, LayoutRequest)]
slims')) [(Path, LayoutRequest)]
slims' (forall a. a -> Maybe a
Just (Rect
r,[Rect]
rects))
      Low (Path, FResponse)
_ -> forall {a1} {a2}. Show a1 => a1 -> a2 -> a2
mytrace [Char]
"unexpected event in loop in layoutMgrF" forall a b. (a -> b) -> a -> b
$
               SP
  (Message
     (Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
  (Message (Path, FRequest) (Path, Rect))
same

--{-
--This is a fix for a problem with dynF, I (th) suppose. I think you can fix it in dynF instead.
begineqlen :: [a] -> [a] -> t
begineqlen [a]
x = forall {a} {t}. (Eq a, Num t) => t -> [a] -> [a] -> t
eq t
0 [a]
x where
  eq :: t -> [a] -> [a] -> t
eq t
n (a
x:[a]
xs) (a
y:[a]
ys) | a
x forall a. Eq a => a -> a -> Bool
== a
y = t -> [a] -> [a] -> t
eq (t
nforall a. Num a => a -> a -> a
+t
1) [a]
xs [a]
ys
  eq t
n [a]
_ [a]
_ = t
n

longesteq :: [a] -> [[a]] -> [a]
longesteq [a]
p1 ([a]
p:[[a]]
ps) = forall {t}. (Num t, Ord t) => ([a], t) -> [[a]] -> [a]
le ([a]
p1,forall {a} {t}. (Eq a, Num t) => [a] -> [a] -> t
begineqlen [a]
p1 [a]
p) [[a]]
ps where
  le :: ([a], t) -> [[a]] -> [a]
le ([a]
pm,t
l) [] = [a]
pm
  le ([a]
pm,t
l) ([a]
p:[[a]]
ps) = let len :: t
len = forall {a} {t}. (Eq a, Num t) => [a] -> [a] -> t
begineqlen [a]
p1 [a]
p
                         pl1 :: ([a], t)
pl1 = if t
len forall a. Ord a => a -> a -> Bool
> t
l then ([a]
p,t
len) else ([a]
pm,t
l)
		     in ([a], t) -> [[a]] -> [a]
le ([a], t)
pl1 [[a]]
ps
-- -}