{-# 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 = 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)
      -- _ -> cmd -- Operationally, the rest is the same as this line.
      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

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

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] -- response to GetGfxPlaces
  | 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)


--  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 = 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 :: 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 -- :: (SP anything (GfxCommand MeasuredGraphics))
	-- this is a workaround necessary to resolve the overloading

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 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' :: 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
      --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`
     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) ->
          --xcommandK ClearWindow $
          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

        -- 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 = 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
         -- 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
0forall 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)) =
      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
$ -- prevents a space leak when sizing==Dynamic, TH 980724
	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 -- == 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 -> 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)
		 	     -> --ctrace "updgfx" (show (req,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
$
	    --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
	  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 =
	  -- High level output tagged Left is sent through idempotSP
	  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' ->
	  -- FreeGC 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' ->
	  -- FreeGC 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
$
	    --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 = 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 --  || all (null.snd) 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
             -- 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
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]
 --  ^^ 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 = 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]

--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]]
_ -> 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
			 -- growrect compensates for a layout bug !!

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
--putSpacer = putLayout . LayoutSpacer
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 =
  --allocNamedColorDefPixel defaultColormap cursorcolor "white" $ \ hipix ->
  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