module ShapeGroupMgr(shapeGroupMgr) where
import LoopLow
import Command
import Fudget
import FRequest
import Geometry
import Spops
import Data.Maybe(fromMaybe,mapMaybe)
import Utils
import Xtypes
import WindowF(kernelTag,getBWidth,adjustBorderWidth,border_width)
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