module SimpleF(Drawer(..), Fms'(..), MapState(..), simpleF, simpleWindowF, simpleK) where
import Color
import Command
import XDraw
import Dlayout(windowF)
import DShellF
--import FDefaults
--import Event
import Fudget
import FudgetIO
import FRequest
--import Xcommand
import Gc
import Geometry(Size)
import LayoutRequest
--import Message(Message(..))
--import NullF
--import Spops
import MapstateK
import Xtypes

type MapState a b c = a -> b -> (a, c)

type Fms' a b c = MapState a (KEvent b) [KCommand c]

type Drawer = DrawCommand -> FRequest

simpleK :: (Drawer -> Drawer -> Fms' a b c) -> Size -> a -> K b c
simpleK Drawer -> Drawer -> Fms' a b c
k Size
size a
s0 = forall a b c.
(Drawer -> Drawer -> Fms' a b c)
-> Size -> Bool -> Bool -> a -> K b c
simpleK' Drawer -> Drawer -> Fms' a b c
k Size
size Bool
True Bool
True a
s0

simpleK' :: (Drawer->Drawer->Fms' a b c) -> Size -> Bool -> Bool -> a -> K b c
simpleK' :: forall a b c.
(Drawer -> Drawer -> Fms' a b c)
-> Size -> Bool -> Bool -> a -> K b c
simpleK' Drawer -> Drawer -> Fms' a b c
k Size
size Bool
fixedh Bool
fixedv a
s0 =
    forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
ColormapId -> ColorName -> Cont (f hi ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap ColorName
"black" forall a b. (a -> b) -> a -> b
$ \Pixel
fg ->
    forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
ColormapId -> ColorName -> Cont (f hi ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap ColorName
"white" forall a b. (a -> b) -> a -> b
$ \Pixel
bg ->
    forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
GCId -> GCAttributeList -> (GCId -> f hi ho) -> f hi ho
wCreateGC GCId
rootGC [forall a b. GCFunction -> GCAttributes a b
GCFunction GCFunction
GXcopy,forall a b. a -> GCAttributes a b
GCForeground Pixel
fg,forall a b. a -> GCAttributes a b
GCBackground Pixel
bg] forall a b. (a -> b) -> a -> b
$ \GCId
fgc ->
    forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
GCId -> GCAttributeList -> (GCId -> f hi ho) -> f hi ho
wCreateGC GCId
fgc [forall a b. a -> GCAttributes a b
GCForeground Pixel
bg] forall a b. (a -> b) -> a -> b
$ \GCId
bgc ->
    forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
FRequest -> f hi ho -> f hi ho
putLow (LayoutRequest -> FRequest
layoutRequestCmd (Size -> Bool -> Bool -> LayoutRequest
plainLayout Size
size Bool
fixedh Bool
fixedv)) forall a b. (a -> b) -> a -> b
$
    forall {t} {hi} {ho}.
(t -> KEvent hi -> (t, [KCommand ho])) -> t -> K hi ho
mapstateK (Drawer -> Drawer -> Fms' a b c
k (GCId -> Drawer
wDraw GCId
fgc) (GCId -> Drawer
wDraw GCId
bgc)) a
s0

simpleF :: ColorName -> (Drawer -> Drawer -> Fms' a c d) -> Size -> a -> F c d
simpleF ColorName
title Drawer -> Drawer -> Fms' a c d
k Size
size a
s0 =
    forall {c} {d}. ColorName -> F c d -> F c d
shellF ColorName
title forall a b. (a -> b) -> a -> b
$
    forall {a} {a} {b}.
(Drawer -> Drawer -> Fms' a a b)
-> Size -> Bool -> Bool -> a -> F a b
simpleWindowF Drawer -> Drawer -> Fms' a c d
k Size
size Bool
False Bool
False a
s0

simpleWindowF :: (Drawer -> Drawer -> Fms' a a b)
-> Size -> Bool -> Bool -> a -> F a b
simpleWindowF Drawer -> Drawer -> Fms' a a b
k Size
size Bool
fh Bool
fv a
s0 =
    forall a b. [FRequest] -> K a b -> F a b
windowF [XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [[EventMask] -> WindowAttributes
CWEventMask [EventMask]
eventmask]] forall a b. (a -> b) -> a -> b
$
    forall a b c.
(Drawer -> Drawer -> Fms' a b c)
-> Size -> Bool -> Bool -> a -> K b c
simpleK' Drawer -> Drawer -> Fms' a a b
k Size
size Bool
fh Bool
fv a
s0
  where
    eventmask :: [EventMask]
eventmask = [EventMask
ExposureMask, EventMask
KeyPressMask, EventMask
KeyReleaseMask, EventMask
ButtonPressMask,
                 EventMask
ButtonReleaseMask]