module LayoutSP(layoutMgrF,dynLayoutMgrF) where
import Data.List(sortBy)
import FRequest
import Fudget
import CompOps((>=^<))
import Geometry(Rect,rR)
import LayoutRequest
import Path(here,showPath)
import Spops
import HbcUtils(apFst)
import LayoutF(LayoutDirection(..))
import Maptrace(ctrace)
default (Int)
mytrace :: a1 -> a2 -> a2
mytrace a1
x = [Char] -> a1 -> a2 -> a2
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 F (Either (Path, LayoutMessage) (Int, Bool)) (Path, Rect)
-> ((Path, LayoutMessage)
-> Either (Path, LayoutMessage) (Int, Bool))
-> F (Path, LayoutMessage) (Path, Rect)
forall c d e. F c d -> (e -> c) -> F e d
>=^< (Path, LayoutMessage) -> Either (Path, LayoutMessage) (Int, Bool)
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) = FSP (Either (Path, LayoutMessage) (Int, Bool)) (Path, Rect)
-> F (Either (Path, LayoutMessage) (Int, Bool)) (Path, Rect)
forall hi ho. FSP hi ho -> F hi ho
F (FSP (Either (Path, LayoutMessage) (Int, Bool)) (Path, Rect)
-> F (Either (Path, LayoutMessage) (Int, Bool)) (Path, Rect))
-> FSP (Either (Path, LayoutMessage) (Int, Bool)) (Path, Rect)
-> F (Either (Path, LayoutMessage) (Int, Bool)) (Path, Rect)
forall a b. (a -> b) -> a -> b
$ Int
-> [(Path, LayoutRequest)]
-> FSP (Either (Path, LayoutMessage) (Int, Bool)) (Path, Rect)
forall a a.
(Num a, Eq 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 = ((Path, b) -> (Path, b) -> Ordering) -> [(Path, b)] -> [(Path, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (LayoutDirection -> (Path, b) -> (Path, b) -> Ordering
forall a b b.
Ord a =>
LayoutDirection -> (a, b) -> (a, b) -> Ordering
order LayoutDirection
dir)
where
order :: LayoutDirection -> (a, b) -> (a, b) -> Ordering
order LayoutDirection
Forward = (a -> a -> Ordering) -> (a, b) -> (a, b) -> Ordering
forall t t t b b. (t -> t -> t) -> (t, b) -> (t, b) -> t
ofst a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
order LayoutDirection
Backward = (a -> a -> Ordering) -> (a, b) -> (a, b) -> Ordering
forall t t t b b. (t -> t -> t) -> (t, b) -> (t, b) -> t
ofst ((a -> a -> Ordering) -> a -> a -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> Ordering
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 Maybe (Rect, [Rect])
forall a. Maybe a
Nothing ([(Path, LayoutRequest)]
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect)))
-> [(Path, LayoutRequest)]
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
forall a b. (a -> b) -> a -> b
$ [(Path, LayoutRequest)] -> [(Path, LayoutRequest)]
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
Cont
(SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect)))
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
forall a b. Cont (SP a b) a
getSP Cont
(SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect)))
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
-> Cont
(SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect)))
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
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
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) ((Path
path,LayoutRequest
lr)(Path, LayoutRequest)
-> [(Path, LayoutRequest)] -> [(Path, LayoutRequest)]
forall a. a -> [a] -> [a]
:[(Path, LayoutRequest)]
l)
LayoutMessage
_ -> Message (Path, FRequest) (Path, Rect)
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
forall b a. b -> SP a b -> SP a b
putSP ((Path, FRequest) -> Message (Path, FRequest) (Path, Rect)
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
na -> a -> a
forall a. Num a => a -> a -> a
+a
1) [(Path, LayoutRequest)]
l
else [Char]
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
forall a1 a2. Show a1 => a1 -> a2 -> a2
mytrace [Char]
"fudget destroyed during getNLimits in layoutMgrF" (SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect)))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
forall a b. (a -> b) -> a -> b
$
SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
same
Low (Path, FResponse)
_ -> [Char]
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
forall a1 a2. Show a1 => a1 -> a2 -> a2
mytrace [Char]
"unexpected event in getNLimits in layoutMgrF" (SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect)))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
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 (((Path, LayoutRequest) -> LayoutRequest)
-> [(Path, LayoutRequest)] -> [LayoutRequest]
forall a b. (a -> b) -> [a] -> [b]
map (Path, LayoutRequest) -> LayoutRequest
forall a b. (a, b) -> b
snd [(Path, LayoutRequest)]
slims)
in [Char]
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
forall a1 a2. Show a1 => a1 -> a2 -> a2
mytrace ([Char]
"req is"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++LayoutRequest -> [Char]
forall a. Show a => a -> [Char]
show LayoutRequest
req) (SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect)))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
forall a b. (a -> b) -> a -> b
$
Message (Path, FRequest) (Path, Rect)
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
forall b a. b -> SP a b -> SP a b
putSP ((Path, FRequest) -> Message (Path, FRequest) (Path, Rect)
forall a b. a -> Message a b
Low (Path
here,LayoutRequest -> FRequest
layoutRequestCmd LayoutRequest
req)) (SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect)))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
forall a b. (a -> b) -> a -> b
$
[Char]
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
forall a1 a2. Show a1 => a1 -> a2 -> a2
mytrace ([Char]
"enter loop with "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Int -> [Char]
forall a. Show a => a -> [Char]
show ([(Path, LayoutRequest)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Path, LayoutRequest)]
slims)) (SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect)))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
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
Cont
(SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect)))
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
forall a b. Cont (SP a b) a
getSP Cont
(SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect)))
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
-> Cont
(SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect)))
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
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 [(Path, LayoutRequest)]
-> Path -> LayoutRequest -> Maybe [(Path, LayoutRequest)]
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 Maybe (Rect, [Rect])
-> ((Rect, [Rect]) -> Maybe Rect) -> Maybe Rect
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Rect, [Rect])
place ->
(Path -> [(Path, Rect)] -> Maybe Rect)
-> [(Path, Rect)] -> Path -> Maybe Rect
forall a b c. (a -> b -> c) -> b -> a -> c
flip Path -> [(Path, Rect)] -> Maybe Rect
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ([Path] -> [Rect] -> [(Path, Rect)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((Path, LayoutRequest) -> Path)
-> [(Path, LayoutRequest)] -> [Path]
forall a b. (a -> b) -> [a] -> [b]
map (Path, LayoutRequest) -> Path
forall a b. (a, b) -> a
fst [(Path, LayoutRequest)]
slims) ((Rect, [Rect]) -> [Rect]
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 -> Message (Path, FRequest) (Path, Rect)
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
forall b a. b -> SP a b -> SP a b
putSP ((Path, Rect) -> Message (Path, FRequest) (Path, Rect)
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' -> [Char]
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
forall a1 a2. Show a1 => a1 -> a2 -> a2
mytrace ([Char]
"reenter: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Int -> [Char]
forall a. Show a => a -> [Char]
show ([(Path, LayoutRequest)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Path, LayoutRequest)]
slims')) (SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect)))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
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 (((Rect, [Rect]) -> (Rect, [Rect]))
-> Maybe (Rect, [Rect]) -> Maybe (Rect, [Rect])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Rect -> Rect) -> (Rect, [Rect]) -> (Rect, [Rect])
forall t a b. (t -> a) -> (t, b) -> (a, b)
apFst (Rect -> Rect -> Rect
forall a b. a -> b -> a
const (Rect -> Rect -> Rect) -> Rect -> Rect -> Rect
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 Maybe Path
forall a. Maybe a
Nothing (Maybe [(Path, b)] -> Maybe [(Path, b)])
-> Maybe [(Path, b)] -> Maybe [(Path, b)]
forall a b. (a -> b) -> a -> b
$
[Char] -> Maybe [(Path, b)] -> Maybe [(Path, b)]
forall a1 a2. Show a1 => a1 -> a2 -> a2
mytrace ([Char]
"lF: trying subPath"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
(Path, [(Path, b)], Path) -> [Char]
forall a. Show a => a -> [Char]
show(Path
path,[(Path, b)]
slims,Path -> [Path] -> Path
forall a. Eq a => [a] -> [[a]] -> [a]
longesteq Path
path (((Path, b) -> Path) -> [(Path, b)] -> [Path]
forall a b. (a -> b) -> [a] -> [b]
map (Path, b) -> Path
forall a b. (a, b) -> a
fst [(Path, b)]
slims)::Path)) (Maybe [(Path, b)] -> Maybe [(Path, b)])
-> Maybe [(Path, b)] -> Maybe [(Path, b)]
forall a b. (a -> b) -> a -> b
$
Path -> Maybe Path -> Maybe [(Path, b)] -> Maybe [(Path, b)]
try (Path -> [Path] -> Path
forall a. Eq a => [a] -> [[a]] -> [a]
longesteq Path
path (((Path, b) -> Path) -> [(Path, b)] -> [Path]
forall a b. (a -> b) -> [a] -> [b]
map (Path, b) -> Path
forall a b. (a, b) -> a
fst [(Path, b)]
slims)) (Path -> Maybe Path
forall a. a -> Maybe a
Just Path
path) Maybe [(Path, b)]
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 = [(Path, b)] -> Maybe [(Path, b)]
forall a. a -> Maybe a
Just ([(Path, b)] -> [(Path, b)]
forall a. [a] -> [a]
reverse [(Path, b)]
l [(Path, b)] -> [(Path, b)] -> [(Path, b)]
forall a. [a] -> [a] -> [a]
++ ((Path
p,b
lr)(Path, b) -> [(Path, b)] -> [(Path, b)]
forall a. a -> [a] -> [a]
:[(Path, b)]
rest)) in
if Path
path'Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
==Path
path then case Maybe Path
orepl of
Maybe Path
Nothing -> Path -> Maybe [(Path, b)]
nslims Path
path
Just repl -> Path -> Maybe [(Path, b)]
nslims Path
repl
else [(Path, b)] -> [(Path, b)] -> Maybe [(Path, b)]
u [(Path, b)]
rest ((Path, b)
pl(Path, b) -> [(Path, b)] -> [(Path, b)]
forall a. a -> [a] -> [a]
:[(Path, b)]
l)
High (Left (Path
path,LayoutMessage
lr)) -> Message (Path, FRequest) (Path, Rect)
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
forall b a. b -> SP a b -> SP a b
putSP ((Path, FRequest) -> Message (Path, FRequest) (Path, Rect)
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 [Char]
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
forall a1 a2. Show a1 => a1 -> a2 -> a2
mytrace [Char]
"fudget destroyed in loop in layoutMgrF" (SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect)))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
forall a b. (a -> b) -> a -> b
$
SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
same
Low (Path
path,LEvt (LayoutPlace Rect
r)) -> [Char]
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
forall a1 a2. Show a1 => a1 -> a2 -> a2
mytrace ([Char]
"Layoutplace "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Path -> [Char]
showPath Path
path[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
","[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Rect -> [Char]
forall a. Show a => a -> [Char]
show Rect
r) (SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect)))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
forall a b. (a -> b) -> a -> b
$
case Maybe (Rect, [Rect])
oplace of
Just (Rect
r',[Rect]
_) | Rect
r Rect -> Rect -> Bool
forall a. Eq a => a -> a -> Bool
== Rect
r' -> [Char]
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
forall a1 a2. Show a1 => a1 -> a2 -> a2
mytrace ([Char]
"lF: same rect "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Rect -> [Char]
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
paths :: [Path]
paths = ((Path, LayoutRequest) -> Path)
-> [(Path, LayoutRequest)] -> [Path]
forall a b. (a -> b) -> [a] -> [b]
map (Path, LayoutRequest) -> Path
forall a b. (a, b) -> a
fst [(Path, LayoutRequest)]
slims
crects :: [(Path, Rect)]
crects = [Path] -> [Rect] -> [(Path, Rect)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Path]
paths [Rect]
rects
in
[Message (Path, FRequest) (Path, Rect)]
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
forall b a. [b] -> SP a b -> SP a b
putsSP [[Char]
-> Message (Path, FRequest) (Path, Rect)
-> Message (Path, FRequest) (Path, Rect)
forall a1 a2. Show a1 => a1 -> a2 -> a2
mytrace ([Char]
"putsSP "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++([Char], Rect) -> [Char]
forall a. Show a => a -> [Char]
show (Path -> [Char]
showPath Path
path,Rect
r))(Message (Path, FRequest) (Path, Rect)
-> Message (Path, FRequest) (Path, Rect))
-> Message (Path, FRequest) (Path, Rect)
-> Message (Path, FRequest) (Path, Rect)
forall a b. (a -> b) -> a -> b
$(Path, Rect) -> Message (Path, FRequest) (Path, Rect)
forall a b. b -> Message a b
High (Path, Rect)
pr | pr :: (Path, Rect)
pr@(Path
path,Rect
r) <- [(Path, Rect)]
crects] (SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect)))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
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 ((LayoutRequest, Rect -> [Rect]) -> Rect -> [Rect]
forall a b. (a, b) -> b
snd ((LayoutRequest, Rect -> [Rect]) -> Rect -> [Rect])
-> (LayoutRequest, Rect -> [Rect]) -> Rect -> [Rect]
forall a b. (a -> b) -> a -> b
$ Placer1
lter1 (((Path, LayoutRequest) -> LayoutRequest)
-> [(Path, LayoutRequest)] -> [LayoutRequest]
forall a b. (a -> b) -> [a] -> [b]
map (Path, LayoutRequest) -> LayoutRequest
forall a b. (a, b) -> b
snd [(Path, LayoutRequest)]
slims')) [(Path, LayoutRequest)]
slims' ((Rect, [Rect]) -> Maybe (Rect, [Rect])
forall a. a -> Maybe a
Just (Rect
r,[Rect]
rects))
Low (Path, FResponse)
_ -> [Char]
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
forall a1 a2. Show a1 => a1 -> a2 -> a2
mytrace [Char]
"unexpected event in loop in layoutMgrF" (SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect)))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
-> SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
forall a b. (a -> b) -> a -> b
$
SP
(Message
(Path, FResponse) (Either (Path, LayoutMessage) (a, Bool)))
(Message (Path, FRequest) (Path, Rect))
same
begineqlen :: [a] -> [a] -> p
begineqlen [a]
x = p -> [a] -> [a] -> p
forall a p. (Eq a, Num p) => p -> [a] -> [a] -> p
eq p
0 [a]
x where
eq :: p -> [a] -> [a] -> p
eq p
n (a
x:[a]
xs) (a
y:[a]
ys) | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = p -> [a] -> [a] -> p
eq (p
np -> p -> p
forall a. Num a => a -> a -> a
+p
1) [a]
xs [a]
ys
eq p
n [a]
_ [a]
_ = p
n
longesteq :: [a] -> [[a]] -> [a]
longesteq [a]
p1 ([a]
p:[[a]]
ps) = ([a], Int) -> [[a]] -> [a]
forall p. (Num p, Ord p) => ([a], p) -> [[a]] -> [a]
le ([a]
p1,[a] -> [a] -> Int
forall a p. (Eq a, Num p) => [a] -> [a] -> p
begineqlen [a]
p1 [a]
p) [[a]]
ps where
le :: ([a], p) -> [[a]] -> [a]
le ([a]
pm,p
l) [] = [a]
pm
le ([a]
pm,p
l) ([a]
p:[[a]]
ps) = let len :: p
len = [a] -> [a] -> p
forall a p. (Eq a, Num p) => [a] -> [a] -> p
begineqlen [a]
p1 [a]
p
pl1 :: ([a], p)
pl1 = if p
len p -> p -> Bool
forall a. Ord a => a -> a -> Bool
> p
l then ([a]
p,p
len) else ([a]
pm,p
l)
in ([a], p) -> [[a]] -> [a]
le ([a], p)
pl1 [[a]]
ps