{-# LANGUAGE CPP #-}
module GraphicsF(GraphicsF,setCursorSolid,setGfxEventMask,
setAdjustSize,setCursor,setDoubleBuffer,
graphicsF,graphicsF',
graphicsGroupF,graphicsGroupF',
graphicsDispGroupF,graphicsDispGroupF',
graphicsLabelF,graphicsLabelF',
graphicsDispF,graphicsDispF',
GfxEventMask(..),GfxChange(..),GfxCommand(..),GfxEvent(..),
GfxFCmd,GfxFEvent,
replaceGfx,replaceAllGfx,showGfx,highlightGfx) where
import Fudget
import FudgetIO
import Xcommand
import FRequest
import NullF(putK,putsK,getK,nullF)
import Spops(nullSP)
import CompSP(postMapSP)
import SpEither(filterLeftSP)
import Command
import DrawInPixmap(pmFillRectangle,pmDrawPoint)
import Event
import Xtypes
import Geometry
import Gc
import Pixmap
import Cursor
import BgF(changeGetBackPixel)
import Defaults(fgColor,bgColor,paperColor,labelFont)
import CmdLineEnv(argFlag,argKeyList,argReadKey)
import LayoutRequest
import Alignment
import Spacers(noStretchS,compS,minSizeS)
import Message
import CompOps
import CompSP(idRightSP)
import Dlayout(groupF)
import Utils(number,pairwith)
import HbcUtils(mapFst,mapSnd)
import Graphic
import CompiledGraphics
import MeasuredGraphics(MeasuredGraphics(SpacedM,MarkM),compileMG,DPath(..))
import Graphic2Pixmap
import GCtx(GCtx(..),wCreateGCtx,rootGCtx)
import GCAttrs
import MGOps(parentGctx,replaceMGPart,updateMGPart,groupMGParts,ungroupMGParts)
import IdempotSP
import DrawCompiledGraphics
import Rects(intersectRects,overlaps)
import EitherUtils(stripEither)
import Sizing(newSize,Sizing(..))
import Xrequest(xrequestK)
import StdIoUtil(echoStderrK)
import FDefaults
#include "defaults.h"
#include "exists.h"
data GfxChange gfx
= GfxReplace (Bool,Maybe gfx)
| GfxGroup Int Int
| GfxUngroup Int
data GfxCommand path gfx
= ChangeGfx [(path,GfxChange gfx)]
| ChangeGfxBg ColorSpec
| ChangeGfxBgPixmap PixmapId Bool
#ifdef USE_EXIST_Q
| EXISTS(bg) TSTHACK((Graphic EQV(bg)) =>) ChangeGfxBgGfx EQV(bg)
#endif
| ChangeGfxCursor CursorId
| ChangeGfxFontCursor Int
| ShowGfx path (Maybe Alignment,Maybe Alignment)
| BellGfx Int
| GetGfxPlaces [path]
replaceAllGfx :: gfx -> GfxCommand [a] gfx
replaceAllGfx = forall {path} {gfx}. path -> gfx -> GfxCommand path gfx
replaceGfx []
replaceGfx :: path -> gfx -> GfxCommand path gfx
replaceGfx path
path gfx
gfx = forall path gfx. [(path, GfxChange gfx)] -> GfxCommand path gfx
ChangeGfx [(path
path,forall gfx. (Bool, Maybe gfx) -> GfxChange gfx
GfxReplace (Bool
False,forall a. a -> Maybe a
Just gfx
gfx))]
showGfx :: path -> GfxCommand path gfx
showGfx path
path = forall path gfx.
path -> (Maybe Alignment, Maybe Alignment) -> GfxCommand path gfx
ShowGfx path
path (forall a. Maybe a
Nothing,forall a. Maybe a
Nothing)
highlightGfx :: path -> Bool -> GfxCommand path gfx
highlightGfx path
path Bool
on = forall path gfx. [(path, GfxChange gfx)] -> GfxCommand path gfx
ChangeGfx [(path
path,forall gfx. (Bool, Maybe gfx) -> GfxChange gfx
GfxReplace (Bool
on,forall a. Maybe a
Nothing))]
instance Functor GfxChange where
fmap :: forall a b. (a -> b) -> GfxChange a -> GfxChange b
fmap a -> b
f (GfxReplace (Bool, Maybe a)
r) = forall gfx. (Bool, Maybe gfx) -> GfxChange gfx
GfxReplace (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (Bool, Maybe a)
r)
fmap a -> b
f (GfxGroup Int
from Int
count) = forall gfx. Int -> Int -> GfxChange gfx
GfxGroup Int
from Int
count
fmap a -> b
f (GfxUngroup Int
at) = forall gfx. Int -> GfxChange gfx
GfxUngroup Int
at
instance Functor (GfxCommand path) where
fmap :: forall a b. (a -> b) -> GfxCommand path a -> GfxCommand path b
fmap a -> b
f GfxCommand path a
cmd =
case GfxCommand path a
cmd of
ChangeGfx [(path, GfxChange a)]
changes -> forall path gfx. [(path, GfxChange gfx)] -> GfxCommand path gfx
ChangeGfx (forall {t} {b} {a}. (t -> b) -> [(a, t)] -> [(a, b)]
mapSnd (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [(path, GfxChange a)]
changes)
ChangeGfxBg ColorSpec
c -> forall path gfx. ColorSpec -> GfxCommand path gfx
ChangeGfxBg ColorSpec
c
ChangeGfxBgPixmap PixmapId
pm Bool
b -> forall path gfx. PixmapId -> Bool -> GfxCommand path gfx
ChangeGfxBgPixmap PixmapId
pm Bool
b
#ifdef USE_EXIST_Q
ChangeGfxBgGfx bg
gfx -> forall path gfx bg. Graphic bg => bg -> GfxCommand path gfx
ChangeGfxBgGfx bg
gfx
#endif
ChangeGfxCursor CursorId
cursor -> forall path gfx. CursorId -> GfxCommand path gfx
ChangeGfxCursor CursorId
cursor
ChangeGfxFontCursor Int
shape -> forall path gfx. Int -> GfxCommand path gfx
ChangeGfxFontCursor Int
shape
ShowGfx path
path (Maybe Alignment, Maybe Alignment)
a -> forall path gfx.
path -> (Maybe Alignment, Maybe Alignment) -> GfxCommand path gfx
ShowGfx path
path (Maybe Alignment, Maybe Alignment)
a
BellGfx Int
n -> forall path gfx. Int -> GfxCommand path gfx
BellGfx Int
n
GetGfxPlaces [path]
paths -> forall path gfx. [path] -> GfxCommand path gfx
GetGfxPlaces [path]
paths
data GfxEvent path
= GfxButtonEvent { forall path. GfxEvent path -> Int
gfxTime :: Time,
forall path. GfxEvent path -> ModState
gfxState :: ModState,
forall path. GfxEvent path -> Pressed
gfxType :: Pressed,
forall path. GfxEvent path -> Button
gfxButton:: Button,
forall path. GfxEvent path -> [(path, (Point, Rect))]
gfxPaths :: [(path,(Point,Rect))] }
| GfxMotionEvent { gfxTime :: Time,
gfxState :: ModState,
gfxPaths :: [(path,(Point,Rect))] }
| GfxKeyEvent { gfxTime :: Time,
gfxState::ModState,
forall path. GfxEvent path -> KeySym
gfxKeySym::KeySym,
forall path. GfxEvent path -> KeySym
gfxKeyLookup::KeyLookup }
| GfxFocusEvent { forall path. GfxEvent path -> Bool
gfxHasFocus :: Bool }
| GfxPlaces [Rect]
| GfxResized Size
deriving (GfxEvent path -> GfxEvent path -> Bool
forall path. Eq path => GfxEvent path -> GfxEvent path -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GfxEvent path -> GfxEvent path -> Bool
$c/= :: forall path. Eq path => GfxEvent path -> GfxEvent path -> Bool
== :: GfxEvent path -> GfxEvent path -> Bool
$c== :: forall path. Eq path => GfxEvent path -> GfxEvent path -> Bool
Eq,Int -> GfxEvent path -> ShowS
forall path. Show path => Int -> GfxEvent path -> ShowS
forall path. Show path => [GfxEvent path] -> ShowS
forall path. Show path => GfxEvent path -> KeySym
forall a.
(Int -> a -> ShowS) -> (a -> KeySym) -> ([a] -> ShowS) -> Show a
showList :: [GfxEvent path] -> ShowS
$cshowList :: forall path. Show path => [GfxEvent path] -> ShowS
show :: GfxEvent path -> KeySym
$cshow :: forall path. Show path => GfxEvent path -> KeySym
showsPrec :: Int -> GfxEvent path -> ShowS
$cshowsPrec :: forall path. Show path => Int -> GfxEvent path -> ShowS
Show)
data GfxEventMask = GfxButtonMask | GfxMotionMask | GfxDragMask | GfxKeyMask
allGfxEvents :: [GfxEventMask]
allGfxEvents = [GfxEventMask
GfxButtonMask, GfxEventMask
GfxMotionMask, GfxEventMask
GfxDragMask, GfxEventMask
GfxKeyMask]
gfxMouseMask :: [GfxEventMask]
gfxMouseMask = [GfxEventMask
GfxButtonMask, GfxEventMask
GfxDragMask]
gfxEventMask :: [GfxEventMask] -> [EventMask]
gfxEventMask = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GfxEventMask -> [EventMask]
events
where
events :: GfxEventMask -> [EventMask]
events GfxEventMask
GfxButtonMask = [EventMask]
buttonmask
events GfxEventMask
GfxMotionMask = [EventMask]
motionmask
events GfxEventMask
GfxDragMask = [EventMask]
dragmask
events GfxEventMask
GfxKeyMask = [EventMask]
keventmask
buttonmask :: [EventMask]
buttonmask = [EventMask
ButtonPressMask,EventMask
ButtonReleaseMask]
motionmask :: [EventMask]
motionmask = [EventMask
PointerMotionMask]
dragmask :: [EventMask]
dragmask = [EventMask
Button1MotionMask]
keventmask :: [EventMask]
keventmask =
[EventMask
KeyPressMask,
EventMask
EnterWindowMask, EventMask
LeaveWindowMask
]
newtype GraphicsF gfx = Pars [Pars gfx]
data Pars gfx
= BorderWidth Int
| BgColorSpec ColorSpec
| FgColorSpec ColorSpec
| FontSpec FontSpec
| Sizing Sizing
| Stretchable (Bool,Bool)
| InitSize gfx
| InitDisp gfx
| CursorSolid Bool
| GfxEventMask [GfxEventMask]
| AdjustSize Bool
| Cursor Int
| DoubleBuffer Bool
parameter_instance1(BorderWidth,GraphicsF)
parameter_instance1(BgColorSpec,GraphicsF)
parameter_instance1(FgColorSpec,GraphicsF)
parameter_instance1(Sizing,GraphicsF)
parameter_instance1(FontSpec,GraphicsF)
parameter_instance1(Stretchable,GraphicsF)
parameter_instance(InitSize,GraphicsF)
parameter_instance(InitDisp,GraphicsF)
parameter(CursorSolid)
parameter(GfxEventMask)
parameter(AdjustSize)
setCursor :: Int -> Customiser (GraphicsF gfx)
parameter(Cursor)
parameter(DoubleBuffer)
type GfxFCmd a = GfxCommand DPath a
type GfxFEvent = GfxEvent DPath
graphicsDispF :: Graphic a => F (GfxFCmd a) (GfxFEvent)
graphicsDispF :: forall a. Graphic a => F (GfxFCmd a) GfxFEvent
graphicsDispF = forall gfx.
Graphic gfx =>
Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) GfxFEvent
graphicsDispF' forall a. Customiser a
standard
graphicsLabelF :: p -> F e d
graphicsLabelF p
lbl = forall {p} {e} {d}.
Graphic p =>
(GraphicsF p -> GraphicsF p) -> p -> F e d
graphicsLabelF' forall a. Customiser a
standard p
lbl
graphicsLabelF' :: (GraphicsF p -> GraphicsF p) -> p -> F e d
graphicsLabelF' GraphicsF p -> GraphicsF p
customiser p
gfx = forall a b. SP a b
nullSP forall a b e. SP a b -> F e a -> F e b
>^^=< F (GfxFCmd p) GfxFEvent
d forall c d e. F c d -> SP e c -> F e d
>=^^< forall a b. SP a b
nullSP'
where d :: F (GfxFCmd p) GfxFEvent
d = forall gfx.
Graphic gfx =>
Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) GfxFEvent
graphicsF' (GraphicsF p -> GraphicsF p
customiser forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphicsF p -> GraphicsF p
params)
params :: GraphicsF p -> GraphicsF p
params = forall (xxx :: * -> *) a.
HasInitDisp xxx =>
a -> Customiser (xxx a)
setInitDisp p
gfx forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall {gfx}. [GfxEventMask] -> Customiser (GraphicsF gfx)
setGfxEventMask [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall xxx. HasSizing xxx => Sizing -> Customiser xxx
setSizing Sizing
Static forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {xxx} {p}.
(HasBgColorSpec xxx, Show p, ColorGen p) =>
p -> Customiser xxx
setBgColor KeySym
bgColor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall xxx. HasBorderWidth xxx => Int -> Customiser xxx
setBorderWidth Int
0
nullSP' :: SP a b
nullSP' = forall a b. SP a b
nullSP
graphicsDispF' :: Graphic gfx => Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) (GfxFEvent)
graphicsDispF' :: forall gfx.
Graphic gfx =>
Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) GfxFEvent
graphicsDispF' Customiser (GraphicsF gfx)
customiser = forall gfx.
Graphic gfx =>
Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) GfxFEvent
graphicsF' (Customiser (GraphicsF gfx)
customiser forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {gfx}. GraphicsF gfx -> GraphicsF gfx
dispCustomiser)
graphicsDispGroupF :: F i o -> F (Either (GfxFCmd gfx) i) (Either GfxFEvent o)
graphicsDispGroupF F i o
fud = forall gfx i o.
Graphic gfx =>
Customiser (GraphicsF gfx)
-> F i o -> F (Either (GfxFCmd gfx) i) (Either GfxFEvent o)
graphicsGroupF' forall {gfx}. GraphicsF gfx -> GraphicsF gfx
dispCustomiser F i o
fud
graphicsDispGroupF' :: (GraphicsF gfx -> GraphicsF gfx)
-> F i o -> F (Either (GfxFCmd gfx) i) (Either GfxFEvent o)
graphicsDispGroupF' GraphicsF gfx -> GraphicsF gfx
customiser F i o
fud =
forall gfx i o.
Graphic gfx =>
Customiser (GraphicsF gfx)
-> F i o -> F (Either (GfxFCmd gfx) i) (Either GfxFEvent o)
graphicsGroupF' (GraphicsF gfx -> GraphicsF gfx
customiser forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {gfx}. GraphicsF gfx -> GraphicsF gfx
dispCustomiser) F i o
fud
dispCustomiser :: GraphicsF gfx -> GraphicsF gfx
dispCustomiser =
forall {gfx}. Bool -> Customiser (GraphicsF gfx)
setCursorSolid Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {gfx}. [GfxEventMask] -> Customiser (GraphicsF gfx)
setGfxEventMask [GfxEventMask]
gfxMouseMask forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall xxx. HasSizing xxx => Sizing -> Customiser xxx
setSizing Sizing
Growing
graphicsF :: Graphic gfx => F (GfxFCmd gfx) (GfxFEvent)
graphicsF :: forall a. Graphic a => F (GfxFCmd a) GfxFEvent
graphicsF = forall gfx.
Graphic gfx =>
Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) GfxFEvent
graphicsF' forall a. Customiser a
standard
graphicsF' :: Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) GfxFEvent
graphicsF' Customiser (GraphicsF gfx)
custom = forall {b1} {b2}. SP (Either b1 b2) b1
filterLeftSP forall a b e. SP a b -> F e a -> F e b
>^^=< forall gfx i o.
Graphic gfx =>
Customiser (GraphicsF gfx)
-> F i o -> F (Either (GfxFCmd gfx) i) (Either GfxFEvent o)
graphicsGroupF' Customiser (GraphicsF gfx)
custom forall {hi} {ho}. F hi ho
nullF forall c d e. F c d -> (e -> c) -> F e d
>=^< forall a b. a -> Either a b
Left
graphicsGroupF :: Graphic gfx => F i o -> F (Either (GfxFCmd gfx) i) (Either (GfxFEvent) o)
graphicsGroupF :: forall gfx i o.
Graphic gfx =>
F i o -> F (Either (GfxFCmd gfx) i) (Either GfxFEvent o)
graphicsGroupF = forall gfx i o.
Graphic gfx =>
Customiser (GraphicsF gfx)
-> F i o -> F (Either (GfxFCmd gfx) i) (Either GfxFEvent o)
graphicsGroupF' forall a. Customiser a
standard
graphicsGroupF' :: Graphic gfx => Customiser (GraphicsF gfx) -> F i o -> F (Either (GfxFCmd gfx) i) (Either (GfxFEvent) o)
graphicsGroupF' :: forall gfx i o.
Graphic gfx =>
Customiser (GraphicsF gfx)
-> F i o -> F (Either (GfxFCmd gfx) i) (Either GfxFEvent o)
graphicsGroupF' Customiser (GraphicsF gfx)
customiser F i o
fud =
let solid :: Bool
solid = forall {gfx}. GraphicsF gfx -> Bool
getCursorSolid GraphicsF gfx
params
mask :: [GfxEventMask]
mask = forall {gfx}. GraphicsF gfx -> [GfxEventMask]
getGfxEventMask GraphicsF gfx
params
sizing :: Sizing
sizing = forall xxx. HasSizing xxx => xxx -> Sizing
getSizing GraphicsF gfx
params
adjsize :: Bool
adjsize = forall {gfx}. GraphicsF gfx -> Bool
getAdjustSize GraphicsF gfx
params
doublebuffer :: Bool
doublebuffer = forall {gfx}. GraphicsF gfx -> Bool
getDoubleBuffer GraphicsF gfx
params
optcursor :: Maybe Int
optcursor = forall a. GraphicsF a -> Maybe Int
getCursorMaybe GraphicsF gfx
params
font :: FontSpec
font = forall xxx. HasFontSpec xxx => xxx -> FontSpec
getFontSpec GraphicsF gfx
params
bw :: Int
bw = forall xxx. HasBorderWidth xxx => xxx -> Int
getBorderWidth GraphicsF gfx
params
bgcol :: ColorSpec
bgcol = forall xxx. HasBgColorSpec xxx => xxx -> ColorSpec
getBgColorSpec GraphicsF gfx
params
fgcol :: ColorSpec
fgcol = forall xxx. HasFgColorSpec xxx => xxx -> ColorSpec
getFgColorSpec GraphicsF gfx
params
optx :: Maybe gfx
optx = forall (xxx :: * -> *) a. HasInitDisp xxx => xxx a -> Maybe a
getInitDispMaybe GraphicsF gfx
params
optstretch :: Maybe (Bool, Bool)
optstretch = forall xxx. HasStretchable xxx => xxx -> Maybe (Bool, Bool)
getStretchableMaybe GraphicsF gfx
params
optinitsize :: Maybe gfx
optinitsize = forall (xxx :: * -> *) a. HasInitSize xxx => xxx a -> Maybe a
getInitSizeMaybe GraphicsF gfx
params
params :: GraphicsF gfx
params = Customiser (GraphicsF gfx)
customiser forall {gfx}. GraphicsF gfx
defaults
defaults :: GraphicsF gfx
defaults = forall gfx. [Pars gfx] -> GraphicsF gfx
Pars [forall gfx. Int -> Pars gfx
BorderWidth Int
1,
forall gfx. ColorSpec -> Pars gfx
BgColorSpec (forall {a}. (Show a, ColorGen a) => a -> ColorSpec
colorSpec KeySym
paperColor),
forall gfx. ColorSpec -> Pars gfx
FgColorSpec (forall {a}. (Show a, ColorGen a) => a -> ColorSpec
colorSpec KeySym
fgColor),
forall gfx. Sizing -> Pars gfx
Sizing Sizing
Dynamic,
forall gfx. Bool -> Pars gfx
CursorSolid Bool
False,
forall gfx. [GfxEventMask] -> Pars gfx
GfxEventMask [GfxEventMask]
allGfxEvents,
forall gfx. Bool -> Pars gfx
AdjustSize Bool
True,
forall gfx. Bool -> Pars gfx
DoubleBuffer Bool
defaultdoublebuffer,
forall gfx. FontSpec -> Pars gfx
FontSpec (forall {a}. (Show a, FontGen a) => a -> FontSpec
fontSpec KeySym
labelFont)]
eventmask :: [EventMask]
eventmask = EventMask
ExposureMaskforall a. a -> [a] -> [a]
:
[GfxEventMask] -> [EventMask]
gfxEventMask [GfxEventMask]
mask
startcmds :: [XCommand]
startcmds = [[WindowAttributes] -> XCommand
ChangeWindowAttributes [[EventMask] -> WindowAttributes
CWEventMask [EventMask]
eventmask,
Gravity -> WindowAttributes
CWBitGravity Gravity
NorthWestGravity],
[WindowChanges] -> XCommand
ConfigureWindow [Int -> WindowChanges
CWBorderWidth Int
bw]
]
in
forall {a1} {a2} {b}. SP a1 a2 -> SP (Either a1 b) (Either a2 b)
idRightSP (forall {a}. Either a a -> a
stripEither forall {t} {b} {a}. (t -> b) -> SP a t -> SP a b
`postMapSP` forall {a1} {a2} {b}. SP a1 a2 -> SP (Either a1 b) (Either a2 b)
idRightSP forall a. Eq a => SP a a
idempotSP) forall a b e. SP a b -> F e a -> F e b
>^^=<
forall {a} {b} {c} {d}.
[FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XCommand -> FRequest
XCmd [XCommand]
startcmds)
(forall {a} {i} {o}.
(Show a, ColorGen a) =>
Bool
-> FontSpec
-> Maybe Int
-> ColorSpec
-> a
-> (Maybe DbeBackBufferId
-> GCtx -> Pixel -> GCId -> GCId -> K i o)
-> K i o
initK Bool
doublebuffer FontSpec
font Maybe Int
optcursor ColorSpec
fgcol ColorSpec
bgcol forall a b. (a -> b) -> a -> b
$
forall {a} {a} {a} {p} {path}.
(Graphic a, Graphic a, Graphic a) =>
Bool
-> Sizing
-> Bool
-> Maybe (Bool, Bool)
-> Maybe a
-> Maybe a
-> Maybe DbeBackBufferId
-> GCtx
-> p
-> GCId
-> GCId
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
graphicsK0 Bool
solid Sizing
sizing Bool
adjsize Maybe (Bool, Bool)
optstretch Maybe gfx
optinitsize Maybe gfx
optx)
F i o
fud
dbeSwapBuffers :: K b c -> K b c
dbeSwapBuffers K b c
cont =
forall {a} {b} {c}.
XRequest -> (XResponse -> Maybe a) -> Cont (K b c) a
xrequestK (SwapAction -> XRequest
DbeSwapBuffers SwapAction
swapaction) forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \ (DbeBuffersSwapped Int
_) -> K b c
cont
optDoubleBufferK :: Bool -> (Maybe DbeBackBufferId -> K b c) -> K b c
optDoubleBufferK Bool
False Maybe DbeBackBufferId -> K b c
cont = Maybe DbeBackBufferId -> K b c
cont forall a. Maybe a
Nothing
optDoubleBufferK Bool
True Maybe DbeBackBufferId -> K b c
cont =
forall {a} {b} {c}.
XRequest -> (XResponse -> Maybe a) -> Cont (K b c) a
xrequestK XRequest
DbeQueryExtension forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \ (DbeExtensionQueried Int
status Int
major Int
minor) ->
let ok :: Bool
ok=Int
statusforall a. Eq a => a -> a -> Bool
/=Int
0
in if Bool -> Bool
not Bool
ok
then forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
KeySym -> f hi ho -> f hi ho
echoStderrK KeySym
"Sorry, double buffering not available." forall a b. (a -> b) -> a -> b
$
Maybe DbeBackBufferId -> K b c
cont forall a. Maybe a
Nothing
else forall {a} {b} {c}.
XRequest -> (XResponse -> Maybe a) -> Cont (K b c) a
xrequestK (SwapAction -> XRequest
DbeAllocateBackBufferName SwapAction
swapaction) forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \ (DbeBackBufferNameAllocated DbeBackBufferId
backbuf) ->
Maybe DbeBackBufferId -> K b c
cont (forall a. a -> Maybe a
Just DbeBackBufferId
backbuf)
initK :: Bool
-> FontSpec
-> Maybe Int
-> ColorSpec
-> a
-> (Maybe DbeBackBufferId
-> GCtx -> Pixel -> GCId -> GCId -> K i o)
-> K i o
initK Bool
doublebuffer FontSpec
font Maybe Int
optcursor ColorSpec
fgcol a
bgcol Maybe DbeBackBufferId -> GCtx -> Pixel -> GCId -> GCId -> K i o
k =
forall {a} {i} {o}.
(Show a, ColorGen a) =>
a -> (Pixel -> K i o) -> K i o
changeGetBackPixel a
bgcol forall a b. (a -> b) -> a -> b
$ \ Pixel
bg ->
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Customiser a
id forall a b. Int -> K a b -> K a b
setFontCursor Maybe Int
optcursor forall a b. (a -> b) -> a -> b
$
forall {a} {f :: * -> * -> *} {i} {o}.
(ColorGen a, FudgetIO f, Show a) =>
a -> (Pixel -> f i o) -> f i o
convColorK [ColorSpec
fgcol,forall {a}. (Show a, ColorGen a) => a -> ColorSpec
colorSpec KeySym
"black"] forall a b. (a -> b) -> a -> b
$ \ Pixel
fg ->
forall {a1} {f :: * -> * -> *} {a2} {i} {o}.
(ColorGen a1, FudgetIO f, FontGen a2, Show a1, Show a2) =>
GCtx -> [GCAttributes a1 a2] -> (GCtx -> f i o) -> f i o
wCreateGCtx GCtx
rootGCtx [forall a b. b -> GCAttributes a b
GCFont [FontSpec
font,forall {a}. (Show a, FontGen a) => a -> FontSpec
fontSpec KeySym
"fixed"],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
$ \ gctx :: GCtx
gctx@(GC GCId
gc FontData
_) ->
forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
GCId -> GCAttributeList -> (GCId -> f hi ho) -> f hi ho
wCreateGC GCId
rootGC [forall a b. a -> GCAttributes a b
GCForeground Pixel
bg] forall a b. (a -> b) -> a -> b
$ \ GCId
cleargc ->
forall {i} {o}. GCId -> Pixel -> Pixel -> (GCId -> K i o) -> K i o
createCursorGC GCId
gc Pixel
bg Pixel
fg forall a b. (a -> b) -> a -> b
$ \ GCId
higc ->
forall {b} {c}. Bool -> (Maybe DbeBackBufferId -> K b c) -> K b c
optDoubleBufferK Bool
doublebuffer forall a b. (a -> b) -> a -> b
$ \ Maybe DbeBackBufferId
optbackbuf ->
Maybe DbeBackBufferId -> GCtx -> Pixel -> GCId -> GCId -> K i o
k Maybe DbeBackBufferId
optbackbuf GCtx
gctx Pixel
bg GCId
cleargc GCId
higc
optCompileGraphicK :: GCtx
-> Maybe a
-> (Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
-> k i o)
-> k i o
optCompileGraphicK GCtx
gctx Maybe a
optgfx Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
-> k i o
cont =
case Maybe a
optgfx of
Maybe a
Nothing -> Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
-> k i o
cont forall a. Maybe a
Nothing
Just a
gfx ->
forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK a
gfx GCtx
gctx forall a b. (a -> b) -> a -> b
$ \ MeasuredGraphics
mg ->
Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
-> k i o
cont (forall a. a -> Maybe a
Just (MeasuredGraphics
mg,(Point -> Point)
-> MeasuredGraphics -> (CompiledGraphics, LayoutRequest)
compileMG forall a. Customiser a
id MeasuredGraphics
mg))
graphicsK0 :: Bool
-> Sizing
-> Bool
-> Maybe (Bool, Bool)
-> Maybe a
-> Maybe a
-> Maybe DbeBackBufferId
-> GCtx
-> p
-> GCId
-> GCId
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
graphicsK0 Bool
solid Sizing
sizing Bool
adjsize Maybe (Bool, Bool)
optstretch Maybe a
optinitsize Maybe a
optx Maybe DbeBackBufferId
optbackbuf GCtx
gctx p
bg GCId
cleargc GCId
higc =
forall {path}.
K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
graphicsK1
where
graphicsK1 :: K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
graphicsK1 =
forall {a} {k :: * -> * -> *} {i} {o}.
(Graphic a, FudgetIO k) =>
GCtx
-> Maybe a
-> (Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
-> k i o)
-> k i o
optCompileGraphicK GCtx
gctx Maybe a
optinitsize forall a b. (a -> b) -> a -> b
$ \ Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
optcgsize ->
forall {a} {k :: * -> * -> *} {i} {o}.
(Graphic a, FudgetIO k) =>
GCtx
-> Maybe a
-> (Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
-> k i o)
-> k i o
optCompileGraphicK GCtx
gctx Maybe a
optx forall a b. (a -> b) -> a -> b
$ \ Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
optcgx ->
forall {a} {a} {a} {b} {path}.
Graphic a =>
Maybe (a, (a, LayoutRequest))
-> Maybe (MeasuredGraphics, b)
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
graphicsK2 Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
optcgsize Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
optcgx
graphicsK2 :: Maybe (a, (a, LayoutRequest))
-> Maybe (MeasuredGraphics, b)
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
graphicsK2 Maybe (a, (a, LayoutRequest))
optcgsize Maybe (MeasuredGraphics, b)
optcgx =
forall {a} {path}.
Graphic a =>
(MeasuredGraphics, (CompiledGraphics, LayoutRequest))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
graphicsK (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
init
where
optSizeS :: Maybe Spacer
optSizeS = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Point -> Spacer
minSizeS forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutRequest -> Point
minsize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) Maybe (a, (a, LayoutRequest))
optcgsize
optStretchS :: Maybe Spacer
optStretchS = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool, Bool) -> Spacer
stretchS Maybe (Bool, Bool)
optstretch
where stretchS :: (Bool, Bool) -> Spacer
stretchS (Bool
sh,Bool
sv) = Bool -> Bool -> Spacer
noStretchS (Bool -> Bool
not Bool
sh) (Bool -> Bool
not Bool
sv)
spacerM :: MeasuredGraphics -> MeasuredGraphics
spacerM =
case (Maybe Spacer
optStretchS,Maybe Spacer
optSizeS) of
(Just Spacer
stretchS,Just Spacer
sizeS) -> Spacer -> MeasuredGraphics -> MeasuredGraphics
SpacedM (Spacer
stretchS Spacer -> Spacer -> Spacer
`compS` Spacer
sizeS)
(Just Spacer
stretchS,Maybe Spacer
_ ) -> Spacer -> MeasuredGraphics -> MeasuredGraphics
SpacedM Spacer
stretchS
(Maybe Spacer
_ ,Just Spacer
sizeS) -> Spacer -> MeasuredGraphics -> MeasuredGraphics
SpacedM Spacer
sizeS
(Maybe Spacer, Maybe Spacer)
_ -> GCtx -> MeasuredGraphics -> MeasuredGraphics
MarkM GCtx
gctx
init :: (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
init = forall {t} {b}. (t -> b) -> t -> (t, b)
pairwith ((Point -> Point)
-> MeasuredGraphics -> (CompiledGraphics, LayoutRequest)
compileMG forall a. Customiser a
id) forall a b. (a -> b) -> a -> b
$ MeasuredGraphics -> MeasuredGraphics
spacerM forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Point -> MeasuredGraphics
emptyMG Point
10) forall a b. (a, b) -> a
fst Maybe (MeasuredGraphics, b)
optcgx
pathIn :: [a] -> [a]
pathIn [a]
path = a
0forall a. a -> [a] -> [a]
:[a]
path
locatePointOut :: Point -> CompiledGraphics -> [([Int], (Point, Rect))]
locatePointOut Point
p (CGMark CompiledGraphics
cg) = Point -> CompiledGraphics -> [([Int], (Point, Rect))]
locatePoint Point
p CompiledGraphics
cg
graphicsK :: (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
graphicsK (MeasuredGraphics
mg,(CompiledGraphics
cg,LayoutRequest
req)) =
forall {hi} {ho}. LayoutRequest -> K hi ho -> K hi ho
putLayoutReq LayoutRequest
req forall a b. (a -> b) -> a -> b
$
forall {a} {path}.
Graphic a =>
GCId
-> LayoutRequest
-> MeasuredGraphics
-> CompiledGraphics
-> Bool
-> [Rect]
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
idleK GCId
cleargc LayoutRequest
req MeasuredGraphics
mg CompiledGraphics
cg Bool
solid []
idleK :: GCId
-> LayoutRequest
-> MeasuredGraphics
-> CompiledGraphics
-> Bool
-> [Rect]
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
idleK GCId
cleargc LayoutRequest
req MeasuredGraphics
mg CompiledGraphics
cg Bool
active [Rect]
es =
seq :: forall a b. a -> b -> b
seq Point
size forall a b. (a -> b) -> a -> b
$
forall {hi} {ho}. Cont (K hi ho) (KEvent hi)
getK forall a b. (a -> b) -> a -> b
$ forall {t1} {t2} {t3}.
(t1 -> t2) -> (t3 -> t2) -> Message t1 t3 -> t2
message FResponse
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
lowK forall {a}.
Graphic a =>
GfxCommand [Int] a
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
highK
where
size :: Point
size = LayoutRequest -> Point
minsize LayoutRequest
req
curR :: Rect -> [Rect]
curR = Bool -> Rect -> [Rect]
hiR (Bool
solidBool -> Bool -> Bool
||Bool
active)
same :: K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
same = GCId
-> LayoutRequest
-> MeasuredGraphics
-> CompiledGraphics
-> Bool
-> [Rect]
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
idleK GCId
cleargc LayoutRequest
req MeasuredGraphics
mg CompiledGraphics
cg Bool
active [Rect]
es
newcleargc :: GCId -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
newcleargc GCId
cleargc' = GCId
-> LayoutRequest
-> MeasuredGraphics
-> CompiledGraphics
-> Bool
-> [Rect]
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
idleK GCId
cleargc' LayoutRequest
req MeasuredGraphics
mg CompiledGraphics
cg Bool
active [Rect]
es
optInsertNew :: MeasuredGraphics
-> CompiledGraphics
-> GCtx
-> [Int]
-> Maybe LayoutRequest
-> Maybe a
-> (MeasuredGraphics
-> CompiledGraphics -> Maybe LayoutRequest -> k i o)
-> k i o
optInsertNew MeasuredGraphics
mg CompiledGraphics
cg GCtx
gctx [Int]
path Maybe LayoutRequest
optreq Maybe a
optnew MeasuredGraphics
-> CompiledGraphics -> Maybe LayoutRequest -> k i o
k =
case Maybe a
optnew of
Maybe a
Nothing -> MeasuredGraphics
-> CompiledGraphics -> Maybe LayoutRequest -> k i o
k MeasuredGraphics
mg CompiledGraphics
cg Maybe LayoutRequest
optreq
Just a
new -> forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK a
new GCtx
gctx forall a b. (a -> b) -> a -> b
$ \ MeasuredGraphics
newmg ->
let mg' :: MeasuredGraphics
mg' = MeasuredGraphics -> [Int] -> MeasuredGraphics -> MeasuredGraphics
replaceMGPart MeasuredGraphics
mg [Int]
path MeasuredGraphics
newmg
(CompiledGraphics
cg',LayoutRequest
req) = (Point -> Point)
-> MeasuredGraphics -> (CompiledGraphics, LayoutRequest)
compileMG (Sizing -> Point -> Point -> Point
newSize Sizing
sizing Point
size) MeasuredGraphics
mg'
in MeasuredGraphics
-> CompiledGraphics -> Maybe LayoutRequest -> k i o
k MeasuredGraphics
mg' CompiledGraphics
cg' (forall a. a -> Maybe a
Just LayoutRequest
req)
updGraphicsK :: MeasuredGraphics
-> CompiledGraphics
-> Maybe LayoutRequest
-> [([Int], GfxChange a)]
-> (LayoutRequest
-> MeasuredGraphics -> CompiledGraphics -> Bool -> K hi ho)
-> K hi ho
updGraphicsK MeasuredGraphics
mg CompiledGraphics
cg Maybe LayoutRequest
optreq [] LayoutRequest
-> MeasuredGraphics -> CompiledGraphics -> Bool -> K hi ho
c =
case Maybe LayoutRequest
optreq of
Just LayoutRequest
req' | Bool -> Bool
not (LayoutRequest -> LayoutRequest -> Bool
similar LayoutRequest
req' LayoutRequest
req)
->
forall {hi} {ho}. LayoutRequest -> K hi ho -> K hi ho
putLayoutReq LayoutRequest
req' forall a b. (a -> b) -> a -> b
$ LayoutRequest
-> MeasuredGraphics -> CompiledGraphics -> Bool -> K hi ho
c LayoutRequest
req' MeasuredGraphics
mg CompiledGraphics
cg Bool
False
Maybe LayoutRequest
_ -> LayoutRequest
-> MeasuredGraphics -> CompiledGraphics -> Bool -> K hi ho
c LayoutRequest
req MeasuredGraphics
mg CompiledGraphics
cg Bool
True
updGraphicsK MeasuredGraphics
mg CompiledGraphics
cg Maybe LayoutRequest
optreq (([Int]
path,GfxChange a
change):[([Int], GfxChange a)]
changes) LayoutRequest
-> MeasuredGraphics -> CompiledGraphics -> Bool -> K hi ho
c =
case GfxChange a
change of
GfxReplace (Bool, Maybe a)
r -> forall {a}. Graphic a => (Bool, Maybe a) -> K hi ho
replace (Bool, Maybe a)
r
GfxGroup Int
from Int
count -> Int -> Int -> K hi ho
group Int
from Int
count
GfxUngroup Int
pos -> Int -> K hi ho
ungroup Int
pos
where
replace :: (Bool, Maybe a) -> K hi ho
replace (Bool
hi,Maybe a
optnew) =
forall {a} {k :: * -> * -> *} {i} {o}.
(Graphic a, FudgetIO k) =>
MeasuredGraphics
-> CompiledGraphics
-> GCtx
-> [Int]
-> Maybe LayoutRequest
-> Maybe a
-> (MeasuredGraphics
-> CompiledGraphics -> Maybe LayoutRequest -> k i o)
-> k i o
optInsertNew MeasuredGraphics
mg CompiledGraphics
cg (GCtx -> MeasuredGraphics -> [Int] -> GCtx
parentGctx GCtx
gctx MeasuredGraphics
mg [Int]
path) [Int]
path Maybe LayoutRequest
optreq Maybe a
optnew forall a b. (a -> b) -> a -> b
$ \ MeasuredGraphics
mg' CompiledGraphics
cg' Maybe LayoutRequest
optreq' ->
let cg'' :: CompiledGraphics
cg'' = case (Bool
hi,Maybe a
optnew) of
(Bool
False,Maybe a
Nothing) -> CompiledGraphics
-> [Int]
-> (CompiledGraphics -> CompiledGraphics)
-> CompiledGraphics
cgupdate CompiledGraphics
cg' [Int]
path CompiledGraphics -> CompiledGraphics
removecursor
(Bool
True,Maybe a
_) -> CompiledGraphics
-> [Int]
-> (CompiledGraphics -> CompiledGraphics)
-> CompiledGraphics
cgupdate CompiledGraphics
cg' [Int]
path CompiledGraphics -> CompiledGraphics
addcursor
(Bool, Maybe a)
_ -> CompiledGraphics
cg'
in MeasuredGraphics
-> CompiledGraphics
-> Maybe LayoutRequest
-> [([Int], GfxChange a)]
-> (LayoutRequest
-> MeasuredGraphics -> CompiledGraphics -> Bool -> K hi ho)
-> K hi ho
updGraphicsK MeasuredGraphics
mg' CompiledGraphics
cg'' Maybe LayoutRequest
optreq' [([Int], GfxChange a)]
changes LayoutRequest
-> MeasuredGraphics -> CompiledGraphics -> Bool -> K hi ho
c
group :: Int -> Int -> K hi ho
group Int
from Int
count = MeasuredGraphics
-> CompiledGraphics
-> Maybe LayoutRequest
-> [([Int], GfxChange a)]
-> (LayoutRequest
-> MeasuredGraphics -> CompiledGraphics -> Bool -> K hi ho)
-> K hi ho
updGraphicsK MeasuredGraphics
mg' CompiledGraphics
cg' Maybe LayoutRequest
optreq [([Int], GfxChange a)]
changes LayoutRequest
-> MeasuredGraphics -> CompiledGraphics -> Bool -> K hi ho
c
where mg' :: MeasuredGraphics
mg' = MeasuredGraphics
-> [Int]
-> (MeasuredGraphics -> MeasuredGraphics)
-> MeasuredGraphics
updateMGPart MeasuredGraphics
mg [Int]
path (Int -> Int -> MeasuredGraphics -> MeasuredGraphics
groupMGParts Int
from Int
count)
cg' :: CompiledGraphics
cg' = CompiledGraphics
-> [Int]
-> (CompiledGraphics -> CompiledGraphics)
-> CompiledGraphics
cgupdate CompiledGraphics
cg [Int]
path (Int -> Int -> CompiledGraphics -> CompiledGraphics
cgGroup Int
from Int
count)
ungroup :: Int -> K hi ho
ungroup Int
pos = MeasuredGraphics
-> CompiledGraphics
-> Maybe LayoutRequest
-> [([Int], GfxChange a)]
-> (LayoutRequest
-> MeasuredGraphics -> CompiledGraphics -> Bool -> K hi ho)
-> K hi ho
updGraphicsK MeasuredGraphics
mg' CompiledGraphics
cg' Maybe LayoutRequest
optreq [([Int], GfxChange a)]
changes LayoutRequest
-> MeasuredGraphics -> CompiledGraphics -> Bool -> K hi ho
c
where mg' :: MeasuredGraphics
mg' = MeasuredGraphics
-> [Int]
-> (MeasuredGraphics -> MeasuredGraphics)
-> MeasuredGraphics
updateMGPart MeasuredGraphics
mg [Int]
path (Int -> MeasuredGraphics -> MeasuredGraphics
ungroupMGParts Int
pos)
cg' :: CompiledGraphics
cg' = CompiledGraphics
-> [Int]
-> (CompiledGraphics -> CompiledGraphics)
-> CompiledGraphics
cgupdate CompiledGraphics
cg [Int]
path (Int -> CompiledGraphics -> CompiledGraphics
cgUngroup Int
pos)
bufDrawChangesK :: Bool
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> K hi ho
-> K hi ho
bufDrawChangesK = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
Bool
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> f hi ho
-> f hi ho
drawChangesK forall {p} {hi} {ho}.
DbeBackBufferId
-> p
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> K hi ho
-> K hi ho
backBufDrawChangesK Maybe DbeBackBufferId
optbackbuf
bufDrawK :: (GCId, Rect -> [t])
-> (t -> [Rect]) -> CompiledGraphics -> K hi ho -> K hi ho
bufDrawK = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {f :: * -> * -> *} {t} {hi} {ho}.
FudgetIO f =>
(GCId, Rect -> [t])
-> (t -> [Rect]) -> CompiledGraphics -> f hi ho -> f hi ho
drawK forall {t} {hi} {ho}.
DbeBackBufferId
-> (GCId, Rect -> [t])
-> (t -> [Rect])
-> CompiledGraphics
-> K hi ho
-> K hi ho
backBufDrawK Maybe DbeBackBufferId
optbackbuf
backBufDrawChangesK :: DbeBackBufferId
-> p
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> K hi ho
-> K hi ho
backBufDrawChangesK DbeBackBufferId
backbuf p
beQuick (GCId, Rect -> [Rect])
cur CompiledGraphics
new CompiledGraphics
old [[Int]]
changes K hi ho
cont =
forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
Maybe (Drawable, GCId)
-> Bool
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> f hi ho
-> f hi ho
drawChangesK' (forall a. a -> Maybe a
Just (DbeBackBufferId -> Drawable
DbeBackBuffer DbeBackBufferId
backbuf,GCId
cleargc)) Bool
False (GCId, Rect -> [Rect])
cur CompiledGraphics
new CompiledGraphics
old [[Int]]
changes forall a b. (a -> b) -> a -> b
$
forall {b} {c}. K b c -> K b c
dbeSwapBuffers forall a b. (a -> b) -> a -> b
$
K hi ho
cont
backBufDrawK :: DbeBackBufferId
-> (GCId, Rect -> [t])
-> (t -> [Rect])
-> CompiledGraphics
-> K hi ho
-> K hi ho
backBufDrawK DbeBackBufferId
backbuf (GCId, Rect -> [t])
cur t -> [Rect]
clip CompiledGraphics
cg K hi ho
cont =
forall {f :: * -> * -> *} {t} {hi} {ho}.
FudgetIO f =>
Drawable
-> (GCId, Rect -> [t])
-> (t -> [Rect])
-> CompiledGraphics
-> f hi ho
-> f hi ho
drawK' (DbeBackBufferId -> Drawable
DbeBackBuffer DbeBackBufferId
backbuf) (GCId, Rect -> [t])
cur t -> [Rect]
clip CompiledGraphics
cg forall a b. (a -> b) -> a -> b
$
forall {b} {c}. K b c -> K b c
dbeSwapBuffers forall a b. (a -> b) -> a -> b
$
K hi ho
cont
where (GC GCId
gc FontData
_) = GCtx
gctx
buttonEvent :: Int
-> Point
-> ModState
-> Pressed
-> Button
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
buttonEvent Int
t Point
p ModState
state Pressed
type' Button
button =
forall {f :: * -> * -> *} {ho} {hi}.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
forall path.
Int
-> ModState
-> Pressed
-> Button
-> [(path, (Point, Rect))]
-> GfxEvent path
GfxButtonEvent Int
t ModState
state Pressed
type' Button
button (Point -> CompiledGraphics -> [([Int], (Point, Rect))]
locatePointOut Point
p CompiledGraphics
cg)) forall a b. (a -> b) -> a -> b
$
K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
same
motionEvent :: Int
-> Point
-> ModState
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
motionEvent Int
t Point
p ModState
state =
forall {f :: * -> * -> *} {ho} {hi}.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall path.
Int -> ModState -> [(path, (Point, Rect))] -> GfxEvent path
GfxMotionEvent Int
t ModState
state (Point -> CompiledGraphics -> [([Int], (Point, Rect))]
locatePointOut Point
p CompiledGraphics
cg)) forall a b. (a -> b) -> a -> b
$
K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
same
key :: Int
-> ModState
-> KeySym
-> KeySym
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
key Int
t ModState
mods KeySym
sym KeySym
lookup =
forall {f :: * -> * -> *} {ho} {hi}.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall path. Int -> ModState -> KeySym -> KeySym -> GfxEvent path
GfxKeyEvent Int
t ModState
mods KeySym
sym KeySym
lookup) forall a b. (a -> b) -> a -> b
$ K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
same
highK :: GfxCommand [Int] a
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
highK (ShowGfx [Int]
path (Maybe Alignment, Maybe Alignment)
align) = forall {hi} {ho}.
CompiledGraphics
-> [Int]
-> (Maybe Alignment, Maybe Alignment)
-> K hi ho
-> K hi ho
mkPathVisible CompiledGraphics
cg (forall {a}. Num a => [a] -> [a]
pathIn [Int]
path) (Maybe Alignment, Maybe Alignment)
align K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
same
highK (BellGfx Int
n) = forall {i} {o}. XCommand -> K i o -> K i o
xcommandK (Int -> XCommand
Bell Int
n) K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
same
highK (GetGfxPlaces [[Int]]
paths) =
forall {f :: * -> * -> *} {ho} {hi}.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall path. [Rect] -> GfxEvent path
GfxPlaces forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CompiledGraphics -> Rect
cgrect forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompiledGraphics -> [Int] -> CompiledGraphics
cgpart CompiledGraphics
cg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Num a => [a] -> [a]
pathIn) [[Int]]
paths) forall a b. (a -> b) -> a -> b
$
K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
same
highK (ChangeGfxBg ColorSpec
bgspec) =
forall {a} {f :: * -> * -> *} {i} {o}.
(ColorGen a, FudgetIO f, Show a) =>
a -> (Pixel -> f i o) -> f i o
convColorK ColorSpec
bgspec forall a b. (a -> b) -> a -> b
$ \ Pixel
bgcol ->
forall {i} {o}. XCommand -> K i o -> K i o
xcommandK ([WindowAttributes] -> XCommand
ChangeWindowAttributes [Pixel -> WindowAttributes
CWBackPixel Pixel
bgcol]) forall a b. (a -> b) -> a -> b
$
forall {i} {o}. XCommand -> K i o -> K i o
xcommandK XCommand
clearWindowExpose forall a b. (a -> b) -> a -> b
$
forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
GCId -> GCAttributeList -> (GCId -> f hi ho) -> f hi ho
wCreateGC GCId
rootGC [forall a b. a -> GCAttributes a b
GCForeground Pixel
bgcol] forall a b. (a -> b) -> a -> b
$ \ GCId
cleargc' ->
GCId -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
newcleargc GCId
cleargc'
highK (ChangeGfxBgPixmap PixmapId
pixmap Bool
freeIt) =
forall {i} {o}. XCommand -> K i o -> K i o
xcommandK ([WindowAttributes] -> XCommand
ChangeWindowAttributes [PixmapId -> WindowAttributes
CWBackPixmap PixmapId
pixmap]) forall a b. (a -> b) -> a -> b
$
forall {i} {o}. XCommand -> K i o -> K i o
xcommandK XCommand
clearWindowExpose forall a b. (a -> b) -> a -> b
$
forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
GCId -> GCAttributeList -> (GCId -> f hi ho) -> f hi ho
wCreateGC GCId
rootGC [forall a b. GCFillStyle -> GCAttributes a b
GCFillStyle GCFillStyle
FillTiled,forall a b. PixmapId -> GCAttributes a b
GCTile PixmapId
pixmap] forall a b. (a -> b) -> a -> b
$ \ GCId
cleargc' ->
(if Bool
freeIt then forall {i} {o}. XCommand -> K i o -> K i o
xcommandK (PixmapId -> XCommand
FreePixmap PixmapId
pixmap) else forall a. Customiser a
id) forall a b. (a -> b) -> a -> b
$
GCId -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
newcleargc GCId
cleargc'
#ifdef USE_EXIST_Q
highK (ChangeGfxBgGfx bg
gfx) =
forall {a} {k :: * -> * -> *} {i} {o}.
(Graphic a, FudgetIO k) =>
a -> GCtx -> (PixmapImage -> k i o) -> k i o
graphic2PixmapImage bg
gfx GCtx
gctx forall a b. (a -> b) -> a -> b
$ \ (PixmapImage Point
size PixmapId
pm) ->
GfxCommand [Int] a
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
highK (forall path gfx. PixmapId -> Bool -> GfxCommand path gfx
ChangeGfxBgPixmap PixmapId
pm Bool
True)
#endif
highK (ChangeGfxCursor CursorId
cursor) =
forall {i} {o}. CursorId -> K i o -> K i o
defineCursor CursorId
cursor forall a b. (a -> b) -> a -> b
$
forall {i} {o}. XCommand -> K i o -> K i o
xcommandK XCommand
Flush forall a b. (a -> b) -> a -> b
$
K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
same
highK (ChangeGfxFontCursor Int
shape) =
forall a b. Int -> K a b -> K a b
setFontCursor Int
shape forall a b. (a -> b) -> a -> b
$
forall {i} {o}. XCommand -> K i o -> K i o
xcommandK XCommand
Flush forall a b. (a -> b) -> a -> b
$
K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
same
highK (ChangeGfx [([Int], GfxChange a)]
changes0) =
forall {a} {hi} {ho}.
Graphic a =>
MeasuredGraphics
-> CompiledGraphics
-> Maybe LayoutRequest
-> [([Int], GfxChange a)]
-> (LayoutRequest
-> MeasuredGraphics -> CompiledGraphics -> Bool -> K hi ho)
-> K hi ho
updGraphicsK MeasuredGraphics
mg CompiledGraphics
cg forall a. Maybe a
Nothing [([Int], GfxChange a)]
changes forall a b. (a -> b) -> a -> b
$ \ LayoutRequest
req' MeasuredGraphics
mg' CompiledGraphics
cg' Bool
beQuick ->
forall {hi} {ho}.
Bool
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> K hi ho
-> K hi ho
bufDrawChangesK Bool
beQuick (GCId
higc,Rect -> [Rect]
curR) CompiledGraphics
cg' CompiledGraphics
cg (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst [([Int], GfxChange a)]
changes) forall a b. (a -> b) -> a -> b
$
GCId
-> LayoutRequest
-> MeasuredGraphics
-> CompiledGraphics
-> Bool
-> [Rect]
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
idleK GCId
cleargc LayoutRequest
req' MeasuredGraphics
mg' CompiledGraphics
cg' Bool
active []
where changes :: [([Int], GfxChange a)]
changes = forall {t} {a} {b}. (t -> a) -> [(t, b)] -> [(a, b)]
mapFst forall {a}. Num a => [a] -> [a]
pathIn [([Int], GfxChange a)]
changes0
changeActive :: Bool -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
changeActive Bool
active' =
if Bool
active'forall a. Eq a => a -> a -> Bool
==Bool
active
then K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
same
else forall {f :: * -> * -> *} {ho} {hi}.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ GfxFocusEvent { gfxHasFocus :: Bool
gfxHasFocus=Bool
active' }) forall a b. (a -> b) -> a -> b
$
forall {hi} {ho}.
Bool
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> K hi ho
-> K hi ho
bufDrawChangesK Bool
True (GCId
higc,Bool -> Rect -> [Rect]
hiR (Bool
solidBool -> Bool -> Bool
||Bool
active')) CompiledGraphics
cg CompiledGraphics
cg (CompiledGraphics -> [[Int]]
cursorPaths CompiledGraphics
cg) forall a b. (a -> b) -> a -> b
$
GCId
-> LayoutRequest
-> MeasuredGraphics
-> CompiledGraphics
-> Bool
-> [Rect]
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
idleK GCId
cleargc LayoutRequest
req MeasuredGraphics
mg CompiledGraphics
cg Bool
active' [Rect]
es
lowK :: FResponse
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
lowK (XEvt XEvent
e) = XEvent -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
eventK XEvent
e
lowK (LEvt LayoutResponse
lresp) = LayoutResponse
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
layoutK LayoutResponse
lresp
lowK FResponse
_ = K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
same
layoutK :: LayoutResponse
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
layoutK LayoutResponse
lresp =
case LayoutResponse
lresp of
LayoutSize Point
size'
| Bool
adjsize ->
if Point
size' forall a. Eq a => a -> a -> Bool
== Point
size then K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
same
else let cg'' :: CompiledGraphics
cg'' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Int] -> CompiledGraphics -> CompiledGraphics
restorecursor CompiledGraphics
cg' (CompiledGraphics -> [[Int]]
cgcursors CompiledGraphics
cg)
where
restorecursor :: [Int] -> CompiledGraphics -> CompiledGraphics
restorecursor [Int]
path CompiledGraphics
cg = CompiledGraphics
-> [Int]
-> (CompiledGraphics -> CompiledGraphics)
-> CompiledGraphics
cgupdate CompiledGraphics
cg [Int]
path CompiledGraphics -> CompiledGraphics
addcursor
(CompiledGraphics
cg',LayoutRequest
_) = (Point -> Point)
-> MeasuredGraphics -> (CompiledGraphics, LayoutRequest)
compileMG (forall a b. a -> b -> a
const Point
size') MeasuredGraphics
mg
in forall {f :: * -> * -> *} {ho} {hi}.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall path. Point -> GfxEvent path
GfxResized Point
size') forall a b. (a -> b) -> a -> b
$
forall {hi} {ho}.
Bool
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> K hi ho
-> K hi ho
bufDrawChangesK Bool
True (GCId
higc,Rect -> [Rect]
curR) CompiledGraphics
cg'' CompiledGraphics
cg [] forall a b. (a -> b) -> a -> b
$
GCId
-> LayoutRequest
-> MeasuredGraphics
-> CompiledGraphics
-> Bool
-> [Rect]
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
idleK GCId
cleargc LayoutRequest
req' MeasuredGraphics
mg CompiledGraphics
cg'' Bool
active [Rect]
es
| Bool
otherwise -> GCId
-> LayoutRequest
-> MeasuredGraphics
-> CompiledGraphics
-> Bool
-> [Rect]
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
idleK GCId
cleargc LayoutRequest
req' MeasuredGraphics
mg CompiledGraphics
cg Bool
active [Rect]
es
where req' :: LayoutRequest
req' = (Point -> Point) -> LayoutRequest -> LayoutRequest
mapLayoutSize (forall a b. a -> b -> a
const Point
size') LayoutRequest
req
LayoutResponse
_ -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
same
eventK :: XEvent -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
eventK XEvent
event =
case XEvent
event of
Expose Rect
r Int
0 ->
let rs :: [Rect]
rs = Rect
rforall a. a -> [a] -> [a]
:[Rect]
es
in forall {t} {hi} {ho}.
(GCId, Rect -> [t])
-> (t -> [Rect]) -> CompiledGraphics -> K hi ho -> K hi ho
bufDrawK (GCId
higc,Rect -> [Rect]
curR) ([Rect] -> Rect -> [Rect]
intersectRects [Rect]
rs) (forall {t :: * -> *}.
Foldable t =>
t Rect -> CompiledGraphics -> CompiledGraphics
prune [Rect]
rs CompiledGraphics
cg) forall a b. (a -> b) -> a -> b
$
GCId
-> LayoutRequest
-> MeasuredGraphics
-> CompiledGraphics
-> Bool
-> [Rect]
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
idleK GCId
cleargc LayoutRequest
req MeasuredGraphics
mg CompiledGraphics
cg Bool
active []
Expose Rect
r Int
_ -> GCId
-> LayoutRequest
-> MeasuredGraphics
-> CompiledGraphics
-> Bool
-> [Rect]
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
idleK GCId
cleargc LayoutRequest
req MeasuredGraphics
mg CompiledGraphics
cg Bool
active (Rect
rforall a. a -> [a] -> [a]
:[Rect]
es)
FocusIn {} -> Bool -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
changeActive Bool
True
FocusOut {} -> Bool -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
changeActive Bool
False
ButtonEvent {time :: XEvent -> Int
time=Int
t, pos :: XEvent -> Point
pos=Point
pos, type' :: XEvent -> Pressed
type'=Pressed
type', button :: XEvent -> Button
button=Button
button, state :: XEvent -> ModState
state=ModState
state} ->
Int
-> Point
-> ModState
-> Pressed
-> Button
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
buttonEvent Int
t Point
pos ModState
state Pressed
type' Button
button
MotionNotify {time :: XEvent -> Int
time=Int
t,pos :: XEvent -> Point
pos=Point
pos,state :: XEvent -> ModState
state=ModState
state} -> Int
-> Point
-> ModState
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
motionEvent Int
t Point
pos ModState
state
KeyEvent Int
t Point
_ Point
_ ModState
mods Pressed
Pressed KeyCode
_ KeySym
sym KeySym
lookup -> Int
-> ModState
-> KeySym
-> KeySym
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
key Int
t ModState
mods KeySym
sym KeySym
lookup
XEvent
_ -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
same
prune :: t Rect -> CompiledGraphics -> CompiledGraphics
prune t Rect
rs (CGMark CompiledGraphics
cg) = CompiledGraphics -> CompiledGraphics
CGMark (t Rect -> CompiledGraphics -> CompiledGraphics
prune t Rect
rs CompiledGraphics
cg)
prune t Rect
rs (CGraphics Rect
r Bool
cur [(GCId, [DrawCommand])]
cmds [CompiledGraphics]
cgs) =
if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Rect -> Rect -> Bool
overlaps Rect
r) t Rect
rs
then if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(GCId, [DrawCommand])]
cmds
then Rect
-> Bool
-> [(GCId, [DrawCommand])]
-> [CompiledGraphics]
-> CompiledGraphics
CGraphics Rect
r Bool
cur [(GCId, [DrawCommand])]
cmds (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t Rect -> CompiledGraphics -> CompiledGraphics
prune t Rect
rs) [CompiledGraphics]
cgs)
else Rect
-> Bool
-> [(GCId, [DrawCommand])]
-> [CompiledGraphics]
-> CompiledGraphics
CGraphics Rect
r Bool
cur [(GCId, [DrawCommand])]
cmds [CompiledGraphics]
cgs
else Rect
-> Bool
-> [(GCId, [DrawCommand])]
-> [CompiledGraphics]
-> CompiledGraphics
CGraphics Rect
r Bool
cur [] []
locatePoint :: Point -> CompiledGraphics -> [([Int], (Point, Rect))]
locatePoint Point
p (CGMark CompiledGraphics
cg) = [(Int
0forall a. a -> [a] -> [a]
:[Int]
path,(Point, Rect)
geom)|([Int]
path,(Point, Rect)
geom)<-Point -> CompiledGraphics -> [([Int], (Point, Rect))]
locatePoint Point
p CompiledGraphics
cg]
locatePoint Point
p (CGraphics Rect
r Bool
_ [(GCId, [DrawCommand])]
_ [CompiledGraphics]
gs) =
if Point
p Point -> Rect -> Bool
`inRect` Rect
r
then let ps :: [[([Int], (Point, Rect))]]
ps = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Point -> CompiledGraphics -> [([Int], (Point, Rect))]
locatePoint Point
p) [CompiledGraphics]
gs
in case [ (Int
iforall a. a -> [a] -> [a]
:[Int]
path,(Point, Rect)
pr) | (Int
i,[([Int], (Point, Rect))]
paths)<-forall a. Int -> [a] -> [(Int, a)]
number Int
1 [[([Int], (Point, Rect))]]
ps, ([Int]
path,(Point, Rect)
pr)<-[([Int], (Point, Rect))]
paths] of
[] -> [([],(Point
pforall a. Num a => a -> a -> a
-Rect -> Point
rectpos Rect
r,Rect
r))]
[([Int], (Point, Rect))]
ps -> [([Int], (Point, Rect))]
ps
else []
cursorPaths :: CompiledGraphics -> [[Int]]
cursorPaths (CGMark CompiledGraphics
cg) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
0forall a. a -> [a] -> [a]
:) (CompiledGraphics -> [[Int]]
cursorPaths CompiledGraphics
cg)
cursorPaths (CGraphics Rect
_ Bool
cur [(GCId, [DrawCommand])]
_ [CompiledGraphics]
gs) =
if Bool
cur
then [[]]
else [Int
iforall a. a -> [a] -> [a]
:[Int]
p | (Int
i,CompiledGraphics
g)<-forall a. Int -> [a] -> [(Int, a)]
number Int
1 [CompiledGraphics]
gs, [Int]
p<-CompiledGraphics -> [[Int]]
cursorPaths CompiledGraphics
g]
hiR :: Bool -> Rect -> [Rect]
hiR Bool
True = forall {a}. a -> [a]
solidCursorRects
hiR Bool
False = Rect -> [Rect]
hollowCursorRects
solidCursorRects :: a -> [a]
solidCursorRects a
r = [a
r]
hollowCursorRects :: Rect -> [Rect]
hollowCursorRects (Rect (Point Int
x Int
y) (Point Int
w Int
h)) =
[Int -> Int -> Int -> Int -> Rect
rR Int
x Int
y Int
w Int
lw,Int -> Int -> Int -> Int -> Rect
rR Int
x Int
y Int
lw Int
h,Int -> Int -> Int -> Int -> Rect
rR Int
x (Int
yforall a. Num a => a -> a -> a
+Int
hforall a. Num a => a -> a -> a
-Int
lw) Int
w Int
lw,Int -> Int -> Int -> Int -> Rect
rR (Int
xforall a. Num a => a -> a -> a
+Int
wforall a. Num a => a -> a -> a
-Int
lw) Int
y Int
lw Int
h]
where lw :: Int
lw=forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Int
2,Int
w,Int
h]
mkChangeVisible :: CompiledGraphics -> [([Int], (Bool, b))] -> K hi ho -> K hi ho
mkChangeVisible CompiledGraphics
cg [([Int], (Bool, b))]
changes =
case [ [Int]
path | ([Int]
path,(Bool
True,b
_))<-[([Int], (Bool, b))]
changes] of
[Int]
path:[[Int]]
_ -> forall {hi} {ho}.
CompiledGraphics
-> [Int]
-> (Maybe Alignment, Maybe Alignment)
-> K hi ho
-> K hi ho
mkPathVisible CompiledGraphics
cg [Int]
path (forall a. Maybe a
Nothing,forall a. Maybe a
Nothing)
[[Int]]
_ -> forall a. Customiser a
id
mkPathVisible :: CompiledGraphics
-> [Int]
-> (Maybe Alignment, Maybe Alignment)
-> K hi ho
-> K hi ho
mkPathVisible CompiledGraphics
cg [Int]
path (Maybe Alignment, Maybe Alignment)
align =
forall {hi} {ho}. LayoutMessage -> K hi ho -> K hi ho
putLayout (Rect -> LayoutMessage
lMkVis (CompiledGraphics -> Rect
cgrect (CompiledGraphics -> [Int] -> CompiledGraphics
cgpart CompiledGraphics
cg [Int]
path)))
where
lMkVis :: Rect -> LayoutMessage
lMkVis Rect
r = Rect -> (Maybe Alignment, Maybe Alignment) -> LayoutMessage
LayoutMakeVisible (Rect
r Rect -> Point -> Rect
`growrect` Point
5) (Maybe Alignment, Maybe Alignment)
align
putLayoutReq :: LayoutRequest -> K hi ho -> K hi ho
putLayoutReq = forall {hi} {ho}. LayoutMessage -> K hi ho -> K hi ho
putLayout forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutRequest -> LayoutMessage
LayoutRequest
putLayout :: LayoutMessage -> K hi ho -> K hi ho
putLayout = forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Message a b
Low forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutMessage -> FRequest
LCmd
createCursorGC :: GCId -> Pixel -> Pixel -> (GCId -> K i o) -> K i o
createCursorGC GCId
gc Pixel
bg Pixel
fg GCId -> K i o
cont =
forall a (f :: * -> * -> *) i o.
(ColorGen a, FudgetIO f) =>
a -> Cont (f i o) (Maybe Pixel)
tryConvColorK [KeySym]
cursorcolor forall a b. (a -> b) -> a -> b
$ \ Maybe Pixel
opthipix ->
let hipix :: Pixel
hipix = forall a. a -> Maybe a -> a
fromMaybe Pixel
fg Maybe Pixel
opthipix
in if Pixel
hipixforall a. Eq a => a -> a -> Bool
/=Pixel
bg Bool -> Bool -> Bool
&& Pixel
hipixforall a. Eq a => a -> a -> Bool
/=Pixel
fg Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
mono
then forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
GCId -> GCAttributeList -> (GCId -> f hi ho) -> f hi ho
wCreateGC GCId
gc [forall a b. a -> GCAttributes a b
GCForeground Pixel
hipix] forall a b. (a -> b) -> a -> b
$ \ GCId
cursorgc ->
GCId -> K i o
cont GCId
cursorgc
else forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
Point -> Int -> (PixmapId -> f hi ho) -> f hi ho
createPixmap (Int -> Int -> Point
Point Int
2 Int
2) Int
copyFromParent forall a b. (a -> b) -> a -> b
$ \ PixmapId
pm ->
forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
GCId -> GCAttributeList -> (GCId -> f hi ho) -> f hi ho
wCreateGC GCId
gc [forall a b. a -> GCAttributes a b
GCForeground Pixel
bg] forall a b. (a -> b) -> a -> b
$ \ GCId
cleargc ->
forall {b} {a}. [KCommand b] -> K a b -> K a b
putsK [forall a b. a -> Message a b
Low forall a b. (a -> b) -> a -> b
$ PixmapId -> GCId -> Rect -> FRequest
pmFillRectangle PixmapId
pm GCId
cleargc (Int -> Int -> Int -> Int -> Rect
rR Int
0 Int
0 Int
2 Int
2),
forall a b. a -> Message a b
Low forall a b. (a -> b) -> a -> b
$ PixmapId -> GCId -> Point -> FRequest
pmDrawPoint PixmapId
pm GCId
gc Point
0] forall a b. (a -> b) -> a -> b
$
forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
GCId -> GCAttributeList -> (GCId -> f hi ho) -> f hi ho
wCreateGC GCId
gc [forall a b. GCFillStyle -> GCAttributes a b
GCFillStyle GCFillStyle
FillTiled,forall a b. PixmapId -> GCAttributes a b
GCTile PixmapId
pm] forall a b. (a -> b) -> a -> b
$ \ GCId
cursorgc ->
GCId -> K i o
cont GCId
cursorgc
similar :: LayoutRequest -> LayoutRequest -> Bool
similar LayoutRequest
l1 LayoutRequest
l2 =
LayoutRequest -> Point
minsize LayoutRequest
l1forall a. Eq a => a -> a -> Bool
==LayoutRequest -> Point
minsize LayoutRequest
l2 Bool -> Bool -> Bool
&&
LayoutRequest -> Bool
fixedh LayoutRequest
l1forall a. Eq a => a -> a -> Bool
==LayoutRequest -> Bool
fixedh LayoutRequest
l2 Bool -> Bool -> Bool
&&
LayoutRequest -> Bool
fixedv LayoutRequest
l1forall a. Eq a => a -> a -> Bool
==LayoutRequest -> Bool
fixedv LayoutRequest
l2
cursorcolor :: [KeySym]
cursorcolor = KeySym -> [KeySym] -> [KeySym]
argKeyList KeySym
"cursor" [KeySym
"yellow"]
mono :: Bool
mono = KeySym -> Bool -> Bool
argFlag KeySym
"mono" Bool
False
defaultdoublebuffer :: Bool
defaultdoublebuffer = KeySym -> Bool -> Bool
argFlag KeySym
"doublebuffer" Bool
False
swapaction :: SwapAction
swapaction = forall {p}. (Read p, Show p) => KeySym -> p -> p
argReadKey KeySym
"swapaction" SwapAction
DbeCopied