module Dlayout(invisibleGroupF,
simpleGroupF, unmappedGroupF, groupF, groupF',
sgroupF, swindowF,
windowF,sF) where
import Command
import CompFfun(prepostMapHigh)
import Defaults(bgColor)
import CmdLineEnv(resourceName)
import Event
import Fudget
import FRequest
import Geometry(Point(..), Rect(..), origin, pmax)
import GreyBgF(changeBg)
import LayoutRequest
import LoopLow
import NullF
import Spops
import AutoLayout(autoLayoutF',nowait)
import Sizing(Sizing(..))
import EitherUtils(stripEither)
import WindowF
import Xtypes
import ParSP
import Path(turn,here)
import Direction(Direction(..))
addEventMask :: [EventMask] -> [WindowAttributes] -> [WindowAttributes]
addEventMask [EventMask]
addmask =
let addem :: [WindowAttributes] -> [WindowAttributes]
addem [] = []
addem (CWEventMask [EventMask]
mask : [WindowAttributes]
wattrs) =
[EventMask] -> WindowAttributes
CWEventMask ([EventMask]
addmask [EventMask] -> [EventMask] -> [EventMask]
forall a. [a] -> [a] -> [a]
++ [EventMask]
mask) WindowAttributes -> [WindowAttributes] -> [WindowAttributes]
forall a. a -> [a] -> [a]
: [WindowAttributes]
wattrs
addem (WindowAttributes
wattr : [WindowAttributes]
wattrs) = WindowAttributes
wattr WindowAttributes -> [WindowAttributes] -> [WindowAttributes]
forall a. a -> [a] -> [a]
: [WindowAttributes] -> [WindowAttributes]
addem [WindowAttributes]
wattrs
in [WindowAttributes] -> [WindowAttributes]
addem
shell :: Bool -> (F a b) -> F a b
shell :: Bool -> F a b -> F a b
shell Bool
nomap F a b
f =
let eventmask :: [EventMask]
eventmask = [EventMask
StructureNotifyMask,EventMask
KeyPressMask,EventMask
KeyReleaseMask,EventMask
FocusChangeMask]
prep :: (Size, [Size], Maybe Path)
-> Message (Path, FResponse) (Path, Size)
-> ((Size, [Size], Maybe Path), [(Path, FResponse)])
prep ss :: (Size, [Size], Maybe Path)
ss@(Size
osize,[Size]
sizeq, Just Path
ltag) (Low (Path
tag, XEvt (ConfigureNotify (Rect Size
_ Size
nsize) Int
_)))
| Path
tag Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
kernelTag = case [Size]
sizeq of
(Size
size:[Size]
sizeq') | Size
size Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size
nsize -> ((Size
nsize,[Size]
sizeq',Path -> Maybe Path
forall a. a -> Maybe a
Just Path
ltag),[])
[Size]
_ -> if Size
nsize Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size
osize then ((Size, [Size], Maybe Path)
ss,[]) else
((Size
nsize,[Size]
sizeq,Path -> Maybe Path
forall a. a -> Maybe a
Just Path
ltag),[(Path
ltag,LayoutResponse -> FResponse
LEvt (LayoutResponse -> FResponse) -> LayoutResponse -> FResponse
forall a b. (a -> b) -> a -> b
$ Rect -> LayoutResponse
LayoutPlace (Size -> Size -> Rect
Rect Size
origin Size
nsize))])
prep (Size, [Size], Maybe Path)
s (Low (Path
t,e :: FResponse
e@(XEvt (FocusIn {})))) | Path
t Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
kernelTag = ((Size, [Size], Maybe Path)
s,[(Path
focusMgrTag, FResponse
e)])
prep (Size, [Size], Maybe Path)
s (Low (Path
t,e :: FResponse
e@(XEvt (FocusOut {})))) | Path
t Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
kernelTag = ((Size, [Size], Maybe Path)
s,[(Path
focusMgrTag, FResponse
e)])
prep (Size, [Size], Maybe Path)
s (Low (Path
t,e :: FResponse
e@(XEvt (KeyEvent {})))) | Path
t Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
kernelTag = ((Size, [Size], Maybe Path)
s,[(Path
focusMgrTag, FResponse
e)])
prep (Size, [Size], Maybe Path)
s (Low (Path, FResponse)
msg) = ((Size, [Size], Maybe Path)
s, [(Path, FResponse)
msg])
prep (Size
osize,[Size]
sizeq, Maybe Path
_) (High (Path
tag, Size
nsize)) =
((Size
osize,[Size]
sizeq[Size] -> [Size] -> [Size]
forall a. [a] -> [a] -> [a]
++ (if [Size] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Size]
sizeq Bool -> Bool -> Bool
|| [Size] -> Size
forall a. [a] -> a
last [Size]
sizeq Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
/= Size
nsize then [Size
nsize] else []), Path -> Maybe Path
forall a. a -> Maybe a
Just Path
tag),
[(Path
tag, LayoutResponse -> FResponse
LEvt (LayoutResponse -> FResponse) -> LayoutResponse -> FResponse
forall a b. (a -> b) -> a -> b
$ Rect -> LayoutResponse
LayoutPlace (Size -> Size -> Rect
Rect Size
origin Size
nsize))])
focusMgrTag :: Path
focusMgrTag = Direction -> Path -> Path
turn Direction
R (Path -> Path) -> Path -> Path
forall a b. (a -> b) -> a -> b
$ Direction -> Path -> Path
turn Direction
L Path
here
minSize :: Size
minSize = Int -> Int -> Size
Point Int
1 Int
1
post :: Bool
-> (Path, FRequest)
-> (Bool, [Message (Path, FRequest) (Path, Size)])
post Bool
nomap' (Path
tag, LCmd LayoutMessage
lreq) = case LayoutMessage
lreq of
LayoutRequest (Layout {minsize :: LayoutRequest -> Size
minsize=Size
size}) ->
(Bool
True,
(Path, Size) -> Message (Path, FRequest) (Path, Size)
forall a b. b -> Message a b
High (Path
tag, Size
size) Message (Path, FRequest) (Path, Size)
-> [Message (Path, FRequest) (Path, Size)]
-> [Message (Path, FRequest) (Path, Size)]
forall a. a -> [a] -> [a]
:
[FRequest] -> [Message (Path, FRequest) (Path, Size)]
forall b1 b2. [b1] -> [Message (Path, b1) b2]
toKernel ([XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ Size -> XCommand
resizeWindow (Size -> Size -> Size
pmax Size
minSize Size
size)] [FRequest] -> [FRequest] -> [FRequest]
forall a. [a] -> [a] -> [a]
++
(if Bool
nomap' then [] else [XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ XCommand
MapRaised])))
LayoutMessage
_ -> (Bool
nomap',[])
post Bool
nomap' (Path
tag, XCmd (ChangeWindowAttributes [WindowAttributes]
wattrs)) | Path
tag Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
kernelTag =
(Bool
nomap',
[(Path, FRequest) -> Message (Path, FRequest) (Path, Size)
forall a b. a -> Message a b
Low (Path
tag, XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes ([EventMask] -> [WindowAttributes] -> [WindowAttributes]
addEventMask [EventMask]
eventmask [WindowAttributes]
wattrs))])
post Bool
nomap' (Path
_,XCmd XCommand
MeButtonMachine) = (Bool
nomap', [])
post Bool
nomap' cmd :: (Path, FRequest)
cmd@(Path
tag, XCmd (ChangeWindowAttributes [WindowAttributes]
wattrs)) = (Bool
nomap',[(Path, FRequest) -> Message (Path, FRequest) (Path, Size)
forall a b. a -> Message a b
Low (Path, FRequest)
cmd])
post Bool
nomap' (Path, FRequest)
cmd = (Bool
nomap', [(Path, FRequest) -> Message (Path, FRequest) (Path, Size)
forall a b. a -> Message a b
Low (Path, FRequest)
cmd])
startcmds :: [Message (Path, FRequest) b2]
startcmds = [FRequest] -> [Message (Path, FRequest) b2]
forall b1 b2. [b1] -> [Message (Path, b1) b2]
toKernel [XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [[EventMask] -> WindowAttributes
CWEventMask []],
XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ Bool -> XCommand
SetWMHints Bool
True]
in SP (Path, FRequest) (Message (Path, FRequest) (Path, Size))
-> SP (Message (Path, FResponse) (Path, Size)) (Path, FResponse)
-> F a b
-> F a b
forall a b c.
SP (Path, FRequest) (FCommand a)
-> SP (FEvent a) (Path, FResponse) -> F b c -> F b c
loopLow ((Bool
-> (Path, FRequest)
-> (Bool, [Message (Path, FRequest) (Path, Size)]))
-> Bool
-> SP (Path, FRequest) (Message (Path, FRequest) (Path, Size))
forall t t b. (t -> t -> (t, [b])) -> t -> SP t b
mapstateSP' Bool
-> (Path, FRequest)
-> (Bool, [Message (Path, FRequest) (Path, Size)])
post Bool
nomap)
(((Size, [Size], Maybe Path)
-> Message (Path, FResponse) (Path, Size)
-> ((Size, [Size], Maybe Path), [(Path, FResponse)]))
-> (Size, [Size], Maybe Path)
-> SP (Message (Path, FResponse) (Path, Size)) (Path, FResponse)
forall t t b. (t -> t -> (t, [b])) -> t -> SP t b
mapstateSP (Size, [Size], Maybe Path)
-> Message (Path, FResponse) (Path, Size)
-> ((Size, [Size], Maybe Path), [(Path, FResponse)])
prep ((Int -> Int -> Size
Point Int
10 Int
10),[], Maybe Path
forall a. Maybe a
Nothing))
([FCommand b] -> F a b -> F a b
forall ho hi. [FCommand ho] -> F hi ho -> F hi ho
myAppendStartF [FCommand b]
forall b2. [Message (Path, FRequest) b2]
startcmds F a b
f)
mapstateSP' :: (t -> t -> (t, [b])) -> t -> SP t b
mapstateSP' t -> t -> (t, [b])
f t
s0 =
Cont (SP t b) t
forall a b. Cont (SP a b) a
getSP (\t
x ->
case t -> t -> (t, [b])
f t
s0 t
x of
(t
s, [b]
y) -> [b] -> SP t b -> SP t b
forall b a. [b] -> SP a b -> SP a b
putsSP [b]
y ((t -> t -> (t, [b])) -> t -> SP t b
mapstateSP' t -> t -> (t, [b])
f t
s))
myAppendStartF :: [FCommand ho] -> F hi ho -> F hi ho
myAppendStartF [FCommand ho]
cmds (F FSP hi ho
f) = FSP hi ho -> F hi ho
forall hi ho. FSP hi ho -> F hi ho
ff (FSP hi ho -> F hi ho) -> FSP hi ho -> F hi ho
forall a b. (a -> b) -> a -> b
$ FSP hi ho -> FSP hi ho -> FSP hi ho
forall a b. SP a b -> SP a b -> SP a b
parSP FSP hi ho
f ([FCommand ho] -> FSP hi ho -> FSP hi ho
forall b a. [b] -> SP a b -> SP a b
putsSP [FCommand ho]
cmds FSP hi ho
forall a b. SP a b
nullSP)
windowF :: [FRequest] -> (K a b) -> F a b
windowF :: [FRequest] -> K a b -> F a b
windowF [FRequest]
cmds = [FRequest] -> Maybe Rect -> K a b -> F a b
forall a ho. [FRequest] -> Maybe Rect -> K a ho -> F a ho
swindowF [FRequest]
cmds Maybe Rect
forall a. Maybe a
Nothing
swindowF :: [FRequest] -> Maybe Rect -> K a ho -> F a ho
swindowF [FRequest]
cmd Maybe Rect
oplace K a ho
k =
(a -> Either a Any)
-> (Either ho ho -> ho)
-> F (Either a Any) (Either ho ho)
-> F a ho
forall hi b c ho. (hi -> b) -> (c -> ho) -> F b c -> F hi ho
prepostMapHigh a -> Either a Any
forall a b. a -> Either a b
Left Either ho ho -> ho
forall p. Either p p -> p
stripEither (Sizing
-> Bool
-> [FRequest]
-> Maybe Rect
-> K a ho
-> Maybe (F Any ho)
-> F (Either a Any) (Either ho ho)
forall a b c d.
Sizing
-> Bool
-> [FRequest]
-> Maybe Rect
-> K a b
-> Maybe (F c d)
-> F (Either a c) (Either b d)
group0F Sizing
sizing Bool
False [FRequest]
cmd Maybe Rect
oplace K a ho
k Maybe (F Any ho)
forall a. Maybe a
Nothing)
where sizing :: Sizing
sizing = if Maybe Rect
oplaceMaybe Rect -> Maybe Rect -> Bool
forall a. Eq a => a -> a -> Bool
==Maybe Rect
forall a. Maybe a
Nothing then Sizing
Static else Sizing
Dynamic
sF :: Bool
-> Maybe Size
-> [FRequest]
-> K a b
-> F c d
-> F (Either a c) (Either b d)
sF Bool
nomap Maybe Size
pos [FRequest]
lc K a b
k F c d
f =
let r :: Maybe a
r = Maybe a
forall a. Maybe a
Nothing
p :: Maybe Size
p =
case Maybe Rect
forall a. Maybe a
r of
Just (Rect Size
p Size
_) -> Size -> Maybe Size
forall a. a -> Maybe a
Just Size
p
Maybe Rect
Nothing -> Maybe Size
pos
lc' :: [FRequest]
lc' =
case Maybe Size
p of
Just Size
p' -> XCommand -> FRequest
XCmd (Size -> XCommand
SetNormalHints Size
p') FRequest -> [FRequest] -> [FRequest]
forall a. a -> [a] -> [a]
: XCommand -> FRequest
XCmd (Size -> XCommand
moveWindow Size
p') FRequest -> [FRequest] -> [FRequest]
forall a. a -> [a] -> [a]
: [FRequest]
lc
Maybe Size
Nothing -> [FRequest]
lc
in Bool -> F (Either a c) (Either b d) -> F (Either a c) (Either b d)
forall a b. Bool -> F a b -> F a b
shell Bool
nomap
((Rect -> FRequest)
-> Bool
-> Bool
-> [FRequest]
-> Maybe Rect
-> K a b
-> F c d
-> F (Either a c) (Either b d)
forall a b c d.
(Rect -> FRequest)
-> Bool
-> Bool
-> [FRequest]
-> Maybe Rect
-> K a b
-> F c d
-> F (Either a c) (Either b d)
windowKF (XRequest -> FRequest
XReq (XRequest -> FRequest) -> (Rect -> XRequest) -> Rect -> FRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> String -> XRequest) -> String -> Rect -> XRequest
forall a b c. (a -> b -> c) -> b -> a -> c
flip Rect -> String -> XRequest
CreateRootWindow String
resourceName) Bool
True Bool
nomap [FRequest]
lc' Maybe Rect
forall a. Maybe a
r (K a b -> K a b
forall a b. K a b -> K a b
bgK K a b
k) F c d
f)
group0F :: Sizing
-> Bool
-> [FRequest]
-> Maybe Rect
-> K a b
-> Maybe (F c d)
-> F (Either a c) (Either b d)
group0F Sizing
sizing Bool
nomap [FRequest]
cmds Maybe Rect
r K a b
k Maybe (F c d)
mf =
case Maybe (F c d)
mf of
Maybe (F c d)
Nothing -> F c d -> F (Either a c) (Either b d)
forall c d. F c d -> F (Either a c) (Either b d)
w F c d
forall hi ho. F hi ho
nullF
Just F c d
f -> F c d -> F (Either a c) (Either b d)
forall c d. F c d -> F (Either a c) (Either b d)
w (F c d -> F (Either a c) (Either b d))
-> F c d -> F (Either a c) (Either b d)
forall a b. (a -> b) -> a -> b
$ Bool -> Sizing -> F c d -> F c d
forall a b. Bool -> Sizing -> F a b -> F a b
autoLayoutF' Bool
nowait Sizing
sizing F c d
f
where w :: F c d -> F (Either a c) (Either b d)
w = (Rect -> FRequest)
-> Bool
-> Bool
-> [FRequest]
-> Maybe Rect
-> K a b
-> F c d
-> F (Either a c) (Either b d)
forall a b c d.
(Rect -> FRequest)
-> Bool
-> Bool
-> [FRequest]
-> Maybe Rect
-> K a b
-> F c d
-> F (Either a c) (Either b d)
windowKF (XRequest -> FRequest
XReq (XRequest -> FRequest) -> (Rect -> XRequest) -> Rect -> FRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rect -> XRequest
CreateMyWindow) Bool
False Bool
nomap [FRequest]
cmds Maybe Rect
r K a b
k
sgroupF :: Sizing
-> [FRequest]
-> Maybe Rect
-> K a b
-> F c d
-> F (Either a c) (Either b d)
sgroupF Sizing
sizing [FRequest]
cmds Maybe Rect
r K a b
k = Sizing
-> Bool
-> [FRequest]
-> Maybe Rect
-> K a b
-> Maybe (F c d)
-> F (Either a c) (Either b d)
forall a b c d.
Sizing
-> Bool
-> [FRequest]
-> Maybe Rect
-> K a b
-> Maybe (F c d)
-> F (Either a c) (Either b d)
group0F Sizing
sizing Bool
False [FRequest]
cmds Maybe Rect
r K a b
k (Maybe (F c d) -> F (Either a c) (Either b d))
-> (F c d -> Maybe (F c d)) -> F c d -> F (Either a c) (Either b d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. F c d -> Maybe (F c d)
forall a. a -> Maybe a
Just
groupF' :: Sizing
-> [FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF' Sizing
sizing [FRequest]
cmds = Sizing
-> [FRequest]
-> Maybe Rect
-> K a b
-> F c d
-> F (Either a c) (Either b d)
forall a b c d.
Sizing
-> [FRequest]
-> Maybe Rect
-> K a b
-> F c d
-> F (Either a c) (Either b d)
sgroupF Sizing
sizing [FRequest]
cmds Maybe Rect
forall a. Maybe a
Nothing
groupF :: [FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF = Sizing
-> [FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
forall a b c d.
Sizing
-> [FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF' Sizing
Dynamic
unmappedGroupF :: Sizing
-> [FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
unmappedGroupF Sizing
sizing [FRequest]
cmds K a b
k = Sizing
-> Bool
-> [FRequest]
-> Maybe Rect
-> K a b
-> Maybe (F c d)
-> F (Either a c) (Either b d)
forall a b c d.
Sizing
-> Bool
-> [FRequest]
-> Maybe Rect
-> K a b
-> Maybe (F c d)
-> F (Either a c) (Either b d)
group0F Sizing
sizing Bool
True [FRequest]
cmds Maybe Rect
forall a. Maybe a
Nothing K a b
k (Maybe (F c d) -> F (Either a c) (Either b d))
-> (F c d -> Maybe (F c d)) -> F c d -> F (Either a c) (Either b d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. F c d -> Maybe (F c d)
forall a. a -> Maybe a
Just
simple :: (t -> t -> t -> t -> F (Either a b) (Either ho ho))
-> t -> t -> t -> t -> F b ho
simple t -> t -> t -> t -> F (Either a b) (Either ho ho)
sf t
sizing t
startcmds t
k t
w =
(b -> Either a b)
-> (Either ho ho -> ho) -> F (Either a b) (Either ho ho) -> F b ho
forall hi b c ho. (hi -> b) -> (c -> ho) -> F b c -> F hi ho
prepostMapHigh b -> Either a b
forall a b. b -> Either a b
Right Either ho ho -> ho
forall p. Either p p -> p
stripEither (t -> t -> t -> t -> F (Either a b) (Either ho ho)
sf t
sizing t
startcmds t
k t
w)
bgK :: K a b -> K a b
bgK = String -> K a b -> K a b
forall a b. String -> K a b -> K a b
changeBg String
bgColor
sGF :: Sizing -> K a ho -> [WindowAttributes] -> F b ho -> F b ho
sGF Sizing
sizing K a ho
k [WindowAttributes]
wattrs =
(Sizing
-> [FRequest] -> K a ho -> F b ho -> F (Either a b) (Either ho ho))
-> Sizing -> [FRequest] -> K a ho -> F b ho -> F b ho
forall t t t t a b ho.
(t -> t -> t -> t -> F (Either a b) (Either ho ho))
-> t -> t -> t -> t -> F b ho
simple Sizing
-> [FRequest] -> K a ho -> F b ho -> F (Either a b) (Either ho ho)
forall a b c d.
Sizing
-> [FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF' Sizing
sizing [XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [WindowAttributes]
wattrs] K a ho
k
simpleGroupF :: [WindowAttributes] -> F b ho -> F b ho
simpleGroupF = Sizing -> K Any ho -> [WindowAttributes] -> F b ho -> F b ho
forall a ho b.
Sizing -> K a ho -> [WindowAttributes] -> F b ho -> F b ho
sGF Sizing
Dynamic (K Any ho -> K Any ho
forall a b. K a b -> K a b
bgK K Any ho
forall hi ho. K hi ho
nullK)
invisibleGroupF :: Sizing -> [FRequest] -> [WindowAttributes] -> F b ho -> F b ho
invisibleGroupF Sizing
sizing [FRequest]
cmds =
Sizing -> K Any ho -> [WindowAttributes] -> F b ho -> F b ho
forall a ho b.
Sizing -> K a ho -> [WindowAttributes] -> F b ho -> F b ho
sGF Sizing
sizing (K Any ho -> K Any ho
forall a b. K a b -> K a b
bgK ([KCommand ho] -> K Any ho -> K Any ho
forall b a. [KCommand b] -> K a b -> K a b
putsK ((FRequest -> KCommand ho) -> [FRequest] -> [KCommand ho]
forall a b. (a -> b) -> [a] -> [b]
map FRequest -> KCommand ho
forall a b. a -> Message a b
Low [FRequest]
cmds) K Any ho
forall hi ho. K hi ho
nullK))