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 = (Drawer -> Drawer -> Fms' a b c)
-> Size -> Bool -> Bool -> a -> K b c
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' :: (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 =
ColormapId -> ColorName -> Cont (K b c) Pixel
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> ColorName -> Cont (f b ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap ColorName
"black" Cont (K b c) Pixel -> Cont (K b c) Pixel
forall a b. (a -> b) -> a -> b
$ \Pixel
fg ->
ColormapId -> ColorName -> Cont (K b c) Pixel
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> ColorName -> Cont (f b ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap ColorName
"white" Cont (K b c) Pixel -> Cont (K b c) Pixel
forall a b. (a -> b) -> a -> b
$ \Pixel
bg ->
GCId -> [GCAttributes Pixel FontId] -> (GCId -> K b c) -> K b c
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
wCreateGC GCId
rootGC [GCFunction -> GCAttributes Pixel FontId
forall a b. GCFunction -> GCAttributes a b
GCFunction GCFunction
GXcopy,Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCForeground Pixel
fg,Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCBackground Pixel
bg] ((GCId -> K b c) -> K b c) -> (GCId -> K b c) -> K b c
forall a b. (a -> b) -> a -> b
$ \GCId
fgc ->
GCId -> [GCAttributes Pixel FontId] -> (GCId -> K b c) -> K b c
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
wCreateGC GCId
fgc [Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCForeground Pixel
bg] ((GCId -> K b c) -> K b c) -> (GCId -> K b c) -> K b c
forall a b. (a -> b) -> a -> b
$ \GCId
bgc ->
FRequest -> K b c -> K b c
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)) (K b c -> K b c) -> K b c -> K b c
forall a b. (a -> b) -> a -> b
$
Fms' a b c -> a -> K b c
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 =
ColorName -> F c d -> F c d
forall c d. ColorName -> F c d -> F c d
shellF ColorName
title (F c d -> F c d) -> F c d -> F c d
forall a b. (a -> b) -> a -> b
$
(Drawer -> Drawer -> Fms' a c d)
-> Size -> Bool -> Bool -> a -> F c d
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 =
[FRequest] -> K a b -> F a b
forall a b. [FRequest] -> K a b -> F a b
windowF [XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [[EventMask] -> WindowAttributes
CWEventMask [EventMask]
eventmask]] (K a b -> F a b) -> K a b -> F a b
forall a b. (a -> b) -> a -> b
$
(Drawer -> Drawer -> Fms' a a b)
-> Size -> Bool -> Bool -> a -> K 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]