module Dlayout(invisibleGroupF,
               simpleGroupF, unmappedGroupF, groupF, groupF',
	       sgroupF, swindowF,
               windowF,sF) where
--import Alignment(Alignment(..))
import Command
import CompFfun(prepostMapHigh)
--import CompOps((>=^^<), (>^=<),(>..=<))
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 Message(Message(..))
import NullF
import Spops
--import SpEither(mapFilterSP)
import AutoLayout(autoLayoutF',nowait)
import Sizing(Sizing(..))
import EitherUtils(stripEither)
--import Utils(oo)
import WindowF
import Xtypes
--import Placer(placerF,spacerF)
--import Spacers
--import AutoPlacer(autoP)
import ParSP
--import CompSP
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 forall a. [a] -> [a] -> [a]
++ [EventMask]
mask) forall a. a -> [a] -> [a]
: [WindowAttributes]
wattrs
        addem (WindowAttributes
wattr : [WindowAttributes]
wattrs) = WindowAttributes
wattr forall a. a -> [a] -> [a]
: [WindowAttributes] -> [WindowAttributes]
addem [WindowAttributes]
wattrs
    in  [WindowAttributes] -> [WindowAttributes]
addem

shell :: Bool -> (F a b) -> F a b
shell :: forall a b. 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 forall a. Eq a => a -> a -> Bool
== Path
kernelTag = case [Size]
sizeq of 
	     (Size
size:[Size]
sizeq') | Size
size forall a. Eq a => a -> a -> Bool
== Size
nsize -> ((Size
nsize,[Size]
sizeq',forall a. a -> Maybe a
Just Path
ltag),[])
	     [Size]
_ -> if Size
nsize forall a. Eq a => a -> a -> Bool
== Size
osize then ((Size, [Size], Maybe Path)
ss,[]) else
	        ((Size
nsize,[Size]
sizeq,forall a. a -> Maybe a
Just Path
ltag),[(Path
ltag,LayoutResponse -> FResponse
LEvt 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 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 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 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]
sizeqforall a. [a] -> [a] -> [a]
++ (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Size]
sizeq Bool -> Bool -> Bool
|| forall a. [a] -> a
last [Size]
sizeq forall a. Eq a => a -> a -> Bool
/= Size
nsize then [Size
nsize] else []), forall a. a -> Maybe a
Just Path
tag),
	   [(Path
tag, LayoutResponse -> FResponse
LEvt 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 forall a b. (a -> b) -> a -> b
$ Direction -> Path -> Path
turn Direction
L Path
here -- hardwired assumption
        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,
             forall a b. b -> Message a b
High (Path
tag, Size
size) forall a. a -> [a] -> [a]
:
             forall {a} {b}. [a] -> [Message (Path, a) b]
toKernel ([XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ Size -> XCommand
resizeWindow (Size -> Size -> Size
pmax Size
minSize Size
size)] forall a. [a] -> [a] -> [a]
++
                       (if Bool
nomap' then [] else [XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ XCommand
MapRaised])))
            -- we should actually wait with MapRaised until f reports OK somehow...
          LayoutMessage
_ -> (Bool
nomap',[]) {- filter all other layout msgs -}
        post Bool
nomap' (Path
tag, XCmd (ChangeWindowAttributes [WindowAttributes]
wattrs)) | Path
tag forall a. Eq a => a -> a -> Bool
== Path
kernelTag =
            (Bool
nomap',
             [forall a b. a -> Message a b
Low (Path
tag, XCommand -> FRequest
XCmd 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',[forall a b. a -> Message a b
Low (Path, FRequest)
cmd])
        post Bool
nomap' (Path, FRequest)
cmd = (Bool
nomap', [forall a b. a -> Message a b
Low (Path, FRequest)
cmd])
        startcmds :: [Message (Path, FRequest) b]
startcmds = forall {a} {b}. [a] -> [Message (Path, a) b]
toKernel [XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [[EventMask] -> WindowAttributes
CWEventMask []],
                              XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ Bool -> XCommand
SetWMHints Bool
True]
    in  forall a b c.
SP (Path, FRequest) (FCommand a)
-> SP (FEvent a) (Path, FResponse) -> F b c -> F b c
loopLow (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)
                (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),[], forall a. Maybe a
Nothing)) {- 10 10 from windowKF... -}
                (forall {ho} {hi}. [FCommand ho] -> F hi ho -> F hi ho
myAppendStartF forall {b}. [Message (Path, FRequest) b]
startcmds F a b
f)

mapstateSP' :: (t -> t -> (t, [b])) -> t -> SP t b
mapstateSP' t -> t -> (t, [b])
f t
s0 =
    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) -> 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))
{-
-- causes a space leak with nhc13 and ghc-7.6
mapstateSP' f s0 =
    getSP (\x ->
           let (s, y) = f s0 x
           in putsSP y (mapstateSP' f s))
-}
-- myAppendStart will let f speak all its initial msgs, not just the first one.
myAppendStartF :: [FCommand ho] -> F hi ho -> F hi ho
myAppendStartF [FCommand ho]
cmds (F FSP hi ho
f) = {-F-}forall {hi} {ho}. FSP hi ho -> F hi ho
ff forall a b. (a -> b) -> a -> b
$ forall {a} {b}. SP a b -> SP a b -> SP a b
parSP FSP hi ho
f (forall b a. [b] -> SP a b -> SP a b
putsSP [FCommand ho]
cmds forall a b. SP a b
nullSP)

windowF :: [FRequest] -> (K a b) -> F a b
windowF :: forall a b. [FRequest] -> K a b -> F a b
windowF [FRequest]
cmds = forall {hi} {ho}. [FRequest] -> Maybe Rect -> K hi ho -> F hi ho
swindowF [FRequest]
cmds forall a. Maybe a
Nothing

swindowF :: [FRequest] -> Maybe Rect -> K hi ho -> F hi ho
swindowF [FRequest]
cmd Maybe Rect
oplace K hi ho
k = 
    forall {hi} {b} {c} {ho}.
(hi -> b) -> (c -> ho) -> F b c -> F hi ho
prepostMapHigh forall a b. a -> Either a b
Left forall {a}. Either a a -> a
stripEither (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 hi ho
k forall a. Maybe a
Nothing)
  where sizing :: Sizing
sizing = if Maybe Rect
oplaceforall a. Eq a => a -> a -> Bool
==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 = forall a. Maybe a
Nothing -- temporary
        p :: Maybe Size
p =
            case forall a. Maybe a
r of
              Just (Rect Size
p 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') forall a. a -> [a] -> [a]
: XCommand -> FRequest
XCmd (Size -> XCommand
moveWindow Size
p') forall a. a -> [a] -> [a]
: [FRequest]
lc
              Maybe Size
Nothing -> [FRequest]
lc
    in forall a b. Bool -> F a b -> F a b
shell Bool
nomap
          (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip Rect -> String -> XRequest
CreateRootWindow String
resourceName) Bool
True Bool
nomap [FRequest]
lc' forall a. Maybe a
r (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 -> forall {c} {d}. F c d -> F (Either a c) (Either b d)
w forall {hi} {ho}. F hi ho
nullF
      Just F c d
f -> forall {c} {d}. F c d -> F (Either a c) (Either b d)
w forall a b. (a -> b) -> a -> b
$ 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 = 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 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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 forall a. Maybe a
Nothing
groupF :: [FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF = 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 = 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 forall a. Maybe a
Nothing K a b
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just


simple :: (t -> t -> t -> t -> F (Either a hi) (Either ho ho))
-> t -> t -> t -> t -> F hi ho
simple t -> t -> t -> t -> F (Either a hi) (Either ho ho)
sf t
sizing t
startcmds t
k t
w =
    forall {hi} {b} {c} {ho}.
(hi -> b) -> (c -> ho) -> F b c -> F hi ho
prepostMapHigh forall a b. b -> Either a b
Right forall {a}. Either a a -> a
stripEither (t -> t -> t -> t -> F (Either a hi) (Either ho ho)
sf t
sizing t
startcmds t
k t
w)

bgK :: K a b -> K a b
bgK = forall a b. String -> K a b -> K a b
changeBg String
bgColor

--sGF :: (K a b) -> [WindowAttributes] -> (F a b) -> F a b
sGF :: Sizing -> K a ho -> [WindowAttributes] -> F hi ho -> F hi ho
sGF Sizing
sizing K a ho
k [WindowAttributes]
wattrs =
  forall {t} {t} {t} {t} {a} {hi} {ho}.
(t -> t -> t -> t -> F (Either a hi) (Either ho ho))
-> t -> t -> t -> t -> F hi ho
simple 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 forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [WindowAttributes]
wattrs] K a ho
k

simpleGroupF :: [WindowAttributes] -> F hi ho -> F hi ho
simpleGroupF = forall {a} {ho} {hi}.
Sizing -> K a ho -> [WindowAttributes] -> F hi ho -> F hi ho
sGF Sizing
Dynamic (forall {a} {b}. K a b -> K a b
bgK forall {hi} {ho}. K hi ho
nullK)
invisibleGroupF :: Sizing -> [FRequest] -> [WindowAttributes] -> F hi ho -> F hi ho
invisibleGroupF Sizing
sizing [FRequest]
cmds = 
     forall {a} {ho} {hi}.
Sizing -> K a ho -> [WindowAttributes] -> F hi ho -> F hi ho
sGF Sizing
sizing (forall {a} {b}. K a b -> K a b
bgK (forall {b} {a}. [KCommand b] -> K a b -> K a b
putsK (forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Message a b
Low [FRequest]
cmds) forall {hi} {ho}. K hi ho
nullK))