module RootWindowF where
import Command
--import Event
--import Font(FontStruct)
--import Fudget
--import Message(Message(..))
import Geometry(Rect(..),origin,pP)
--import Path
import WindowF(kernelF)
--import NullF(putK)
--import Xrequest(xrequestF)
import Xcommand(xcommandK)
import QueryTree
import UserLayoutF(userLayoutF)
import CompOps
import SerCompF(absF)
import Loops(loopThroughRightF)
import Spops(mapSP)
import AutoLayout(autoLayoutF)
--import CmdLineEnv(argReadKey)
--import NullF(nullF)
import WindowF(kernelTag)

{-
rootWindowF k =
    defaultRootWindowF $ \ root ->
    kernelF (putK (Low (ReparentToMe kernelTag root)) k) >*< nullF
-}
  
rootWindowF :: K b c -> F b c
rootWindowF K b c
k =
    Cont (F b c) Window
forall b c. Cont (F b c) Window
defaultRootWindowF Cont (F b c) Window -> Cont (F b c) Window
forall a b. (a -> b) -> a -> b
$ \ Window
root ->
    K b c -> F b c
forall a b. K a b -> F a b
kernelF (XCommand -> K b c -> K b c
forall i o. XCommand -> K i o -> K i o
xcommandK (Window -> XCommand
SelectWindow Window
root) K b c
k)
  
rootGroupF :: K a b -> F c d -> F (Either a c) (Either b d)
rootGroupF K a b
k F c d
f =
    F a b
k' F 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'
  where
    k' :: F a b
k' = K a b -> F a b
forall a b. K a b -> F a b
kernelF (
            Cont (K a b) Window
forall b c. Cont (K b c) Window
defaultRootWindowK Cont (K a b) Window -> Cont (K a b) Window
forall a b. (a -> b) -> a -> b
$ \ Window
root ->
            XCommand -> K a b -> K a b
forall i o. XCommand -> K i o -> K i o
xcommandK (Path -> Window -> XCommand
ReparentToMe Path
kernelTag Window
root) K a b
k)
    f' :: F c d
f' = F (Either (Either (Path, LayoutMessage) d) c)
  (Either (Either (Path, Rect) c) d)
-> F (Either (Path, Rect) c) (Either (Path, LayoutMessage) d)
-> F c d
forall a b c d. F (Either a b) (Either c d) -> F c a -> F b d
loopThroughRightF (SP
  (Either (Either (Path, LayoutMessage) d) c)
  (Either (Either (Path, Rect) c) d)
-> F (Either (Either (Path, LayoutMessage) d) c)
     (Either (Either (Path, Rect) c) d)
forall a b. SP a b -> F a b
absF SP
  (Either (Either (Path, LayoutMessage) d) c)
  (Either (Either (Path, Rect) c) d)
forall a b b b.
SP (Either (Either (a, b) b) b) (Either (Either (a, Rect) b) b)
ctrlSP) (F c d -> F (Either (Path, Rect) c) (Either (Path, LayoutMessage) d)
forall a b.
F a b -> F (Either (Path, Rect) a) (Either (Path, LayoutMessage) b)
userLayoutF (F c d -> F c d
forall a b. F a b -> F a b
autoLayoutF F c d
f))
    ctrlSP :: SP (Either (Either (a, b) b) b) (Either (Either (a, Rect) b) b)
ctrlSP = (Either (Either (a, b) b) b -> Either (Either (a, Rect) b) b)
-> SP (Either (Either (a, b) b) b) (Either (Either (a, Rect) b) b)
forall t b. (t -> b) -> SP t b
mapSP Either (Either (a, b) b) b -> Either (Either (a, Rect) b) b
forall a b b b.
Either (Either (a, b) b) b -> Either (Either (a, Rect) b) b
ctrl
    ctrl :: Either (Either (a, b) b) b -> Either (Either (a, Rect) b) b
ctrl Either (Either (a, b) b) b
msg =
      case Either (Either (a, b) b) b
msg of
        Left (Left (a
path,b
req)) -> Either (a, Rect) b -> Either (Either (a, Rect) b) b
forall a b. a -> Either a b
Left ((a, Rect) -> Either (a, Rect) b
forall a b. a -> Either a b
Left (a
path,Rect
screenrect))
	Left (Right b
x) -> b -> Either (Either (a, Rect) b) b
forall a b. b -> Either a b
Right b
x
	Right b
x -> Either (a, Rect) b -> Either (Either (a, Rect) b) b
forall a b. a -> Either a b
Left (b -> Either (a, Rect) b
forall a b. b -> Either a b
Right b
x)
	
    screenrect :: Rect
screenrect = Point -> Point -> Rect
Rect Point
origin (Int -> Int -> Point
pP Int
1152 Int
900)
    -- !!! no Read instance...
    --screenrect = Rect origin (argReadKey "screensize" (pP 1152 900)) -- !!!