module ShapeGroupMgr(shapeGroupMgr) where

--import Path
import LoopLow
import Command
--import Event
import Fudget
import FRequest
import Geometry
--import Message(Message(..))
--import NullF
--import Spacers
--import Alignment
import Spops
--import EitherUtils
import Data.Maybe(fromMaybe,mapMaybe)
import Utils
import Xtypes
import WindowF(kernelTag,getBWidth,adjustBorderWidth,border_width)
--import AuxTypes(Ordering(..)) -- HBC bug workaround 960405 TH.
--import Prelude hiding (Ordering)

doConfigure :: a
-> [(a, (Int, Rect))]
-> [WindowChanges]
-> Maybe [(a, (Int, Rect))]
doConfigure a
tag [(a, (Int, Rect))]
wins [WindowChanges]
cws = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
tag [(a, (Int, Rect))]
wins forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Int, Rect)
br ->
    let br' :: (Int, Rect)
br' = (Int, Rect) -> [WindowChanges] -> (Int, Rect)
upd (Int, Rect)
br [WindowChanges]
cws 
        upd :: (Int, Rect) -> [WindowChanges] -> (Int, Rect)
upd (Int, Rect)
br [] = (Int, Rect)
br
	upd br :: (Int, Rect)
br@(Int
bw,r :: Rect
r@(Rect (Point Int
x Int
y) (Point Int
w Int
h))) (WindowChanges
c:[WindowChanges]
cs) = 
	   (Int, Rect) -> [WindowChanges] -> (Int, Rect)
upd (case WindowChanges
c of
		 CWX Int
x' -> (Int
bw,Point -> Point -> Rect
Rect (Int -> Int -> Point
Point Int
x' Int
y) (Int -> Int -> Point
Point Int
w Int
h))
		 CWY Int
y' -> (Int
bw,Point -> Point -> Rect
Rect (Int -> Int -> Point
Point Int
x Int
y') (Int -> Int -> Point
Point Int
w Int
h))
		 CWWidth Int
w' -> (Int
bw,Point -> Point -> Rect
Rect (Int -> Int -> Point
Point Int
x Int
y) (Int -> Int -> Point
Point Int
w' Int
h))
		 CWHeight Int
h' -> (Int
bw,Point -> Point -> Rect
Rect (Int -> Int -> Point
Point Int
x Int
y) (Int -> Int -> Point
Point Int
w Int
h'))
		 CWBorderWidth Int
bw' -> (Int
bw',Rect
r)
		 WindowChanges
_ -> (Int, Rect)
br) [WindowChanges]
cs
    in if (Int, Rect)
br  forall a. Eq a => a -> a -> Bool
== (Int, Rect)
br' then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a} {b}. Eq a => (a, b) -> [(a, b)] -> [(a, b)]
replace (a
tag,(Int, Rect)
br') [(a, (Int, Rect))]
wins

filterBorderwidth :: [WindowChanges] -> [WindowChanges]
filterBorderwidth = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\WindowChanges
c->case WindowChanges
c of CWBorderWidth Int
_ -> forall a. Maybe a
Nothing
					    WindowChanges
_-> forall a. a -> Maybe a
Just WindowChanges
c)
shapeGroupMgr :: F a b -> F a b
shapeGroupMgr :: forall a b. F a b -> F a b
shapeGroupMgr F a b
f  = forall i o.
SP (Either TCommand TEvent) (Either TCommand TEvent)
-> F i o -> F i o
loopThroughLowF (forall {b}.
(Int, [(Path, (Int, Rect))])
-> SP (Either TCommand b) (Either TCommand b)
sg (Int
border_width,[])) F a b
f where
   sg :: (Int, [(Path, (Int, Rect))])
-> SP (Either TCommand b) (Either TCommand b)
sg state :: (Int, [(Path, (Int, Rect))])
state@(Int
bw,[(Path, (Int, Rect))]
wins) =
      forall a b. Cont (SP a b) a
getSP forall a b. (a -> b) -> a -> b
$ \Either TCommand b
msg -> 
      let same :: SP (Either TCommand b) (Either TCommand b)
same = (Int, [(Path, (Int, Rect))])
-> SP (Either TCommand b) (Either TCommand b)
sg (Int, [(Path, (Int, Rect))])
state
          pass :: SP a (Either TCommand b) -> SP a (Either TCommand b)
pass = forall b a. b -> SP a b -> SP a b
putSP Either TCommand b
msg
	  passame :: SP (Either TCommand b) (Either TCommand b)
passame = forall {a}. SP a (Either TCommand b) -> SP a (Either TCommand b)
pass SP (Either TCommand b) (Either TCommand b)
same 
          reshape :: Int
-> [(Path, (Int, Rect))]
-> SP (Either TCommand b) (Either TCommand b)
reshape Int
bw [(Path, (Int, Rect))]
wins = forall {a} {b}.
ShapeKind
-> Int -> SP a (Either TCommand b) -> SP a (Either TCommand b)
shape ShapeKind
ShapeBounding Int
bw forall a b. (a -> b) -> a -> b
$
			    forall {a} {b}.
ShapeKind
-> Int -> SP a (Either TCommand b) -> SP a (Either TCommand b)
shape ShapeKind
ShapeClip Int
0 forall a b. (a -> b) -> a -> b
$ (Int, [(Path, (Int, Rect))])
-> SP (Either TCommand b) (Either TCommand b)
sg (Int
bw,[(Path, (Int, Rect))]
wins) where
	     shape :: ShapeKind
-> Int -> SP a (Either TCommand b) -> SP a (Either TCommand b)
shape ShapeKind
kind Int
bw =
	       forall b a. b -> SP a b -> SP a b
putSP (forall a b. a -> Either a b
Left (Path
kernelTag,
	                      XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$
	                      ShapeKind
-> Point -> [Rect] -> ShapeOperation -> Ordering' -> XCommand
ShapeCombineRectangles 
			        ShapeKind
kind
				Point
origin
				(forall a b. (a -> b) -> [a] -> [b]
map (Int -> (Int, Rect) -> Rect
adj Int
bwforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) [(Path, (Int, Rect))]
wins) ShapeOperation
ShapeSet Ordering'
Unsorted))
	  adj :: Int -> (Int, Rect) -> Rect
adj Int
bw (Int
lbw,Rect Point
p Point
s) = Point -> Point -> Rect
Rect (Point
p Point -> Point -> Point
`psub` (Int -> Int -> Point
Point Int
bw Int
bw))
			               (Int -> Point -> Point
adjustBorderWidth (Int
lbwforall a. Num a => a -> a -> a
+Int
bw) Point
s)
      in case Either TCommand b
msg of
        Left (Path
tag,FRequest
cmd) -> 
            case FRequest
cmd of
	      XReq (CreateSimpleWindow Path
stag Rect
r) | Path
tag forall a. Eq a => a -> a -> Bool
== Path
kernelTag ->
	         forall {a}. SP a (Either TCommand b) -> SP a (Either TCommand b)
pass forall a b. (a -> b) -> a -> b
$ (Int, [(Path, (Int, Rect))])
-> SP (Either TCommand b) (Either TCommand b)
sg (Int
bw,(Path
stag,(Int
border_width,Rect
r))forall a. a -> [a] -> [a]
:[(Path, (Int, Rect))]
wins)
	      XCmd (ConfigureWindow [WindowChanges]
cws) | Path
tag forall a. Eq a => a -> a -> Bool
== Path
kernelTag ->
	         let bw' :: Int
bw' = forall a. a -> Maybe a -> a
fromMaybe Int
bw ([WindowChanges] -> Maybe Int
getBWidth [WindowChanges]
cws) 
		     cws' :: [WindowChanges]
cws'= [WindowChanges] -> [WindowChanges]
filterBorderwidth [WindowChanges]
cws
		 in
		 forall b a. b -> SP a b -> SP a b
putSP (forall a b. a -> Either a b
Left (Path
tag,XCommand -> FRequest
XCmd ([WindowChanges] -> XCommand
ConfigureWindow [WindowChanges]
cws'))) forall a b. (a -> b) -> a -> b
$
		 if Int
bw forall a. Eq a => a -> a -> Bool
== Int
bw' then SP (Either TCommand b) (Either TCommand b)
same else Int
-> [(Path, (Int, Rect))]
-> SP (Either TCommand b) (Either TCommand b)
reshape Int
bw' [(Path, (Int, Rect))]
wins
	      XCmd (ConfigureWindow [WindowChanges]
cws) -> 
	         case forall {a}.
Eq a =>
a
-> [(a, (Int, Rect))]
-> [WindowChanges]
-> Maybe [(a, (Int, Rect))]
doConfigure Path
tag [(Path, (Int, Rect))]
wins [WindowChanges]
cws of
		    Maybe [(Path, (Int, Rect))]
Nothing -> SP (Either TCommand b) (Either TCommand b)
passame
		    Just [(Path, (Int, Rect))]
wins' -> forall {a}. SP a (Either TCommand b) -> SP a (Either TCommand b)
pass forall a b. (a -> b) -> a -> b
$ Int
-> [(Path, (Int, Rect))]
-> SP (Either TCommand b) (Either TCommand b)
reshape Int
bw [(Path, (Int, Rect))]
wins'
	      XCmd XCommand
DestroyWindow ->
		 forall {a}. SP a (Either TCommand b) -> SP a (Either TCommand b)
pass forall a b. (a -> b) -> a -> b
$ (Int, [(Path, (Int, Rect))])
-> SP (Either TCommand b) (Either TCommand b)
sg (Int
bw,forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/=Path
tag)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) [(Path, (Int, Rect))]
wins)
	      FRequest
_ -> SP (Either TCommand b) (Either TCommand b)
passame
        Either TCommand b
_ -> SP (Either TCommand b) (Either TCommand b)
passame