module WindowF(adjustBorderWidth,border_width,getBWidth,kernelF, toKernel, kernelTag,autumnize, windowKF) where
import Command
import CompOps((>+<))
import CompSP(prepostMapSP)
--import CompSP(serCompSP)
import Utils(pair,mapList)
import Direction
import Event
--import Font(FontStruct)
import Fudget
import FRequest
import Geometry(Point(..), Rect(..), origin, padd, pmax, rR)
import LayoutRequest
import LoopLow
--import Message(Message(..))
import NullF
import Path
--import SerCompF(idRightF)
import CompFfun(prepostMapLow)
import Spops
--import EitherUtils
import Data.Maybe(fromMaybe,isJust)
import Xtypes
import CmdLineEnv(argFlag)
--import DialogueIO hiding (IOError)

kernelF :: (K a b) -> F a b
kernelF :: K a b -> F a b
kernelF (K KSP a b
proc) =
    let prep :: Message (a, a) b -> Message a b
prep (High b
a) = b -> Message a b
forall a b. b -> Message a b
High b
a
        prep (Low (a
_, a
b)) = a -> Message a b
forall a b. a -> Message a b
Low a
b
        post :: Message b b -> Message (Path, b) b
post (High b
a) = b -> Message (Path, b) b
forall a b. b -> Message a b
High b
a
        post (Low b
b) = (Path, b) -> Message (Path, b) b
forall a b. a -> Message a b
Low (Path
here, b
b)
    in  {-F-}FSP a b -> F a b
forall hi ho. FSP hi ho -> F hi ho
ff ((Message (Path, FResponse) a -> Message FResponse a)
-> (Message FRequest b -> Message (Path, FRequest) b)
-> KSP a b
-> FSP a b
forall t1 a t2 b. (t1 -> a) -> (t2 -> b) -> SP a t2 -> SP t1 b
prepostMapSP Message (Path, FResponse) a -> Message FResponse a
forall a a b. Message (a, a) b -> Message a b
prep Message FRequest b -> Message (Path, FRequest) b
forall b b. Message b b -> Message (Path, b) b
post KSP a b
proc)

toLowHere :: [b] -> [Message (Path, b) b]
toLowHere = (b -> Message (Path, b) b) -> [b] -> [Message (Path, b) b]
forall a b. (a -> b) -> [a] -> [b]
mapList ((Path, b) -> Message (Path, b) b
forall a b. a -> Message a b
Low ((Path, b) -> Message (Path, b) b)
-> (b -> (Path, b)) -> b -> Message (Path, b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> b -> (Path, b)
forall a b. a -> b -> (a, b)
pair Path
here)

winF :: (Rect -> FRequest) -> [FRequest] -> Rect -> K a b -> F a b
winF :: (Rect -> FRequest) -> [FRequest] -> Rect -> K a b -> F a b
winF Rect -> FRequest
winCmd [FRequest]
startcmds Rect
rect K a b
w =
    [FCommand b] -> F a b -> F a b
forall ho hi. [FCommand ho] -> F hi ho -> F hi ho
putMessagesF ([FRequest] -> [FCommand b]
forall b b. [b] -> [Message (Path, b) b]
toLowHere (Rect -> FRequest
winCmd Rect
rect FRequest -> [FRequest] -> [FRequest]
forall a. a -> [a] -> [a]
: [FRequest]
startcmds)) (K a b -> F a b
forall a b. K a b -> F a b
kernelF K a b
w)

newKTag :: Bool
newKTag = Bool -> Bool
not ([Char] -> Bool -> Bool
argFlag [Char]
"oldKTag" Bool
True) -- trouble with autolayout...

kernelTag :: Path
kernelTag = if Bool
newKTag then Path
here else Direction -> Path -> Path
turn Direction
L Path
here
autumnize :: [a] -> [a]
autumnize  = if Bool
newKTag then [a] -> [a]
forall a. a -> a
id else [a] -> [a]
forall a. [a] -> [a]
autumnize' where
  autumnize' :: [a] -> [a]
autumnize' [] = []
  autumnize' [a]
l = ([a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
tail ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse) [a]
l


toKernel :: [b] -> [Message (Path, b) b]
toKernel [b]
x = (b -> Message (Path, b) b) -> [b] -> [Message (Path, b) b]
forall a b. (a -> b) -> [a] -> [b]
mapList ((Path, b) -> Message (Path, b) b
forall a b. a -> Message a b
Low ((Path, b) -> Message (Path, b) b)
-> (b -> (Path, b)) -> b -> Message (Path, b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> b -> (Path, b)
forall a b. a -> b -> (a, b)
pair Path
kernelTag) [b]
x

getBWidth :: [WindowChanges] -> Maybe Int
getBWidth [WindowChanges]
cws = case [WindowChanges]
cws of
   [] -> Maybe Int
forall a. Maybe a
Nothing
   CWBorderWidth Int
bw':[WindowChanges]
_ -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
bw'
   WindowChanges
_:[WindowChanges]
cws -> [WindowChanges] -> Maybe Int
getBWidth [WindowChanges]
cws

adjustBorderWidth :: Int -> Point -> Point
adjustBorderWidth Int
b (Point Int
x Int
y) = Int -> Int -> Point
Point (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b2) (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b2) where b2 :: Int
b2 = Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
b

border_width :: Int
border_width = Int
0::Int -- Should agree with the value in the core for XCreateSimpleWindow in xdecode.c and ghc-dialogue/DoXRequest.hs

windowKF :: (Rect -> FRequest) -> Bool -> Bool -> [FRequest] -> Maybe Rect -> K a b -> F c d -> F (Either a c) (Either b d)
windowKF :: (Rect -> FRequest)
-> Bool
-> Bool
-> [FRequest]
-> Maybe Rect
-> K a b
-> F c d
-> F (Either a c) (Either b d)
windowKF Rect -> FRequest
winCmd Bool
isShell Bool
nomap [FRequest]
startcmds Maybe Rect
oplace K a b
k F c d
f =
 let ctrlSP :: (Int, Bool)
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
ctrlSP (Int
bw,Bool
nomap) =
       Cont
  (SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse)))
  (Either (Path, FRequest) (Path, FResponse))
forall a b. Cont (SP a b) a
getSP Cont
  (SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse)))
  (Either (Path, FRequest) (Path, FResponse))
-> Cont
     (SP
        (Either (Path, FRequest) (Path, FResponse))
        (Either (Path, FRequest) (Path, FResponse)))
     (Either (Path, FRequest) (Path, FResponse))
forall a b. (a -> b) -> a -> b
$ \Either (Path, FRequest) (Path, FResponse)
msg ->
       let same :: SP
  (Either (Path, FRequest) (Path, FResponse))
  (Either (Path, FRequest) (Path, FResponse))
same = (Int, Bool)
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
ctrlSP (Int
bw,Bool
nomap)
           pass :: SP a (Either (Path, FRequest) (Path, FResponse))
-> SP a (Either (Path, FRequest) (Path, FResponse))
pass = Either (Path, FRequest) (Path, FResponse)
-> SP a (Either (Path, FRequest) (Path, FResponse))
-> SP a (Either (Path, FRequest) (Path, FResponse))
forall b a. b -> SP a b -> SP a b
putSP Either (Path, FRequest) (Path, FResponse)
msg 
	   passame :: SP
  (Either (Path, FRequest) (Path, FResponse))
  (Either (Path, FRequest) (Path, FResponse))
passame = SP
  (Either (Path, FRequest) (Path, FResponse))
  (Either (Path, FRequest) (Path, FResponse))
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
forall a.
SP a (Either (Path, FRequest) (Path, FResponse))
-> SP a (Either (Path, FRequest) (Path, FResponse))
pass SP
  (Either (Path, FRequest) (Path, FResponse))
  (Either (Path, FRequest) (Path, FResponse))
same
	   adjB :: Int -> Point -> Point
adjB Int
b Point
s = if Bool
isShell then Point
s else Int -> Point -> Point
adjustBorderWidth Int
b Point
s
       in case Either (Path, FRequest) (Path, FResponse)
msg of
         Left (Path
tag,FRequest
cmd) -> case FRequest
cmd of
            XReq (CreateMyWindow Rect
r) | Path
tag Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
/= Path
kernelTag ->
		   Either (Path, FRequest) (Path, FResponse)
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
forall b a. b -> SP a b -> SP a b
putSP ((Path, FRequest) -> Either (Path, FRequest) (Path, FResponse)
forall a b. a -> Either a b
Left (Path
kernelTag, 
	                    XRequest -> FRequest
XReq (Path -> Rect -> XRequest
CreateSimpleWindow Path
tag Rect
r))) SP
  (Either (Path, FRequest) (Path, FResponse))
  (Either (Path, FRequest) (Path, FResponse))
same
	    XCmd (ReparentToMe Path
r Window
w) | Path
r Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
here Bool -> Bool -> Bool
&& Path
tag Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
/= Path
kernelTag ->
		   Either (Path, FRequest) (Path, FResponse)
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
forall b a. b -> SP a b -> SP a b
putSP ((Path, FRequest) -> Either (Path, FRequest) (Path, FResponse)
forall a b. a -> Either a b
Left (Path
kernelTag,XCommand -> FRequest
XCmd (Path -> Window -> XCommand
ReparentToMe Path
tag Window
w))) SP
  (Either (Path, FRequest) (Path, FResponse))
  (Either (Path, FRequest) (Path, FResponse))
same
            XCmd (ConfigureWindow [WindowChanges]
cws) | Path
tag Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
kernelTag -> 
	        -- hopefully, this occurs before LayoutMsg
		let bw' :: Int
bw' = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
bw ([WindowChanges] -> Maybe Int
getBWidth [WindowChanges]
cws) in
		if Int
bw'Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
bw' then SP
  (Either (Path, FRequest) (Path, FResponse))
  (Either (Path, FRequest) (Path, FResponse))
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
forall a.
SP a (Either (Path, FRequest) (Path, FResponse))
-> SP a (Either (Path, FRequest) (Path, FResponse))
pass (SP
   (Either (Path, FRequest) (Path, FResponse))
   (Either (Path, FRequest) (Path, FResponse))
 -> SP
      (Either (Path, FRequest) (Path, FResponse))
      (Either (Path, FRequest) (Path, FResponse)))
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
forall a b. (a -> b) -> a -> b
$ (Int, Bool)
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
ctrlSP (Int
bw',Bool
nomap) else [Char]
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
forall a. HasCallStack => [Char] -> a
error [Char]
"windowKF"
            LCmd (LayoutRequest LayoutRequest
req) ->
	        Either (Path, FRequest) (Path, FResponse)
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
forall b a. b -> SP a b -> SP a b
putSP ((Path, FRequest) -> Either (Path, FRequest) (Path, FResponse)
forall a b. a -> Either a b
Left (Path
tag,LayoutRequest -> FRequest
layoutRequestCmd ((Point -> Point) -> LayoutRequest -> LayoutRequest
mapLayoutSize (Int -> Point -> Point
adjB Int
bw) LayoutRequest
req))) (SP
   (Either (Path, FRequest) (Path, FResponse))
   (Either (Path, FRequest) (Path, FResponse))
 -> SP
      (Either (Path, FRequest) (Path, FResponse))
      (Either (Path, FRequest) (Path, FResponse)))
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
forall a b. (a -> b) -> a -> b
$
		SP
  (Either (Path, FRequest) (Path, FResponse))
  (Either (Path, FRequest) (Path, FResponse))
same
	    FRequest
_ -> SP
  (Either (Path, FRequest) (Path, FResponse))
  (Either (Path, FRequest) (Path, FResponse))
passame
	 Right (Path
tag,FResponse
evt) -> case FResponse
evt of
	    XResp (WindowCreated Window
_) | Path
tagPath -> Path -> Bool
forall a. Eq a => a -> a -> Bool
==Path
kernelTag -> SP
  (Either (Path, FRequest) (Path, FResponse))
  (Either (Path, FRequest) (Path, FResponse))
same 
	    -- does not correspond to internal request
            LEvt (LayoutPlace (Rect Point
p Point
s)) -> let ads :: Point
ads = Int -> Point -> Point
adjB (-Int
bw) Point
s in
	       [Either (Path, FRequest) (Path, FResponse)]
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
forall b a. [b] -> SP a b -> SP a b
putsSP ([(Path, FResponse) -> Either (Path, FRequest) (Path, FResponse)
forall a b. b -> Either a b
Right (Path
tag, LayoutResponse -> FResponse
LEvt (Rect -> LayoutResponse
LayoutPlace (Point -> Point -> Rect
Rect Point
origin Point
ads))),
		      (Path, FResponse) -> Either (Path, FRequest) (Path, FResponse)
forall a b. b -> Either a b
Right (Path
kernelTag, LayoutResponse -> FResponse
LEvt (Point -> LayoutResponse
LayoutSize Point
ads)),
		      (Path, FResponse) -> Either (Path, FRequest) (Path, FResponse)
forall a b. b -> Either a b
Right (Path
kernelTag, LayoutResponse -> FResponse
LEvt (Point -> LayoutResponse
LayoutPos Point
p))] [Either (Path, FRequest) (Path, FResponse)]
-> [Either (Path, FRequest) (Path, FResponse)]
-> [Either (Path, FRequest) (Path, FResponse)]
forall a. [a] -> [a] -> [a]
++   -- TH 990321
		       (if Bool
isShell then []
		        else (FRequest -> Either (Path, FRequest) (Path, FResponse))
-> [FRequest] -> [Either (Path, FRequest) (Path, FResponse)]
forall a b. (a -> b) -> [a] -> [b]
mapList ((Path, FRequest) -> Either (Path, FRequest) (Path, FResponse)
forall a b. a -> Either a b
Left((Path, FRequest) -> Either (Path, FRequest) (Path, FResponse))
-> (FRequest -> (Path, FRequest))
-> FRequest
-> Either (Path, FRequest) (Path, FResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> FRequest -> (Path, FRequest)
forall a b. a -> b -> (a, b)
pair Path
kernelTag)
			         ([XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ Rect -> XCommand
moveResizeWindow (Rect -> Rect
checkSize (Point -> Point -> Rect
Rect Point
p Point
ads))] [FRequest] -> [FRequest] -> [FRequest]
forall a. [a] -> [a] -> [a]
++
			          (if Bool
nomap Bool -> Bool -> Bool
|| Bool
static then []
				   else [XCommand -> FRequest
XCmd XCommand
MapRaised])))) (SP
   (Either (Path, FRequest) (Path, FResponse))
   (Either (Path, FRequest) (Path, FResponse))
 -> SP
      (Either (Path, FRequest) (Path, FResponse))
      (Either (Path, FRequest) (Path, FResponse)))
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
forall a b. (a -> b) -> a -> b
$
               (Int, Bool)
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
ctrlSP (Int
bw,Bool
True)
	    -- The LayoutSize message is not sent by the ordinary layout
	    -- system, but by popupGroupF for convenience, to resize the
	    -- window without moving it.
            LEvt (LayoutSize Point
s) -> let ads :: Point
ads = Int -> Point -> Point
adjB (-Int
bw) Point
s in
	       [Either (Path, FRequest) (Path, FResponse)]
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
forall b a. [b] -> SP a b -> SP a b
putsSP ([(Path, FResponse) -> Either (Path, FRequest) (Path, FResponse)
forall a b. b -> Either a b
Right (Path
tag, LayoutResponse -> FResponse
LEvt (Rect -> LayoutResponse
LayoutPlace (Point -> Point -> Rect
Rect Point
origin Point
ads))),
		      (Path, FResponse) -> Either (Path, FRequest) (Path, FResponse)
forall a b. b -> Either a b
Right (Path
kernelTag, LayoutResponse -> FResponse
LEvt (Point -> LayoutResponse
LayoutSize Point
ads))] [Either (Path, FRequest) (Path, FResponse)]
-> [Either (Path, FRequest) (Path, FResponse)]
-> [Either (Path, FRequest) (Path, FResponse)]
forall a. [a] -> [a] -> [a]
++
		       (if Bool
isShell then []
		        else [((Path, FRequest) -> Either (Path, FRequest) (Path, FResponse)
forall a b. a -> Either a b
Left((Path, FRequest) -> Either (Path, FRequest) (Path, FResponse))
-> (FRequest -> (Path, FRequest))
-> FRequest
-> Either (Path, FRequest) (Path, FResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> FRequest -> (Path, FRequest)
forall a b. a -> b -> (a, b)
pair Path
kernelTag)
			        (XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ Point -> XCommand
resizeWindow (Point -> Point -> Point
pmax Point
ads Point
minSize))])) (SP
   (Either (Path, FRequest) (Path, FResponse))
   (Either (Path, FRequest) (Path, FResponse))
 -> SP
      (Either (Path, FRequest) (Path, FResponse))
      (Either (Path, FRequest) (Path, FResponse)))
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
forall a b. (a -> b) -> a -> b
$
               SP
  (Either (Path, FRequest) (Path, FResponse))
  (Either (Path, FRequest) (Path, FResponse))
same
	    FResponse
_ -> SP
  (Either (Path, FRequest) (Path, FResponse))
  (Either (Path, FRequest) (Path, FResponse))
passame

     minSize :: Point
minSize = Int -> Int -> Point
Point Int
1 Int
1
     checkSize :: Rect -> Rect
checkSize (Rect Point
p Point
s) = Point -> Point -> Rect
Rect Point
p (Point -> Point -> Point
pmax Point
s Point
minSize)
     static :: Bool
static = Maybe Rect -> Bool
forall a. Maybe a -> Bool
isJust Maybe Rect
oplace
     startplace :: Rect
startplace =
	 case Maybe Rect
oplace of
	   Maybe Rect
Nothing -> Int -> Int -> Int -> Int -> Rect
rR Int
0 Int
0 Int
10 Int
10
	   Just Rect
p -> Rect
p
     statlimits :: Rect -> FRequest
statlimits (Rect Point
p Point
s) = LayoutRequest -> FRequest
layoutRequestCmd (Point -> Bool -> Bool -> LayoutRequest
plainLayout (Point -> Point -> Point
padd Point
p Point
s) Bool
True Bool
True)
     wf :: F a b
wf =
	 (Rect -> FRequest) -> [FRequest] -> Rect -> K a b -> F a b
forall a b.
(Rect -> FRequest) -> [FRequest] -> Rect -> K a b -> F a b
winF Rect -> FRequest
winCmd
	      ([FRequest]
startcmds [FRequest] -> [FRequest] -> [FRequest]
forall a. [a] -> [a] -> [a]
++
	       (case Maybe Rect
oplace of
		  Maybe Rect
Nothing -> []
		  Just Rect
r -> [Rect -> FRequest
statlimits Rect
r] [FRequest] -> [FRequest] -> [FRequest]
forall a. [a] -> [a] -> [a]
++
			    (if Bool
nomap then [] else [XCommand -> FRequest
XCmd XCommand
MapRaised])))
	      Rect
startplace
	      K a b
k
     wff :: F (Either a c) (Either b d)
wff = F (Either a c) (Either b d) -> F (Either a c) (Either b d)
forall hi ho. F hi ho -> F hi ho
adjTag (F a b
wfF a b -> F c d -> F (Either a c) (Either b d)
forall a b c d. F a b -> F c d -> F (Either a c) (Either b d)
>+<F c d
f)
     adjTag :: F hi ho -> F hi ho
adjTag = if Bool
newKTag then ((Path, FResponse) -> (Path, FResponse))
-> ((Path, FRequest) -> (Path, FRequest)) -> F hi ho -> F hi ho
forall hi ho.
((Path, FResponse) -> (Path, FResponse))
-> ((Path, FRequest) -> (Path, FRequest)) -> F hi ho -> F hi ho
prepostMapLow (Path, FResponse) -> (Path, FResponse)
forall b. (Path, b) -> (Path, b)
addktag (Path, FRequest) -> (Path, FRequest)
forall b. (Path, b) -> (Path, b)
removektag else F hi ho -> F hi ho
forall a. a -> a
id where
	    addktag :: (Path, b) -> (Path, b)
addktag ([],b
m) = ([Direction
L],b
m)
	    addktag (Path, b)
tm = (Path, b)
tm
	    removektag :: (Path, b) -> (Path, b)
removektag ([Direction
L],b
m) = ([],b
m)
	    removektag (Path, b)
tm = (Path, b)
tm

     windowf :: F (Either a c) (Either b d)
windowf = SP
  (Either (Path, FRequest) (Path, FResponse))
  (Either (Path, FRequest) (Path, FResponse))
-> F (Either a c) (Either b d) -> F (Either a c) (Either b d)
forall i o.
SP
  (Either (Path, FRequest) (Path, FResponse))
  (Either (Path, FRequest) (Path, FResponse))
-> F i o -> F i o
loopThroughLowF ((Int, Bool)
-> SP
     (Either (Path, FRequest) (Path, FResponse))
     (Either (Path, FRequest) (Path, FResponse))
ctrlSP (Int
border_width,Bool
nomap)) F (Either a c) (Either b d)
wff
     --windowf = windowf' ctrlSP nomap wf f
 in  case Maybe Rect
oplace of
          Maybe Rect
Nothing -> F (Either a c) (Either b d)
windowf
          Just Rect
place -> let prep' :: Message (a, FResponse) a -> [(a, FResponse)]
prep' (High a
ltag) = [(a
ltag, LayoutResponse -> FResponse
LEvt (Rect -> LayoutResponse
LayoutPlace Rect
place))]
                            prep' (Low (a
_, LEvt (LayoutPlace Rect
_))) = []
                            prep' (Low (a, FResponse)
msg) = [(a, FResponse)
msg]
                            post' :: (b, FRequest) -> [Message (b, FRequest) b]
post' (b
ltag, LCmd LayoutMessage
_) = [b -> Message (b, FRequest) b
forall a b. b -> Message a b
High b
ltag]
                            post' (b, FRequest)
cmd = [(b, FRequest) -> Message (b, FRequest) b
forall a b. a -> Message a b
Low (b, FRequest)
cmd]
                        in  SP (Path, FRequest) (FCommand Path)
-> SP (FEvent Path) (Path, FResponse)
-> F (Either a c) (Either b d)
-> F (Either a c) (Either b d)
forall a b c.
SP (Path, FRequest) (FCommand a)
-> SP (FEvent a) (Path, FResponse) -> F b c -> F b c
loopLow (((Path, FRequest) -> [FCommand Path])
-> SP (Path, FRequest) (FCommand Path)
forall t b. (t -> [b]) -> SP t b
concmapSP (Path, FRequest) -> [FCommand Path]
forall b. (b, FRequest) -> [Message (b, FRequest) b]
post') ((FEvent Path -> [(Path, FResponse)])
-> SP (FEvent Path) (Path, FResponse)
forall t b. (t -> [b]) -> SP t b
concmapSP FEvent Path -> [(Path, FResponse)]
forall a. Message (a, FResponse) a -> [(a, FResponse)]
prep') F (Either a c) (Either b d)
windowf

{-
windowf' ctrlSP nomap wf f =
  let wff = wf>+<f
      windowf = loopThroughLowF (ctrlSP (border_width,nomap)) wff
  in windowf
--}