{-# 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)--mapFilterSP
--import SerCompF(stubF)
import Command
import DrawInPixmap(pmFillRectangle,pmDrawPoint)
--import DrawInWindow(wCopyArea)
import Event
import Xtypes
import Geometry
import Gc
import Pixmap
import Cursor
--import Color
--import Font(font_id,string_box_size)
--import LoadFont(safeLoadQueryFont)
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 InputMsg
import Graphic
import CompiledGraphics
import MeasuredGraphics(MeasuredGraphics(SpacedM,MarkM),compileMG,DPath(..))--,emptyMG,emptyMG'
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)--,mapEither
import Sizing(newSize,Sizing(..))
--import HO(apSnd)
--import Maybe(fromMaybe)
import Xrequest(xrequestK)
import StdIoUtil(echoStderrK)
--import ContinuationIO(stderr)
--import Maptrace(ctrace) -- debugging

import FDefaults
#include "defaults.h"
#include "exists.h"
--  Commands for grapihcsF: ---------------------------------------------------

data GfxChange gfx
  = GfxReplace (Bool,Maybe gfx)
  | GfxGroup Int Int -- position & length
  | GfxUngroup Int -- position
  
data GfxCommand path gfx
  = ChangeGfx [(path,GfxChange gfx)]
  | ChangeGfxBg ColorSpec
  | ChangeGfxBgPixmap PixmapId Bool -- True = free pixmap
#ifdef USE_EXIST_Q
  | EXISTS(bg) TSTHACK((Graphic EQV(bg)) =>) ChangeGfxBgGfx EQV(bg)
#endif
  | ChangeGfxCursor CursorId
  | ChangeGfxFontCursor Int
  | ShowGfx path (Maybe Alignment,Maybe Alignment) -- makes the selected part visible
  | BellGfx Int -- sound the bell
  | GetGfxPlaces [path] -- ask for rectangles of listed paths

replaceAllGfx :: gfx -> GfxCommand [a] gfx
replaceAllGfx = [a] -> gfx -> GfxCommand [a] gfx
forall path gfx. path -> gfx -> GfxCommand path gfx
replaceGfx []
replaceGfx :: path -> gfx -> GfxCommand path gfx
replaceGfx path
path gfx
gfx = [(path, GfxChange gfx)] -> GfxCommand path gfx
forall path gfx. [(path, GfxChange gfx)] -> GfxCommand path gfx
ChangeGfx [(path
path,(Bool, Maybe gfx) -> GfxChange gfx
forall gfx. (Bool, Maybe gfx) -> GfxChange gfx
GfxReplace (Bool
False,gfx -> Maybe gfx
forall a. a -> Maybe a
Just gfx
gfx))]
showGfx :: path -> GfxCommand path gfx
showGfx path
path = path -> (Maybe Alignment, Maybe Alignment) -> GfxCommand path gfx
forall path gfx.
path -> (Maybe Alignment, Maybe Alignment) -> GfxCommand path gfx
ShowGfx path
path (Maybe Alignment
forall a. Maybe a
Nothing,Maybe Alignment
forall a. Maybe a
Nothing)
highlightGfx :: path -> Bool -> GfxCommand path gfx
highlightGfx path
path Bool
on = [(path, GfxChange gfx)] -> GfxCommand path gfx
forall path gfx. [(path, GfxChange gfx)] -> GfxCommand path gfx
ChangeGfx [(path
path,(Bool, Maybe gfx) -> GfxChange gfx
forall gfx. (Bool, Maybe gfx) -> GfxChange gfx
GfxReplace (Bool
on,Maybe gfx
forall a. Maybe a
Nothing))]

instance Functor GfxChange where
  fmap :: (a -> b) -> GfxChange a -> GfxChange b
fmap a -> b
f (GfxReplace (Bool, Maybe a)
r) = (Bool, Maybe b) -> GfxChange b
forall gfx. (Bool, Maybe gfx) -> GfxChange gfx
GfxReplace ((Maybe a -> Maybe b) -> (Bool, Maybe a) -> (Bool, Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Maybe a -> Maybe b
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) = Int -> Int -> GfxChange b
forall gfx. Int -> Int -> GfxChange gfx
GfxGroup Int
from Int
count
  fmap a -> b
f (GfxUngroup Int
at) = Int -> GfxChange b
forall gfx. Int -> GfxChange gfx
GfxUngroup Int
at

instance Functor (GfxCommand path) where
  fmap :: (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 -> [(path, GfxChange b)] -> GfxCommand path b
forall path gfx. [(path, GfxChange gfx)] -> GfxCommand path gfx
ChangeGfx ((GfxChange a -> GfxChange b)
-> [(path, GfxChange a)] -> [(path, GfxChange b)]
forall t b a. (t -> b) -> [(a, t)] -> [(a, b)]
mapSnd ((a -> b) -> GfxChange a -> GfxChange b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [(path, GfxChange a)]
changes)
      -- _ -> cmd -- Operationally, the rest is the same as this line.
      ChangeGfxBg ColorSpec
c -> ColorSpec -> GfxCommand path b
forall path gfx. ColorSpec -> GfxCommand path gfx
ChangeGfxBg ColorSpec
c
      ChangeGfxBgPixmap PixmapId
pm Bool
b -> PixmapId -> Bool -> GfxCommand path b
forall path gfx. PixmapId -> Bool -> GfxCommand path gfx
ChangeGfxBgPixmap PixmapId
pm Bool
b
#ifdef USE_EXIST_Q
      ChangeGfxBgGfx bg
gfx -> bg -> GfxCommand path b
forall path gfx bg. Graphic bg => bg -> GfxCommand path gfx
ChangeGfxBgGfx bg
gfx
#endif
      ChangeGfxCursor CursorId
cursor -> CursorId -> GfxCommand path b
forall path gfx. CursorId -> GfxCommand path gfx
ChangeGfxCursor CursorId
cursor
      ChangeGfxFontCursor Int
shape -> Int -> GfxCommand path b
forall path gfx. Int -> GfxCommand path gfx
ChangeGfxFontCursor Int
shape
      ShowGfx path
path (Maybe Alignment, Maybe Alignment)
a -> path -> (Maybe Alignment, Maybe Alignment) -> GfxCommand path b
forall path gfx.
path -> (Maybe Alignment, Maybe Alignment) -> GfxCommand path gfx
ShowGfx path
path (Maybe Alignment, Maybe Alignment)
a
      BellGfx Int
n -> Int -> GfxCommand path b
forall path gfx. Int -> GfxCommand path gfx
BellGfx Int
n
      GetGfxPlaces [path]
paths -> [path] -> GfxCommand path b
forall path gfx. [path] -> GfxCommand path gfx
GetGfxPlaces [path]
paths

--  Events from graphicsF: ----------------------------------------------------

data GfxEvent path
  = GfxButtonEvent { GfxEvent path -> Int
gfxTime  :: Time,
                     GfxEvent path -> ModState
gfxState :: ModState,
		     GfxEvent path -> Pressed
gfxType  :: Pressed,
                     GfxEvent path -> Button
gfxButton:: Button,
		     GfxEvent path -> [(path, (Point, Rect))]
gfxPaths :: [(path,(Point,Rect))] }
  | GfxMotionEvent { gfxTime  :: Time,
                     gfxState :: ModState,
		     gfxPaths :: [(path,(Point,Rect))] }
  | GfxKeyEvent    { gfxTime  :: Time,
                     gfxState::ModState,
                     GfxEvent path -> KeySym
gfxKeySym::KeySym,
		     GfxEvent path -> KeySym
gfxKeyLookup::KeyLookup }
  | GfxFocusEvent  { GfxEvent path -> Bool
gfxHasFocus :: Bool }
  | GfxPlaces [Rect] -- response to GetGfxPlaces
  | GfxResized Size
  deriving (GfxEvent path -> GfxEvent path -> Bool
(GfxEvent path -> GfxEvent path -> Bool)
-> (GfxEvent path -> GfxEvent path -> Bool) -> Eq (GfxEvent path)
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
[GfxEvent path] -> ShowS
GfxEvent path -> KeySym
(Int -> GfxEvent path -> ShowS)
-> (GfxEvent path -> KeySym)
-> ([GfxEvent path] -> ShowS)
-> Show (GfxEvent path)
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)


--  graphicsF event masks: ----------------------------------------------------

data GfxEventMask = GfxButtonMask | GfxMotionMask | GfxDragMask | GfxKeyMask

allGfxEvents :: [GfxEventMask]
allGfxEvents = [GfxEventMask
GfxButtonMask, GfxEventMask
GfxMotionMask, GfxEventMask
GfxDragMask, GfxEventMask
GfxKeyMask]
gfxMouseMask :: [GfxEventMask]
gfxMouseMask = [GfxEventMask
GfxButtonMask, GfxEventMask
GfxDragMask] -- backward compat

gfxEventMask :: [GfxEventMask] -> [EventMask]
gfxEventMask = (GfxEventMask -> [EventMask]) -> [GfxEventMask] -> [EventMask]
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 -- because of CTT implementation
	 ]

--  Customisers for graphicsF: ------------------------------------------------

newtype GraphicsF gfx = Pars [Pars gfx]

data Pars gfx
  -- Standard customisers:
  = BorderWidth Int
  | BgColorSpec ColorSpec
  | FgColorSpec ColorSpec
  | FontSpec FontSpec
  | Sizing Sizing
  | Stretchable (Bool,Bool)
  | InitSize gfx
  | InitDisp gfx
  -- Special customisers:
  | CursorSolid Bool
  | GfxEventMask [GfxEventMask]
  | AdjustSize Bool
  | Cursor Int -- pointer cursor shape for XCreateFontCursor
  | DoubleBuffer Bool
-- Could also support:
--  | Align Alignment
--  | Spacer Spacer
--  | Margin Int

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 :: F (GfxFCmd a) GfxFEvent
graphicsDispF = Customiser (GraphicsF a) -> F (GfxFCmd a) GfxFEvent
forall gfx.
Graphic gfx =>
Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) GfxFEvent
graphicsDispF' Customiser (GraphicsF a)
forall a. Customiser a
standard

graphicsLabelF :: a -> F e d
graphicsLabelF a
lbl = (GraphicsF a -> GraphicsF a) -> a -> F e d
forall a e d.
Graphic a =>
(GraphicsF a -> GraphicsF a) -> a -> F e d
graphicsLabelF' GraphicsF a -> GraphicsF a
forall a. Customiser a
standard a
lbl

graphicsLabelF' :: (GraphicsF a -> GraphicsF a) -> a -> F e d
graphicsLabelF' GraphicsF a -> GraphicsF a
customiser a
gfx = SP GfxFEvent d
forall a b. SP a b
nullSP SP GfxFEvent d -> F (GfxFCmd a) GfxFEvent -> F (GfxFCmd a) d
forall a b e. SP a b -> F e a -> F e b
>^^=< F (GfxFCmd a) GfxFEvent
d F (GfxFCmd a) d -> SP e (GfxFCmd a) -> F e d
forall c d e. F c d -> SP e c -> F e d
>=^^< SP e (GfxFCmd a)
forall a b. SP a b
nullSP'
  where d :: F (GfxFCmd a) GfxFEvent
d = (GraphicsF a -> GraphicsF a) -> F (GfxFCmd a) GfxFEvent
forall gfx.
Graphic gfx =>
Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) GfxFEvent
graphicsF' (GraphicsF a -> GraphicsF a
customiser (GraphicsF a -> GraphicsF a)
-> (GraphicsF a -> GraphicsF a) -> GraphicsF a -> GraphicsF a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphicsF a -> GraphicsF a
params)
	params :: GraphicsF a -> GraphicsF a
params = a -> GraphicsF a -> GraphicsF a
forall (xxx :: * -> *) a.
HasInitDisp xxx =>
a -> Customiser (xxx a)
setInitDisp a
gfx (GraphicsF a -> GraphicsF a)
-> (GraphicsF a -> GraphicsF a) -> GraphicsF a -> GraphicsF a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[GfxEventMask] -> GraphicsF a -> GraphicsF a
forall gfx. [GfxEventMask] -> Customiser (GraphicsF gfx)
setGfxEventMask [] (GraphicsF a -> GraphicsF a)
-> (GraphicsF a -> GraphicsF a) -> GraphicsF a -> GraphicsF a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sizing -> GraphicsF a -> GraphicsF a
forall xxx. HasSizing xxx => Sizing -> Customiser xxx
setSizing Sizing
Static (GraphicsF a -> GraphicsF a)
-> (GraphicsF a -> GraphicsF a) -> GraphicsF a -> GraphicsF a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		 KeySym -> GraphicsF a -> GraphicsF a
forall xxx a.
(HasBgColorSpec xxx, Show a, ColorGen a) =>
a -> Customiser xxx
setBgColor KeySym
bgColor (GraphicsF a -> GraphicsF a)
-> (GraphicsF a -> GraphicsF a) -> GraphicsF a -> GraphicsF a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GraphicsF a -> GraphicsF a
forall xxx. HasBorderWidth xxx => Int -> Customiser xxx
setBorderWidth Int
0
	nullSP' :: SP a b
nullSP' = SP a b
forall a b. SP a b
nullSP -- :: (SP anything (GfxCommand MeasuredGraphics))
	-- this is a workaround necessary to resolve the overloading

graphicsDispF' :: Graphic gfx => Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) (GfxFEvent)
graphicsDispF' :: Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) GfxFEvent
graphicsDispF' Customiser (GraphicsF gfx)
customiser  = Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) GfxFEvent
forall gfx.
Graphic gfx =>
Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) GfxFEvent
graphicsF' (Customiser (GraphicsF gfx)
customiser Customiser (GraphicsF gfx)
-> Customiser (GraphicsF gfx) -> Customiser (GraphicsF gfx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Customiser (GraphicsF gfx)
forall gfx. GraphicsF gfx -> GraphicsF gfx
dispCustomiser)
graphicsDispGroupF :: F i o -> F (Either (GfxFCmd gfx) i) (Either GfxFEvent o)
graphicsDispGroupF F i o
fud = Customiser (GraphicsF gfx)
-> F i o -> F (Either (GfxFCmd gfx) i) (Either GfxFEvent o)
forall gfx i o.
Graphic gfx =>
Customiser (GraphicsF gfx)
-> F i o -> F (Either (GfxFCmd gfx) i) (Either GfxFEvent o)
graphicsGroupF' Customiser (GraphicsF gfx)
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 =
  (GraphicsF gfx -> GraphicsF gfx)
-> F i o -> F (Either (GfxFCmd gfx) i) (Either GfxFEvent o)
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 (GraphicsF gfx -> GraphicsF gfx)
-> (GraphicsF gfx -> GraphicsF gfx)
-> GraphicsF gfx
-> GraphicsF gfx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphicsF gfx -> GraphicsF gfx
forall gfx. GraphicsF gfx -> GraphicsF gfx
dispCustomiser) F i o
fud

dispCustomiser :: GraphicsF gfx -> GraphicsF gfx
dispCustomiser =
  Bool -> GraphicsF gfx -> GraphicsF gfx
forall gfx. Bool -> Customiser (GraphicsF gfx)
setCursorSolid Bool
True (GraphicsF gfx -> GraphicsF gfx)
-> (GraphicsF gfx -> GraphicsF gfx)
-> GraphicsF gfx
-> GraphicsF gfx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GfxEventMask] -> GraphicsF gfx -> GraphicsF gfx
forall gfx. [GfxEventMask] -> Customiser (GraphicsF gfx)
setGfxEventMask [GfxEventMask]
gfxMouseMask (GraphicsF gfx -> GraphicsF gfx)
-> (GraphicsF gfx -> GraphicsF gfx)
-> GraphicsF gfx
-> GraphicsF gfx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sizing -> GraphicsF gfx -> GraphicsF gfx
forall xxx. HasSizing xxx => Sizing -> Customiser xxx
setSizing Sizing
Growing

graphicsF :: Graphic gfx => F (GfxFCmd gfx) (GfxFEvent)
graphicsF :: F (GfxFCmd gfx) GfxFEvent
graphicsF = Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) GfxFEvent
forall gfx.
Graphic gfx =>
Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) GfxFEvent
graphicsF' Customiser (GraphicsF gfx)
forall a. Customiser a
standard

graphicsF' :: Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) GfxFEvent
graphicsF' Customiser (GraphicsF gfx)
custom = SP (Either GfxFEvent Any) GfxFEvent
forall b1 b2. SP (Either b1 b2) b1
filterLeftSP SP (Either GfxFEvent Any) GfxFEvent
-> F (Either (GfxFCmd gfx) Any) (Either GfxFEvent Any)
-> F (Either (GfxFCmd gfx) Any) GfxFEvent
forall a b e. SP a b -> F e a -> F e b
>^^=< Customiser (GraphicsF gfx)
-> F Any Any -> F (Either (GfxFCmd gfx) Any) (Either GfxFEvent Any)
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 F Any Any
forall hi ho. F hi ho
nullF F (Either (GfxFCmd gfx) Any) GfxFEvent
-> (GfxFCmd gfx -> Either (GfxFCmd gfx) Any)
-> F (GfxFCmd gfx) GfxFEvent
forall c d e. F c d -> (e -> c) -> F e d
>=^< GfxFCmd gfx -> Either (GfxFCmd gfx) Any
forall a b. a -> Either a b
Left

graphicsGroupF :: Graphic gfx => F i o -> F (Either (GfxFCmd gfx) i) (Either (GfxFEvent) o)
graphicsGroupF :: F i o -> F (Either (GfxFCmd gfx) i) (Either GfxFEvent o)
graphicsGroupF = Customiser (GraphicsF gfx)
-> F i o -> F (Either (GfxFCmd gfx) i) (Either GfxFEvent o)
forall gfx i o.
Graphic gfx =>
Customiser (GraphicsF gfx)
-> F i o -> F (Either (GfxFCmd gfx) i) (Either GfxFEvent o)
graphicsGroupF' Customiser (GraphicsF gfx)
forall a. Customiser a
standard

--graphicsGroupF' :: (Graphic init,Graphic gfx => Customiser (GraphicsF init) -> F i o -> F (Either (GfxFCmd gfx) i) (Either (GfxFEvent) o)
graphicsGroupF' :: Graphic gfx => Customiser (GraphicsF gfx) -> F i o -> F (Either (GfxFCmd gfx) i) (Either (GfxFEvent) o)
graphicsGroupF' :: 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 = GraphicsF gfx -> Bool
forall gfx. GraphicsF gfx -> Bool
getCursorSolid GraphicsF gfx
params
      mask :: [GfxEventMask]
mask = GraphicsF gfx -> [GfxEventMask]
forall gfx. GraphicsF gfx -> [GfxEventMask]
getGfxEventMask GraphicsF gfx
params
      sizing :: Sizing
sizing = GraphicsF gfx -> Sizing
forall xxx. HasSizing xxx => xxx -> Sizing
getSizing GraphicsF gfx
params
      adjsize :: Bool
adjsize = GraphicsF gfx -> Bool
forall gfx. GraphicsF gfx -> Bool
getAdjustSize GraphicsF gfx
params
      doublebuffer :: Bool
doublebuffer = GraphicsF gfx -> Bool
forall gfx. GraphicsF gfx -> Bool
getDoubleBuffer GraphicsF gfx
params
      optcursor :: Maybe Int
optcursor = GraphicsF gfx -> Maybe Int
forall a. GraphicsF a -> Maybe Int
getCursorMaybe GraphicsF gfx
params
      font :: FontSpec
font = GraphicsF gfx -> FontSpec
forall xxx. HasFontSpec xxx => xxx -> FontSpec
getFontSpec GraphicsF gfx
params
      bw :: Int
bw = GraphicsF gfx -> Int
forall xxx. HasBorderWidth xxx => xxx -> Int
getBorderWidth GraphicsF gfx
params
      bgcol :: ColorSpec
bgcol = GraphicsF gfx -> ColorSpec
forall xxx. HasBgColorSpec xxx => xxx -> ColorSpec
getBgColorSpec GraphicsF gfx
params
      fgcol :: ColorSpec
fgcol = GraphicsF gfx -> ColorSpec
forall xxx. HasFgColorSpec xxx => xxx -> ColorSpec
getFgColorSpec GraphicsF gfx
params
      optx :: Maybe gfx
optx = GraphicsF gfx -> Maybe gfx
forall (xxx :: * -> *) a. HasInitDisp xxx => xxx a -> Maybe a
getInitDispMaybe GraphicsF gfx
params
      optstretch :: Maybe (Bool, Bool)
optstretch = GraphicsF gfx -> Maybe (Bool, Bool)
forall xxx. HasStretchable xxx => xxx -> Maybe (Bool, Bool)
getStretchableMaybe GraphicsF gfx
params
      optinitsize :: Maybe gfx
optinitsize = GraphicsF gfx -> Maybe gfx
forall (xxx :: * -> *) a. HasInitSize xxx => xxx a -> Maybe a
getInitSizeMaybe GraphicsF gfx
params
      params :: GraphicsF gfx
params = Customiser (GraphicsF gfx)
customiser GraphicsF gfx
forall gfx. GraphicsF gfx
defaults
      defaults :: GraphicsF gfx
defaults = [Pars gfx] -> GraphicsF gfx
forall gfx. [Pars gfx] -> GraphicsF gfx
Pars [Int -> Pars gfx
forall gfx. Int -> Pars gfx
BorderWidth Int
1,
                       ColorSpec -> Pars gfx
forall gfx. ColorSpec -> Pars gfx
BgColorSpec (KeySym -> ColorSpec
forall a. (Show a, ColorGen a) => a -> ColorSpec
colorSpec KeySym
paperColor),
                       ColorSpec -> Pars gfx
forall gfx. ColorSpec -> Pars gfx
FgColorSpec (KeySym -> ColorSpec
forall a. (Show a, ColorGen a) => a -> ColorSpec
colorSpec KeySym
fgColor),
		       Sizing -> Pars gfx
forall gfx. Sizing -> Pars gfx
Sizing Sizing
Dynamic,
		       Bool -> Pars gfx
forall gfx. Bool -> Pars gfx
CursorSolid Bool
False,
		       [GfxEventMask] -> Pars gfx
forall gfx. [GfxEventMask] -> Pars gfx
GfxEventMask [GfxEventMask]
allGfxEvents,
		       Bool -> Pars gfx
forall gfx. Bool -> Pars gfx
AdjustSize Bool
True,
		       Bool -> Pars gfx
forall gfx. Bool -> Pars gfx
DoubleBuffer Bool
defaultdoublebuffer,
		       FontSpec -> Pars gfx
forall gfx. FontSpec -> Pars gfx
FontSpec (KeySym -> FontSpec
forall a. (Show a, FontGen a) => a -> FontSpec
fontSpec KeySym
labelFont)]
      eventmask :: [EventMask]
eventmask = EventMask
ExposureMaskEventMask -> [EventMask] -> [EventMask]
forall a. a -> [a] -> [a]
:
	          [GfxEventMask] -> [EventMask]
gfxEventMask [GfxEventMask]
mask
      --grabmask =  [ButtonReleaseMask, PointerMotionMask]
      -- NOTE: some code below assumes that motion events occur ONLY
      --       while Button1 is pressed!
      startcmds :: [XCommand]
startcmds = [[WindowAttributes] -> XCommand
ChangeWindowAttributes [[EventMask] -> WindowAttributes
CWEventMask [EventMask]
eventmask,
                                           Gravity -> WindowAttributes
CWBitGravity Gravity
NorthWestGravity],
                    [WindowChanges] -> XCommand
ConfigureWindow [Int -> WindowChanges
CWBorderWidth Int
bw]--,
		    --GrabButton False (Button 1) [] grabmask,
		    --GrabButton False (Button 2) [] [ButtonReleaseMask]
		  ]
  in --compMsgSP layoutOptSP (idRightSP idempotSP) `serCompSP`
     SP (Either GfxFEvent GfxFEvent) GfxFEvent
-> SP (Either (Either GfxFEvent GfxFEvent) o) (Either GfxFEvent o)
forall a1 a2 b. SP a1 a2 -> SP (Either a1 b) (Either a2 b)
idRightSP (Either GfxFEvent GfxFEvent -> GfxFEvent
forall p. Either p p -> p
stripEither (Either GfxFEvent GfxFEvent -> GfxFEvent)
-> SP (Either GfxFEvent GfxFEvent) (Either GfxFEvent GfxFEvent)
-> SP (Either GfxFEvent GfxFEvent) GfxFEvent
forall t b a. (t -> b) -> SP a t -> SP a b
`postMapSP` SP GfxFEvent GfxFEvent
-> SP (Either GfxFEvent GfxFEvent) (Either GfxFEvent GfxFEvent)
forall a1 a2 b. SP a1 a2 -> SP (Either a1 b) (Either a2 b)
idRightSP SP GfxFEvent GfxFEvent
forall a. Eq a => SP a a
idempotSP) SP (Either (Either GfxFEvent GfxFEvent) o) (Either GfxFEvent o)
-> F (Either (GfxFCmd gfx) i)
     (Either (Either GfxFEvent GfxFEvent) o)
-> F (Either (GfxFCmd gfx) i) (Either GfxFEvent o)
forall a b e. SP a b -> F e a -> F e b
>^^=<
     [FRequest]
-> K (GfxFCmd gfx) (Either GfxFEvent GfxFEvent)
-> F i o
-> F (Either (GfxFCmd gfx) i)
     (Either (Either GfxFEvent GfxFEvent) o)
forall a b c d.
[FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF ((XCommand -> FRequest) -> [XCommand] -> [FRequest]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XCommand -> FRequest
XCmd [XCommand]
startcmds)
        (Bool
-> FontSpec
-> Maybe Int
-> ColorSpec
-> ColorSpec
-> (Maybe DbeBackBufferId
    -> GCtx
    -> Pixel
    -> GCId
    -> GCId
    -> K (GfxFCmd gfx) (Either GfxFEvent GfxFEvent))
-> K (GfxFCmd gfx) (Either GfxFEvent GfxFEvent)
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 ((Maybe DbeBackBufferId
  -> GCtx
  -> Pixel
  -> GCId
  -> GCId
  -> K (GfxFCmd gfx) (Either GfxFEvent GfxFEvent))
 -> K (GfxFCmd gfx) (Either GfxFEvent GfxFEvent))
-> (Maybe DbeBackBufferId
    -> GCtx
    -> Pixel
    -> GCId
    -> GCId
    -> K (GfxFCmd gfx) (Either GfxFEvent GfxFEvent))
-> K (GfxFCmd gfx) (Either GfxFEvent GfxFEvent)
forall a b. (a -> b) -> a -> b
$
	 Bool
-> Sizing
-> Bool
-> Maybe (Bool, Bool)
-> Maybe gfx
-> Maybe gfx
-> Maybe DbeBackBufferId
-> GCtx
-> Pixel
-> GCId
-> GCId
-> K (GfxFCmd gfx) (Either GfxFEvent GfxFEvent)
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 =
  XRequest
-> (XResponse -> Maybe XResponse) -> Cont (K b c) XResponse
forall a b c. XRequest -> (XResponse -> Maybe a) -> Cont (K b c) a
xrequestK (SwapAction -> XRequest
DbeSwapBuffers SwapAction
swapaction) XResponse -> Maybe XResponse
forall a. a -> Maybe a
Just Cont (K b c) XResponse -> Cont (K b c) XResponse
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 Maybe DbeBackBufferId
forall a. Maybe a
Nothing
optDoubleBufferK Bool
True Maybe DbeBackBufferId -> K b c
cont =
  XRequest
-> (XResponse -> Maybe XResponse) -> Cont (K b c) XResponse
forall a b c. XRequest -> (XResponse -> Maybe a) -> Cont (K b c) a
xrequestK XRequest
DbeQueryExtension XResponse -> Maybe XResponse
forall a. a -> Maybe a
Just Cont (K b c) XResponse -> Cont (K b c) XResponse
forall a b. (a -> b) -> a -> b
$ \ (DbeExtensionQueried Int
status Int
major Int
minor) ->
  let ok :: Bool
ok=Int
statusInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
0
  in if Bool -> Bool
not Bool
ok
     then KeySym -> K b c -> K b c
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
KeySym -> f b ho -> f b ho
echoStderrK KeySym
"Sorry, double buffering not available." (K b c -> K b c) -> K b c -> K b c
forall a b. (a -> b) -> a -> b
$
	  Maybe DbeBackBufferId -> K b c
cont Maybe DbeBackBufferId
forall a. Maybe a
Nothing
     else XRequest
-> (XResponse -> Maybe XResponse) -> Cont (K b c) XResponse
forall a b c. XRequest -> (XResponse -> Maybe a) -> Cont (K b c) a
xrequestK (SwapAction -> XRequest
DbeAllocateBackBufferName SwapAction
swapaction) XResponse -> Maybe XResponse
forall a. a -> Maybe a
Just Cont (K b c) XResponse -> Cont (K b c) XResponse
forall a b. (a -> b) -> a -> b
$ \ (DbeBackBufferNameAllocated DbeBackBufferId
backbuf) ->
          --xcommandK ClearWindow $
          Maybe DbeBackBufferId -> K b c
cont (DbeBackBufferId -> Maybe DbeBackBufferId
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 =
  a -> (Pixel -> K i o) -> K i o
forall a i o.
(Show a, ColorGen a) =>
a -> (Pixel -> K i o) -> K i o
changeGetBackPixel a
bgcol ((Pixel -> K i o) -> K i o) -> (Pixel -> K i o) -> K i o
forall a b. (a -> b) -> a -> b
$ \ Pixel
bg ->
  (K i o -> K i o)
-> (Int -> K i o -> K i o) -> Maybe Int -> K i o -> K i o
forall b a. b -> (a -> b) -> Maybe a -> b
maybe K i o -> K i o
forall a. Customiser a
id Int -> K i o -> K i o
forall a b. Int -> K a b -> K a b
setFontCursor Maybe Int
optcursor (K i o -> K i o) -> K i o -> K i o
forall a b. (a -> b) -> a -> b
$
  [ColorSpec] -> (Pixel -> K i o) -> K i o
forall a (f :: * -> * -> *) i o.
(ColorGen a, FudgetIO f, Show a) =>
a -> (Pixel -> f i o) -> f i o
convColorK [ColorSpec
fgcol,KeySym -> ColorSpec
forall a. (Show a, ColorGen a) => a -> ColorSpec
colorSpec KeySym
"black"] ((Pixel -> K i o) -> K i o) -> (Pixel -> K i o) -> K i o
forall a b. (a -> b) -> a -> b
$ \ Pixel
fg ->
  GCtx -> [GCAttributes Pixel [FontSpec]] -> (GCtx -> K i o) -> K i o
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 [[FontSpec] -> GCAttributes Pixel [FontSpec]
forall a b. b -> GCAttributes a b
GCFont [FontSpec
font,KeySym -> FontSpec
forall a. (Show a, FontGen a) => a -> FontSpec
fontSpec KeySym
"fixed"],Pixel -> GCAttributes Pixel [FontSpec]
forall a b. a -> GCAttributes a b
GCForeground Pixel
fg,Pixel -> GCAttributes Pixel [FontSpec]
forall a b. a -> GCAttributes a b
GCBackground Pixel
bg] ((GCtx -> K i o) -> K i o) -> (GCtx -> K i o) -> K i o
forall a b. (a -> b) -> a -> b
$ \ gctx :: GCtx
gctx@(GC GCId
gc FontData
_) ->
  GCId -> [GCAttributes Pixel FontId] -> (GCId -> K i o) -> K i o
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
wCreateGC GCId
rootGC [Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCForeground Pixel
bg] ((GCId -> K i o) -> K i o) -> (GCId -> K i o) -> K i o
forall a b. (a -> b) -> a -> b
$ \ GCId
cleargc ->
  GCId -> Pixel -> Pixel -> (GCId -> K i o) -> K i o
forall b ho. GCId -> Pixel -> Pixel -> (GCId -> K b ho) -> K b ho
createCursorGC GCId
gc Pixel
bg Pixel
fg ((GCId -> K i o) -> K i o) -> (GCId -> K i o) -> K i o
forall a b. (a -> b) -> a -> b
$ \ GCId
higc ->
  Bool -> (Maybe DbeBackBufferId -> K i o) -> K i o
forall b c. Bool -> (Maybe DbeBackBufferId -> K b c) -> K b c
optDoubleBufferK Bool
doublebuffer ((Maybe DbeBackBufferId -> K i o) -> K i o)
-> (Maybe DbeBackBufferId -> K i o) -> K i o
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 Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
forall a. Maybe a
Nothing
    Just a
gfx ->
      a -> GCtx -> Cont (k i o) MeasuredGraphics
forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK a
gfx GCtx
gctx Cont (k i o) MeasuredGraphics -> Cont (k i o) MeasuredGraphics
forall a b. (a -> b) -> a -> b
$ \ MeasuredGraphics
mg ->
      Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
-> k i o
cont ((MeasuredGraphics, (CompiledGraphics, LayoutRequest))
-> Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
forall a. a -> Maybe a
Just (MeasuredGraphics
mg,(Point -> Point)
-> MeasuredGraphics -> (CompiledGraphics, LayoutRequest)
compileMG Point -> Point
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 =
    K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall path.
K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
graphicsK1 
  where
    graphicsK1 :: K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
graphicsK1 =
      GCtx
-> Maybe a
-> (Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
    -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
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 ((Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
  -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> (Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
    -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. (a -> b) -> a -> b
$ \ Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
optcgsize ->
      GCtx
-> Maybe a
-> (Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
    -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
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 ((Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
  -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> (Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
    -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. (a -> b) -> a -> b
$ \ Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
optcgx ->
      Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
-> Maybe (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
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 =
        (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
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    = ((a, (a, LayoutRequest)) -> Spacer)
-> Maybe (a, (a, LayoutRequest)) -> Maybe Spacer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Point -> Spacer
minSizeS (Point -> Spacer)
-> ((a, (a, LayoutRequest)) -> Point)
-> (a, (a, LayoutRequest))
-> Spacer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutRequest -> Point
minsize (LayoutRequest -> Point)
-> ((a, (a, LayoutRequest)) -> LayoutRequest)
-> (a, (a, LayoutRequest))
-> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, LayoutRequest) -> LayoutRequest
forall a b. (a, b) -> b
snd ((a, LayoutRequest) -> LayoutRequest)
-> ((a, (a, LayoutRequest)) -> (a, LayoutRequest))
-> (a, (a, LayoutRequest))
-> LayoutRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, (a, LayoutRequest)) -> (a, LayoutRequest)
forall a b. (a, b) -> b
snd) Maybe (a, (a, LayoutRequest))
optcgsize
        optStretchS :: Maybe Spacer
optStretchS = ((Bool, Bool) -> Spacer) -> Maybe (Bool, Bool) -> Maybe Spacer
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 stretchS,Just sizeS) -> Spacer -> MeasuredGraphics -> MeasuredGraphics
SpacedM (Spacer
stretchS Spacer -> Spacer -> Spacer
`compS` Spacer
sizeS)
	    (Just stretchS,Maybe Spacer
_         ) -> Spacer -> MeasuredGraphics -> MeasuredGraphics
SpacedM Spacer
stretchS
	    (Maybe Spacer
_            ,Just sizeS) -> Spacer -> MeasuredGraphics -> MeasuredGraphics
SpacedM Spacer
sizeS
	    (Maybe Spacer, Maybe Spacer)
_                          -> GCtx -> MeasuredGraphics -> MeasuredGraphics
MarkM GCtx
gctx

        -- All incoming and outgoing paths have to be adjusted because of
	-- the extra spacer. The functions pathIn & pathOut handle this.
	init :: (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
init = (MeasuredGraphics -> (CompiledGraphics, LayoutRequest))
-> MeasuredGraphics
-> (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
forall t b. (t -> b) -> t -> (t, b)
pairwith ((Point -> Point)
-> MeasuredGraphics -> (CompiledGraphics, LayoutRequest)
compileMG Point -> Point
forall a. Customiser a
id) (MeasuredGraphics
 -> (MeasuredGraphics, (CompiledGraphics, LayoutRequest)))
-> MeasuredGraphics
-> (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
forall a b. (a -> b) -> a -> b
$ MeasuredGraphics -> MeasuredGraphics
spacerM (MeasuredGraphics -> MeasuredGraphics)
-> MeasuredGraphics -> MeasuredGraphics
forall a b. (a -> b) -> a -> b
$ MeasuredGraphics
-> ((MeasuredGraphics, b) -> MeasuredGraphics)
-> Maybe (MeasuredGraphics, b)
-> MeasuredGraphics
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Point -> MeasuredGraphics
emptyMG Point
10) (MeasuredGraphics, b) -> MeasuredGraphics
forall a b. (a, b) -> a
fst Maybe (MeasuredGraphics, b)
optcgx
         -- Stretchiness is applied to all drawings as it should be, but
	 -- optinitsize should be applied only to the first drawing!!!
    
    pathIn :: [a] -> [a]
pathIn [a]
path = a
0a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
path
    -- pathOut (0:path) = path

    -- locatePointOut p = mapFst pathOut . locatePoint p
    locatePointOut :: Point -> CompiledGraphics -> [([Int], (Point, Rect))]
locatePointOut Point
p (CGMark CompiledGraphics
cg) = Point -> CompiledGraphics -> [([Int], (Point, Rect))]
locatePoint Point
p CompiledGraphics
cg
    -- bug if top node isn't a CGMark !!

    graphicsK :: (MeasuredGraphics, (CompiledGraphics, LayoutRequest))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
graphicsK (MeasuredGraphics
mg,(CompiledGraphics
cg,LayoutRequest
req)) =
      LayoutRequest
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall hi ho. LayoutRequest -> K hi ho -> K hi ho
putLayoutReq LayoutRequest
req (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. (a -> b) -> a -> b
$
      GCId
-> LayoutRequest
-> MeasuredGraphics
-> CompiledGraphics
-> Bool
-> [Rect]
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
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 =
        Point
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
seq Point
size (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. (a -> b) -> a -> b
$ -- prevents a space leak when sizing==Dynamic, TH 980724
	Cont
  (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
  (KEvent (GfxCommand [Int] a))
forall hi ho. Cont (K hi ho) (KEvent hi)
getK Cont
  (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
  (KEvent (GfxCommand [Int] a))
-> Cont
     (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
     (KEvent (GfxCommand [Int] a))
forall a b. (a -> b) -> a -> b
$ (FResponse
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> (GfxCommand [Int] a
    -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> KEvent (GfxCommand [Int] a)
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall t1 p t2. (t1 -> p) -> (t2 -> p) -> Message t1 t2 -> p
message FResponse
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
lowK GfxCommand [Int] a
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
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 -- == current window size most of the time
	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 -> a -> GCtx -> Cont (k i o) MeasuredGraphics
forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK a
new GCtx
gctx Cont (k i o) MeasuredGraphics -> Cont (k i o) MeasuredGraphics
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' (LayoutRequest -> Maybe LayoutRequest
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)
		 	     -> --ctrace "updgfx" (show (req,req')) $
				LayoutRequest -> K hi ho -> K hi ho
forall hi ho. LayoutRequest -> K hi ho -> K hi ho
putLayoutReq LayoutRequest
req' (K hi ho -> K hi ho) -> K hi ho -> K hi ho
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 -> (Bool, Maybe a) -> K hi ho
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) =
              MeasuredGraphics
-> CompiledGraphics
-> GCtx
-> [Int]
-> Maybe LayoutRequest
-> Maybe a
-> (MeasuredGraphics
    -> CompiledGraphics -> Maybe LayoutRequest -> K hi ho)
-> K hi ho
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 ((MeasuredGraphics
  -> CompiledGraphics -> Maybe LayoutRequest -> K hi ho)
 -> K hi ho)
-> (MeasuredGraphics
    -> CompiledGraphics -> Maybe LayoutRequest -> K hi ho)
-> K hi ho
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 = (Bool
 -> (GCId, Rect -> [Rect])
 -> CompiledGraphics
 -> CompiledGraphics
 -> [[Int]]
 -> K hi ho
 -> K hi ho)
-> (DbeBackBufferId
    -> Bool
    -> (GCId, Rect -> [Rect])
    -> CompiledGraphics
    -> CompiledGraphics
    -> [[Int]]
    -> K hi ho
    -> K hi ho)
-> Maybe DbeBackBufferId
-> Bool
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> K hi ho
-> K hi ho
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> K hi ho
-> K hi ho
forall (f :: * -> * -> *) hi ho.
FudgetIO f =>
Bool
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> f hi ho
-> f hi ho
drawChangesK DbeBackBufferId
-> Bool
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> K hi ho
-> K hi ho
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 = ((GCId, Rect -> [t])
 -> (t -> [Rect]) -> CompiledGraphics -> K hi ho -> K hi ho)
-> (DbeBackBufferId
    -> (GCId, Rect -> [t])
    -> (t -> [Rect])
    -> CompiledGraphics
    -> K hi ho
    -> K hi ho)
-> Maybe DbeBackBufferId
-> (GCId, Rect -> [t])
-> (t -> [Rect])
-> CompiledGraphics
-> K hi ho
-> K hi ho
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (GCId, Rect -> [t])
-> (t -> [Rect]) -> CompiledGraphics -> K hi ho -> K hi ho
forall (f :: * -> * -> *) t hi ho.
FudgetIO f =>
(GCId, Rect -> [t])
-> (t -> [Rect]) -> CompiledGraphics -> f hi ho -> f hi ho
drawK DbeBackBufferId
-> (GCId, Rect -> [t])
-> (t -> [Rect])
-> CompiledGraphics
-> K hi ho
-> K hi ho
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 =
            Maybe (Drawable, GCId)
-> Bool
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> K hi ho
-> K hi ho
forall (f :: * -> * -> *) hi ho.
FudgetIO f =>
Maybe (Drawable, GCId)
-> Bool
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> f hi ho
-> f hi ho
drawChangesK' ((Drawable, GCId) -> Maybe (Drawable, GCId)
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 (K hi ho -> K hi ho) -> K hi ho -> K hi ho
forall a b. (a -> b) -> a -> b
$
	    K hi ho -> K hi ho
forall b c. K b c -> K b c
dbeSwapBuffers (K hi ho -> K hi ho) -> K hi ho -> K hi ho
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 =
            Drawable
-> (GCId, Rect -> [t])
-> (t -> [Rect])
-> CompiledGraphics
-> K hi ho
-> K hi ho
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 (K hi ho -> K hi ho) -> K hi ho -> K hi ho
forall a b. (a -> b) -> a -> b
$
	    K hi ho -> K hi ho
forall b c. K b c -> K b c
dbeSwapBuffers (K hi ho -> K hi ho) -> K hi ho -> K hi ho
forall a b. (a -> b) -> a -> b
$
	    --putLow (wCopyArea gc (DbeBackBuffer backbuf) (Rect 0 size) 0) $
	    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 =
	  -- High level output tagged Left is sent through idempotSP
	  Either GfxFEvent (GfxEvent path)
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall (f :: * -> * -> *) ho hi.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh (GfxFEvent -> Either GfxFEvent (GfxEvent path)
forall a b. a -> Either a b
Left (GfxFEvent -> Either GfxFEvent (GfxEvent path))
-> GfxFEvent -> Either GfxFEvent (GfxEvent path)
forall a b. (a -> b) -> a -> b
$
	           Int
-> ModState
-> Pressed
-> Button
-> [([Int], (Point, Rect))]
-> GfxFEvent
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)) (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
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 =
	  -- High level output tagged Left is sent through idempotSP
	  Either GfxFEvent (GfxEvent path)
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall (f :: * -> * -> *) ho hi.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh (GfxFEvent -> Either GfxFEvent (GfxEvent path)
forall a b. a -> Either a b
Left (GfxFEvent -> Either GfxFEvent (GfxEvent path))
-> GfxFEvent -> Either GfxFEvent (GfxEvent path)
forall a b. (a -> b) -> a -> b
$ Int -> ModState -> [([Int], (Point, Rect))] -> GfxFEvent
forall path.
Int -> ModState -> [(path, (Point, Rect))] -> GfxEvent path
GfxMotionEvent Int
t ModState
state (Point -> CompiledGraphics -> [([Int], (Point, Rect))]
locatePointOut Point
p CompiledGraphics
cg)) (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
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 =
	  Either GfxFEvent (GfxEvent path)
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall (f :: * -> * -> *) ho hi.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh (GfxEvent path -> Either GfxFEvent (GfxEvent path)
forall a b. b -> Either a b
Right (GfxEvent path -> Either GfxFEvent (GfxEvent path))
-> GfxEvent path -> Either GfxFEvent (GfxEvent path)
forall a b. (a -> b) -> a -> b
$ Int -> ModState -> KeySym -> KeySym -> GfxEvent path
forall path. Int -> ModState -> KeySym -> KeySym -> GfxEvent path
GfxKeyEvent Int
t ModState
mods KeySym
sym KeySym
lookup) (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
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) = CompiledGraphics
-> [Int]
-> (Maybe Alignment, Maybe Alignment)
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall hi ho.
CompiledGraphics
-> [Int]
-> (Maybe Alignment, Maybe Alignment)
-> K hi ho
-> K hi ho
mkPathVisible CompiledGraphics
cg ([Int] -> [Int]
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) = XCommand
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
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) =
	  Either GfxFEvent (GfxEvent path)
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall (f :: * -> * -> *) ho hi.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh (GfxEvent path -> Either GfxFEvent (GfxEvent path)
forall a b. b -> Either a b
Right (GfxEvent path -> Either GfxFEvent (GfxEvent path))
-> GfxEvent path -> Either GfxFEvent (GfxEvent path)
forall a b. (a -> b) -> a -> b
$ [Rect] -> GfxEvent path
forall path. [Rect] -> GfxEvent path
GfxPlaces ([Rect] -> GfxEvent path) -> [Rect] -> GfxEvent path
forall a b. (a -> b) -> a -> b
$ ([Int] -> Rect) -> [[Int]] -> [Rect]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CompiledGraphics -> Rect
cgrect (CompiledGraphics -> Rect)
-> ([Int] -> CompiledGraphics) -> [Int] -> Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompiledGraphics -> [Int] -> CompiledGraphics
cgpart CompiledGraphics
cg ([Int] -> CompiledGraphics)
-> ([Int] -> [Int]) -> [Int] -> CompiledGraphics
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Num a => [a] -> [a]
pathIn) [[Int]]
paths) (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. (a -> b) -> a -> b
$
	  K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
same
	highK (ChangeGfxBg ColorSpec
bgspec) =
	  ColorSpec
-> (Pixel
    -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a (f :: * -> * -> *) i o.
(ColorGen a, FudgetIO f, Show a) =>
a -> (Pixel -> f i o) -> f i o
convColorK ColorSpec
bgspec ((Pixel
  -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> (Pixel
    -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. (a -> b) -> a -> b
$ \ Pixel
bgcol ->
	  XCommand
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall i o. XCommand -> K i o -> K i o
xcommandK ([WindowAttributes] -> XCommand
ChangeWindowAttributes [Pixel -> WindowAttributes
CWBackPixel Pixel
bgcol]) (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. (a -> b) -> a -> b
$
	  XCommand
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall i o. XCommand -> K i o -> K i o
xcommandK XCommand
clearWindowExpose (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. (a -> b) -> a -> b
$
	  GCId
-> [GCAttributes Pixel FontId]
-> (GCId
    -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
wCreateGC GCId
rootGC [Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCForeground Pixel
bgcol] ((GCId
  -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> (GCId
    -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. (a -> b) -> a -> b
$ \ GCId
cleargc' ->
	  -- FreeGC cleargc
	  GCId -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
newcleargc GCId
cleargc'
	highK (ChangeGfxBgPixmap PixmapId
pixmap Bool
freeIt) =
	  XCommand
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall i o. XCommand -> K i o -> K i o
xcommandK ([WindowAttributes] -> XCommand
ChangeWindowAttributes [PixmapId -> WindowAttributes
CWBackPixmap PixmapId
pixmap]) (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. (a -> b) -> a -> b
$
	  XCommand
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall i o. XCommand -> K i o -> K i o
xcommandK XCommand
clearWindowExpose (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. (a -> b) -> a -> b
$
	  GCId
-> [GCAttributes Pixel FontId]
-> (GCId
    -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
wCreateGC GCId
rootGC [GCFillStyle -> GCAttributes Pixel FontId
forall a b. GCFillStyle -> GCAttributes a b
GCFillStyle GCFillStyle
FillTiled,PixmapId -> GCAttributes Pixel FontId
forall a b. PixmapId -> GCAttributes a b
GCTile PixmapId
pixmap] ((GCId
  -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> (GCId
    -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. (a -> b) -> a -> b
$ \ GCId
cleargc' ->
	  -- FreeGC cleargc
	  (if Bool
freeIt then XCommand
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall i o. XCommand -> K i o -> K i o
xcommandK (PixmapId -> XCommand
FreePixmap PixmapId
pixmap) else K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a. Customiser a
id) (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
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) =
	  bg
-> GCtx
-> (PixmapImage
    -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> (PixmapImage -> k i o) -> k i o
graphic2PixmapImage bg
gfx GCtx
gctx ((PixmapImage
  -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> (PixmapImage
    -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. (a -> b) -> a -> b
$ \ (PixmapImage Point
size PixmapId
pm) ->
	  GfxCommand [Int] a
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
highK (PixmapId -> Bool -> GfxCommand [Int] a
forall path gfx. PixmapId -> Bool -> GfxCommand path gfx
ChangeGfxBgPixmap PixmapId
pm Bool
True)
#endif
        highK (ChangeGfxCursor CursorId
cursor) =
          CursorId
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall i o. CursorId -> K i o -> K i o
defineCursor CursorId
cursor (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. (a -> b) -> a -> b
$
          XCommand
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall i o. XCommand -> K i o -> K i o
xcommandK XCommand
Flush (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. (a -> b) -> a -> b
$
	  K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
same
        highK (ChangeGfxFontCursor Int
shape) =
          Int
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. Int -> K a b -> K a b
setFontCursor Int
shape (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. (a -> b) -> a -> b
$
          XCommand
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall i o. XCommand -> K i o -> K i o
xcommandK XCommand
Flush (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. (a -> b) -> a -> b
$
	  K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
same
	highK (ChangeGfx [([Int], GfxChange a)]
changes0) =
	    MeasuredGraphics
-> CompiledGraphics
-> Maybe LayoutRequest
-> [([Int], GfxChange a)]
-> (LayoutRequest
    -> MeasuredGraphics
    -> CompiledGraphics
    -> Bool
    -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
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 Maybe LayoutRequest
forall a. Maybe a
Nothing [([Int], GfxChange a)]
changes ((LayoutRequest
  -> MeasuredGraphics
  -> CompiledGraphics
  -> Bool
  -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> (LayoutRequest
    -> MeasuredGraphics
    -> CompiledGraphics
    -> Bool
    -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. (a -> b) -> a -> b
$ \ LayoutRequest
req' MeasuredGraphics
mg' CompiledGraphics
cg' Bool
beQuick ->
	    Bool
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
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 ((([Int], GfxChange a) -> [Int])
-> [([Int], GfxChange a)] -> [[Int]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Int], GfxChange a) -> [Int]
forall a b. (a, b) -> a
fst [([Int], GfxChange a)]
changes) (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. (a -> b) -> a -> b
$
	    --mkChangeVisible cg' changes $
	    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 = ([Int] -> [Int])
-> [([Int], GfxChange a)] -> [([Int], GfxChange a)]
forall t a b. (t -> a) -> [(t, b)] -> [(a, b)]
mapFst [Int] -> [Int]
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'Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
==Bool
active
	  then K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
same
	  else Either GfxFEvent (GfxEvent path)
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall (f :: * -> * -> *) ho hi.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh (GfxFEvent -> Either GfxFEvent (GfxEvent path)
forall a b. a -> Either a b
Left (GfxFEvent -> Either GfxFEvent (GfxEvent path))
-> GfxFEvent -> Either GfxFEvent (GfxEvent path)
forall a b. (a -> b) -> a -> b
$ GfxFocusEvent :: forall path. Bool -> GfxEvent path
GfxFocusEvent { gfxHasFocus :: Bool
gfxHasFocus=Bool
active' }) (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. (a -> b) -> a -> b
$
	       Bool
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
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) (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
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' Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
size then K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
same
		    else let cg'' :: CompiledGraphics
cg'' = ([Int] -> CompiledGraphics -> CompiledGraphics)
-> CompiledGraphics -> [[Int]] -> CompiledGraphics
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 (Point -> Point -> Point
forall a b. a -> b -> a
const Point
size') MeasuredGraphics
mg
			 in Either GfxFEvent (GfxEvent path)
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall (f :: * -> * -> *) ho hi.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh (GfxFEvent -> Either GfxFEvent (GfxEvent path)
forall a b. a -> Either a b
Left (GfxFEvent -> Either GfxFEvent (GfxEvent path))
-> GfxFEvent -> Either GfxFEvent (GfxEvent path)
forall a b. (a -> b) -> a -> b
$ Point -> GfxFEvent
forall path. Point -> GfxEvent path
GfxResized Point
size') (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
forall a b. (a -> b) -> a -> b
$
			    Bool
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
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 [] (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
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 (Point -> Point -> Point
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
rRect -> [Rect] -> [Rect]
forall a. a -> [a] -> [a]
:[Rect]
es
	      in (GCId, Rect -> [Rect])
-> (Rect -> [Rect])
-> CompiledGraphics
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
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) ([Rect] -> CompiledGraphics -> CompiledGraphics
forall (t :: * -> *).
Foldable t =>
t Rect -> CompiledGraphics -> CompiledGraphics
prune [Rect]
rs CompiledGraphics
cg) (K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
 -> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path)))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
-> K (GfxCommand [Int] a) (Either GfxFEvent (GfxEvent path))
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
rRect -> [Rect] -> [Rect]
forall 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 (Rect -> Bool) -> t Rect -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Rect -> Rect -> Bool
overlaps Rect
r) t Rect
rs
  then if [(GCId, [DrawCommand])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(GCId, [DrawCommand])]
cmds --  || all (null.snd) cmds
       then Rect
-> Bool
-> [(GCId, [DrawCommand])]
-> [CompiledGraphics]
-> CompiledGraphics
CGraphics Rect
r Bool
cur [(GCId, [DrawCommand])]
cmds ((CompiledGraphics -> CompiledGraphics)
-> [CompiledGraphics] -> [CompiledGraphics]
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
             -- cmds may overlap with cgs, so
	     -- if cmds are redrawn then all cgs should be redrawn too.
  else Rect
-> Bool
-> [(GCId, [DrawCommand])]
-> [CompiledGraphics]
-> CompiledGraphics
CGraphics Rect
r Bool
cur [] [] -- subtree rectangles are inside parent rectangles.

{-
locatePoint' p cg = fmap addrect $ locatePoint p cg
  where
    addrect = pairwith (cgrect . cgpart cg)
-}

locatePoint :: Point -> CompiledGraphics -> [([Int], (Point, Rect))]
locatePoint Point
p (CGMark CompiledGraphics
cg) = [(Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
path,(Point, Rect)
geom)|([Int]
path,(Point, Rect)
geom)<-Point -> CompiledGraphics -> [([Int], (Point, Rect))]
locatePoint Point
p CompiledGraphics
cg]
 --  ^^ the wrong geometry will be return if CGMark came from a SpacerM !!
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 = (CompiledGraphics -> [([Int], (Point, Rect))])
-> [CompiledGraphics] -> [[([Int], (Point, Rect))]]
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
iInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
path,(Point, Rect)
pr) | (Int
i,[([Int], (Point, Rect))]
paths)<-Int
-> [[([Int], (Point, Rect))]] -> [(Int, [([Int], (Point, Rect))])]
forall a. Int -> [a] -> [(Int, a)]
number Int
1 [[([Int], (Point, Rect))]]
ps, ([Int]
path,(Point, Rect)
pr)<-[([Int], (Point, Rect))]
paths] of
            [] -> [([],(Point
pPoint -> Point -> Point
forall 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) = ([Int] -> [Int]) -> [[Int]] -> [[Int]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) (CompiledGraphics -> [[Int]]
cursorPaths CompiledGraphics
cg)
cursorPaths (CGraphics Rect
_ Bool
cur [(GCId, [DrawCommand])]
_ [CompiledGraphics]
gs) =
  if Bool
cur
  then [[]]
  else [Int
iInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
p | (Int
i,CompiledGraphics
g)<-Int -> [CompiledGraphics] -> [(Int, CompiledGraphics)]
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 = Rect -> [Rect]
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
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
lw) Int
w Int
lw,Int -> Int -> Int -> Int -> Rect
rR (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
lw) Int
y Int
lw Int
h]
 where lw :: Int
lw=[Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Int
2,Int
w,Int
h]

--putSize cg = putLayoutReq (Layout (cgsize cg) False False)

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]]
_ -> CompiledGraphics
-> [Int]
-> (Maybe Alignment, Maybe Alignment)
-> K hi ho
-> K hi ho
forall hi ho.
CompiledGraphics
-> [Int]
-> (Maybe Alignment, Maybe Alignment)
-> K hi ho
-> K hi ho
mkPathVisible CompiledGraphics
cg [Int]
path (Maybe Alignment
forall a. Maybe a
Nothing,Maybe Alignment
forall a. Maybe a
Nothing)
    [[Int]]
_ -> K hi ho -> K hi ho
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 =
    LayoutMessage -> K hi ho -> K hi ho
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
			 -- growrect compensates for a layout bug !!

putLayoutReq :: LayoutRequest -> K hi ho -> K hi ho
putLayoutReq = LayoutMessage -> K hi ho -> K hi ho
forall hi ho. LayoutMessage -> K hi ho -> K hi ho
putLayout (LayoutMessage -> K hi ho -> K hi ho)
-> (LayoutRequest -> LayoutMessage)
-> LayoutRequest
-> K hi ho
-> K hi ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutRequest -> LayoutMessage
LayoutRequest
--putSpacer = putLayout . LayoutSpacer
putLayout :: LayoutMessage -> K hi ho -> K hi ho
putLayout = KCommand ho -> K hi ho -> K hi ho
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK (KCommand ho -> K hi ho -> K hi ho)
-> (LayoutMessage -> KCommand ho)
-> LayoutMessage
-> K hi ho
-> K hi ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FRequest -> KCommand ho
forall a b. a -> Message a b
Low (FRequest -> KCommand ho)
-> (LayoutMessage -> FRequest) -> LayoutMessage -> KCommand ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutMessage -> FRequest
LCmd

createCursorGC :: GCId -> Pixel -> Pixel -> (GCId -> K b ho) -> K b ho
createCursorGC GCId
gc Pixel
bg Pixel
fg GCId -> K b ho
cont =
  --allocNamedColorDefPixel defaultColormap cursorcolor "white" $ \ hipix ->
  [KeySym] -> Cont (K b ho) (Maybe Pixel)
forall a (f :: * -> * -> *) i o.
(ColorGen a, FudgetIO f) =>
a -> Cont (f i o) (Maybe Pixel)
tryConvColorK [KeySym]
cursorcolor Cont (K b ho) (Maybe Pixel) -> Cont (K b ho) (Maybe Pixel)
forall a b. (a -> b) -> a -> b
$ \ Maybe Pixel
opthipix ->
  let hipix :: Pixel
hipix = Pixel -> Maybe Pixel -> Pixel
forall a. a -> Maybe a -> a
fromMaybe Pixel
fg Maybe Pixel
opthipix
  in if Pixel
hipixPixel -> Pixel -> Bool
forall a. Eq a => a -> a -> Bool
/=Pixel
bg Bool -> Bool -> Bool
&& Pixel
hipixPixel -> Pixel -> Bool
forall a. Eq a => a -> a -> Bool
/=Pixel
fg Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
mono
     then GCId -> [GCAttributes Pixel FontId] -> (GCId -> K b ho) -> K b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
wCreateGC GCId
gc [Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCForeground Pixel
hipix] ((GCId -> K b ho) -> K b ho) -> (GCId -> K b ho) -> K b ho
forall a b. (a -> b) -> a -> b
$ \ GCId
cursorgc ->
	  GCId -> K b ho
cont GCId
cursorgc
     else Point -> Int -> (PixmapId -> K b ho) -> K b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
Point -> Int -> (PixmapId -> f b ho) -> f b ho
createPixmap (Int -> Int -> Point
Point Int
2 Int
2) Int
copyFromParent ((PixmapId -> K b ho) -> K b ho) -> (PixmapId -> K b ho) -> K b ho
forall a b. (a -> b) -> a -> b
$ \ PixmapId
pm ->
	  GCId -> [GCAttributes Pixel FontId] -> (GCId -> K b ho) -> K b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
wCreateGC GCId
gc [Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCForeground Pixel
bg] ((GCId -> K b ho) -> K b ho) -> (GCId -> K b ho) -> K b ho
forall a b. (a -> b) -> a -> b
$ \ GCId
cleargc ->
	  [KCommand ho] -> K b ho -> K b ho
forall b a. [KCommand b] -> K a b -> K a b
putsK [FRequest -> KCommand ho
forall a b. a -> Message a b
Low (FRequest -> KCommand ho) -> FRequest -> KCommand ho
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),
		 FRequest -> KCommand ho
forall a b. a -> Message a b
Low (FRequest -> KCommand ho) -> FRequest -> KCommand ho
forall a b. (a -> b) -> a -> b
$ PixmapId -> GCId -> Point -> FRequest
pmDrawPoint PixmapId
pm GCId
gc Point
0] (K b ho -> K b ho) -> K b ho -> K b ho
forall a b. (a -> b) -> a -> b
$
	  GCId -> [GCAttributes Pixel FontId] -> (GCId -> K b ho) -> K b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
wCreateGC GCId
gc [GCFillStyle -> GCAttributes Pixel FontId
forall a b. GCFillStyle -> GCAttributes a b
GCFillStyle GCFillStyle
FillTiled,PixmapId -> GCAttributes Pixel FontId
forall a b. PixmapId -> GCAttributes a b
GCTile PixmapId
pm] ((GCId -> K b ho) -> K b ho) -> (GCId -> K b ho) -> K b ho
forall a b. (a -> b) -> a -> b
$ \ GCId
cursorgc ->
	  GCId -> K b ho
cont GCId
cursorgc

similar :: LayoutRequest -> LayoutRequest -> Bool
similar LayoutRequest
l1 LayoutRequest
l2 =
  LayoutRequest -> Point
minsize LayoutRequest
l1Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
==LayoutRequest -> Point
minsize LayoutRequest
l2 Bool -> Bool -> Bool
&&
  LayoutRequest -> Bool
fixedh LayoutRequest
l1Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
==LayoutRequest -> Bool
fixedh LayoutRequest
l2 Bool -> Bool -> Bool
&&
  LayoutRequest -> Bool
fixedv LayoutRequest
l1Bool -> Bool -> Bool
forall 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 = KeySym -> SwapAction -> SwapAction
forall p. (Read p, Show p) => KeySym -> p -> p
argReadKey KeySym
"swapaction" SwapAction
DbeCopied