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 = (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]