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 = a -> [(a, (Int, Rect))] -> Maybe (Int, Rect)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
tag [(a, (Int, Rect))]
wins Maybe (Int, Rect)
-> ((Int, Rect) -> Maybe [(a, (Int, Rect))])
-> Maybe [(a, (Int, Rect))]
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  (Int, Rect) -> (Int, Rect) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Rect)
br' then Maybe [(a, (Int, Rect))]
forall a. Maybe a
Nothing else [(a, (Int, Rect))] -> Maybe [(a, (Int, Rect))]
forall a. a -> Maybe a
Just ([(a, (Int, Rect))] -> Maybe [(a, (Int, Rect))])
-> [(a, (Int, Rect))] -> Maybe [(a, (Int, Rect))]
forall a b. (a -> b) -> a -> b
$ (a, (Int, Rect)) -> [(a, (Int, Rect))] -> [(a, (Int, Rect))]
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 = (WindowChanges -> Maybe WindowChanges)
-> [WindowChanges] -> [WindowChanges]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\WindowChanges
c->case WindowChanges
c of CWBorderWidth Int
_ -> Maybe WindowChanges
forall a. Maybe a
Nothing
					    WindowChanges
_-> WindowChanges -> Maybe WindowChanges
forall a. a -> Maybe a
Just WindowChanges
c)
shapeGroupMgr :: F a b -> F a b
shapeGroupMgr :: F a b -> F a b
shapeGroupMgr F a b
f  = SP (Either TCommand TEvent) (Either TCommand TEvent)
-> F a b -> F a b
forall i o.
SP (Either TCommand TEvent) (Either TCommand TEvent)
-> F i o -> F i o
loopThroughLowF ((Int, [(Path, (Int, Rect))])
-> SP (Either TCommand TEvent) (Either TCommand TEvent)
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) =
      Cont
  (SP (Either TCommand b) (Either TCommand b)) (Either TCommand b)
forall a b. Cont (SP a b) a
getSP Cont
  (SP (Either TCommand b) (Either TCommand b)) (Either TCommand b)
-> Cont
     (SP (Either TCommand b) (Either TCommand b)) (Either TCommand b)
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 = Either TCommand b
-> SP a (Either TCommand b) -> SP a (Either TCommand b)
forall b a. b -> SP a b -> SP a b
putSP Either TCommand b
msg
	  passame :: SP (Either TCommand b) (Either TCommand b)
passame = SP (Either TCommand b) (Either TCommand b)
-> SP (Either TCommand b) (Either TCommand b)
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 = ShapeKind
-> Int
-> SP (Either TCommand b) (Either TCommand b)
-> SP (Either TCommand b) (Either TCommand b)
forall a b.
ShapeKind
-> Int -> SP a (Either TCommand b) -> SP a (Either TCommand b)
shape ShapeKind
ShapeBounding Int
bw (SP (Either TCommand b) (Either TCommand b)
 -> SP (Either TCommand b) (Either TCommand b))
-> SP (Either TCommand b) (Either TCommand b)
-> SP (Either TCommand b) (Either TCommand b)
forall a b. (a -> b) -> a -> b
$
			    ShapeKind
-> Int
-> SP (Either TCommand b) (Either TCommand b)
-> SP (Either TCommand b) (Either TCommand b)
forall a b.
ShapeKind
-> Int -> SP a (Either TCommand b) -> SP a (Either TCommand b)
shape ShapeKind
ShapeClip Int
0 (SP (Either TCommand b) (Either TCommand b)
 -> SP (Either TCommand b) (Either TCommand b))
-> SP (Either TCommand b) (Either TCommand b)
-> SP (Either TCommand b) (Either TCommand b)
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 =
	       Either TCommand b
-> SP a (Either TCommand b) -> SP a (Either TCommand b)
forall b a. b -> SP a b -> SP a b
putSP (TCommand -> Either TCommand b
forall a b. a -> Either a b
Left (Path
kernelTag,
	                      XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$
	                      ShapeKind
-> Point -> [Rect] -> ShapeOperation -> Ordering' -> XCommand
ShapeCombineRectangles 
			        ShapeKind
kind
				Point
origin
				(((Path, (Int, Rect)) -> Rect) -> [(Path, (Int, Rect))] -> [Rect]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> (Int, Rect) -> Rect
adj Int
bw((Int, Rect) -> Rect)
-> ((Path, (Int, Rect)) -> (Int, Rect))
-> (Path, (Int, Rect))
-> Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Path, (Int, Rect)) -> (Int, Rect)
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
lbwInt -> Int -> Int
forall 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 Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
kernelTag ->
	         SP (Either TCommand b) (Either TCommand b)
-> SP (Either TCommand b) (Either TCommand b)
forall a. SP a (Either TCommand b) -> SP a (Either TCommand b)
pass (SP (Either TCommand b) (Either TCommand b)
 -> SP (Either TCommand b) (Either TCommand b))
-> SP (Either TCommand b) (Either TCommand b)
-> SP (Either TCommand b) (Either TCommand b)
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))(Path, (Int, Rect))
-> [(Path, (Int, Rect))] -> [(Path, (Int, Rect))]
forall a. a -> [a] -> [a]
:[(Path, (Int, Rect))]
wins)
	      XCmd (ConfigureWindow [WindowChanges]
cws) | Path
tag Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
kernelTag ->
	         let bw' :: Int
bw' = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
bw ([WindowChanges] -> Maybe Int
getBWidth [WindowChanges]
cws) 
		     cws' :: [WindowChanges]
cws'= [WindowChanges] -> [WindowChanges]
filterBorderwidth [WindowChanges]
cws
		 in
		 Either TCommand b
-> SP (Either TCommand b) (Either TCommand b)
-> SP (Either TCommand b) (Either TCommand b)
forall b a. b -> SP a b -> SP a b
putSP (TCommand -> Either TCommand b
forall a b. a -> Either a b
Left (Path
tag,XCommand -> FRequest
XCmd ([WindowChanges] -> XCommand
ConfigureWindow [WindowChanges]
cws'))) (SP (Either TCommand b) (Either TCommand b)
 -> SP (Either TCommand b) (Either TCommand b))
-> SP (Either TCommand b) (Either TCommand b)
-> SP (Either TCommand b) (Either TCommand b)
forall a b. (a -> b) -> a -> b
$
		 if Int
bw Int -> Int -> Bool
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 Path
-> [(Path, (Int, Rect))]
-> [WindowChanges]
-> Maybe [(Path, (Int, Rect))]
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' -> SP (Either TCommand b) (Either TCommand b)
-> SP (Either TCommand b) (Either TCommand b)
forall a. SP a (Either TCommand b) -> SP a (Either TCommand b)
pass (SP (Either TCommand b) (Either TCommand b)
 -> SP (Either TCommand b) (Either TCommand b))
-> SP (Either TCommand b) (Either TCommand b)
-> SP (Either TCommand b) (Either TCommand b)
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 ->
		 SP (Either TCommand b) (Either TCommand b)
-> SP (Either TCommand b) (Either TCommand b)
forall a. SP a (Either TCommand b) -> SP a (Either TCommand b)
pass (SP (Either TCommand b) (Either TCommand b)
 -> SP (Either TCommand b) (Either TCommand b))
-> SP (Either TCommand b) (Either TCommand b)
-> SP (Either TCommand b) (Either TCommand b)
forall a b. (a -> b) -> a -> b
$ (Int, [(Path, (Int, Rect))])
-> SP (Either TCommand b) (Either TCommand b)
sg (Int
bw,((Path, (Int, Rect)) -> Bool)
-> [(Path, (Int, Rect))] -> [(Path, (Int, Rect))]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
/=Path
tag)(Path -> Bool)
-> ((Path, (Int, Rect)) -> Path) -> (Path, (Int, Rect)) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Path, (Int, Rect)) -> Path
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