module SimpleF(Drawer(..), Fms'(..), MapState(..), simpleF, simpleWindowF, simpleK) where
import Color
import Command
import XDraw
import Dlayout(windowF)
import DShellF
import Fudget
import FudgetIO
import FRequest
import Gc
import Geometry(Size)
import LayoutRequest
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]