module Event(module Event,FontStructList,FontStruct) where
import Font(FontStruct,FontStructList,CharStruct)
import Visual(Visual)
import Geometry
import Xtypes
--import DialogueIO hiding (IOError)

newtype KeyCode = KeyCode Int deriving (KeyCode -> KeyCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyCode -> KeyCode -> Bool
$c/= :: KeyCode -> KeyCode -> Bool
== :: KeyCode -> KeyCode -> Bool
$c== :: KeyCode -> KeyCode -> Bool
Eq, Eq KeyCode
KeyCode -> KeyCode -> Bool
KeyCode -> KeyCode -> Ordering
KeyCode -> KeyCode -> KeyCode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: KeyCode -> KeyCode -> KeyCode
$cmin :: KeyCode -> KeyCode -> KeyCode
max :: KeyCode -> KeyCode -> KeyCode
$cmax :: KeyCode -> KeyCode -> KeyCode
>= :: KeyCode -> KeyCode -> Bool
$c>= :: KeyCode -> KeyCode -> Bool
> :: KeyCode -> KeyCode -> Bool
$c> :: KeyCode -> KeyCode -> Bool
<= :: KeyCode -> KeyCode -> Bool
$c<= :: KeyCode -> KeyCode -> Bool
< :: KeyCode -> KeyCode -> Bool
$c< :: KeyCode -> KeyCode -> Bool
compare :: KeyCode -> KeyCode -> Ordering
$ccompare :: KeyCode -> KeyCode -> Ordering
Ord, Int -> KeyCode -> ShowS
[KeyCode] -> ShowS
KeyCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyCode] -> ShowS
$cshowList :: [KeyCode] -> ShowS
show :: KeyCode -> String
$cshow :: KeyCode -> String
showsPrec :: Int -> KeyCode -> ShowS
$cshowsPrec :: Int -> KeyCode -> ShowS
Show, ReadPrec [KeyCode]
ReadPrec KeyCode
Int -> ReadS KeyCode
ReadS [KeyCode]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [KeyCode]
$creadListPrec :: ReadPrec [KeyCode]
readPrec :: ReadPrec KeyCode
$creadPrec :: ReadPrec KeyCode
readList :: ReadS [KeyCode]
$creadList :: ReadS [KeyCode]
readsPrec :: Int -> ReadS KeyCode
$creadsPrec :: Int -> ReadS KeyCode
Read)

data Pressed = Pressed | Released | MultiClick Int
               deriving (Pressed -> Pressed -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pressed -> Pressed -> Bool
$c/= :: Pressed -> Pressed -> Bool
== :: Pressed -> Pressed -> Bool
$c== :: Pressed -> Pressed -> Bool
Eq, Eq Pressed
Pressed -> Pressed -> Bool
Pressed -> Pressed -> Ordering
Pressed -> Pressed -> Pressed
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Pressed -> Pressed -> Pressed
$cmin :: Pressed -> Pressed -> Pressed
max :: Pressed -> Pressed -> Pressed
$cmax :: Pressed -> Pressed -> Pressed
>= :: Pressed -> Pressed -> Bool
$c>= :: Pressed -> Pressed -> Bool
> :: Pressed -> Pressed -> Bool
$c> :: Pressed -> Pressed -> Bool
<= :: Pressed -> Pressed -> Bool
$c<= :: Pressed -> Pressed -> Bool
< :: Pressed -> Pressed -> Bool
$c< :: Pressed -> Pressed -> Bool
compare :: Pressed -> Pressed -> Ordering
$ccompare :: Pressed -> Pressed -> Ordering
Ord, Int -> Pressed -> ShowS
[Pressed] -> ShowS
Pressed -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pressed] -> ShowS
$cshowList :: [Pressed] -> ShowS
show :: Pressed -> String
$cshow :: Pressed -> String
showsPrec :: Int -> Pressed -> ShowS
$cshowsPrec :: Int -> Pressed -> ShowS
Show, ReadPrec [Pressed]
ReadPrec Pressed
Int -> ReadS Pressed
ReadS [Pressed]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Pressed]
$creadListPrec :: ReadPrec [Pressed]
readPrec :: ReadPrec Pressed
$creadPrec :: ReadPrec Pressed
readList :: ReadS [Pressed]
$creadList :: ReadS [Pressed]
readsPrec :: Int -> ReadS Pressed
$creadsPrec :: Int -> ReadS Pressed
Read)

data Detail = NotifyAncestor |
              NotifyVirtual |
              NotifyInferior |
              NotifyNonlinear |
              NotifyNonlinearVirtual |
              NotifyPointer |
              NotifyPointerRoot |
              NotifyDetailNothing 
              deriving (Detail -> Detail -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Detail -> Detail -> Bool
$c/= :: Detail -> Detail -> Bool
== :: Detail -> Detail -> Bool
$c== :: Detail -> Detail -> Bool
Eq, Eq Detail
Detail -> Detail -> Bool
Detail -> Detail -> Ordering
Detail -> Detail -> Detail
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Detail -> Detail -> Detail
$cmin :: Detail -> Detail -> Detail
max :: Detail -> Detail -> Detail
$cmax :: Detail -> Detail -> Detail
>= :: Detail -> Detail -> Bool
$c>= :: Detail -> Detail -> Bool
> :: Detail -> Detail -> Bool
$c> :: Detail -> Detail -> Bool
<= :: Detail -> Detail -> Bool
$c<= :: Detail -> Detail -> Bool
< :: Detail -> Detail -> Bool
$c< :: Detail -> Detail -> Bool
compare :: Detail -> Detail -> Ordering
$ccompare :: Detail -> Detail -> Ordering
Ord, Int -> Detail -> ShowS
[Detail] -> ShowS
Detail -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Detail] -> ShowS
$cshowList :: [Detail] -> ShowS
show :: Detail -> String
$cshow :: Detail -> String
showsPrec :: Int -> Detail -> ShowS
$cshowsPrec :: Int -> Detail -> ShowS
Show, ReadPrec [Detail]
ReadPrec Detail
Int -> ReadS Detail
ReadS [Detail]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Detail]
$creadListPrec :: ReadPrec [Detail]
readPrec :: ReadPrec Detail
$creadPrec :: ReadPrec Detail
readList :: ReadS [Detail]
$creadList :: ReadS [Detail]
readsPrec :: Int -> ReadS Detail
$creadsPrec :: Int -> ReadS Detail
Read, Detail
forall a. a -> a -> Bounded a
maxBound :: Detail
$cmaxBound :: Detail
minBound :: Detail
$cminBound :: Detail
Bounded, Int -> Detail
Detail -> Int
Detail -> [Detail]
Detail -> Detail
Detail -> Detail -> [Detail]
Detail -> Detail -> Detail -> [Detail]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Detail -> Detail -> Detail -> [Detail]
$cenumFromThenTo :: Detail -> Detail -> Detail -> [Detail]
enumFromTo :: Detail -> Detail -> [Detail]
$cenumFromTo :: Detail -> Detail -> [Detail]
enumFromThen :: Detail -> Detail -> [Detail]
$cenumFromThen :: Detail -> Detail -> [Detail]
enumFrom :: Detail -> [Detail]
$cenumFrom :: Detail -> [Detail]
fromEnum :: Detail -> Int
$cfromEnum :: Detail -> Int
toEnum :: Int -> Detail
$ctoEnum :: Int -> Detail
pred :: Detail -> Detail
$cpred :: Detail -> Detail
succ :: Detail -> Detail
$csucc :: Detail -> Detail
Enum)

data Mode = NotifyNormal |
            NotifyGrab |
            NotifyUngrab |
            NotifyWhileGrabbed 
            deriving (Mode -> Mode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq, Eq Mode
Mode -> Mode -> Bool
Mode -> Mode -> Ordering
Mode -> Mode -> Mode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Mode -> Mode -> Mode
$cmin :: Mode -> Mode -> Mode
max :: Mode -> Mode -> Mode
$cmax :: Mode -> Mode -> Mode
>= :: Mode -> Mode -> Bool
$c>= :: Mode -> Mode -> Bool
> :: Mode -> Mode -> Bool
$c> :: Mode -> Mode -> Bool
<= :: Mode -> Mode -> Bool
$c<= :: Mode -> Mode -> Bool
< :: Mode -> Mode -> Bool
$c< :: Mode -> Mode -> Bool
compare :: Mode -> Mode -> Ordering
$ccompare :: Mode -> Mode -> Ordering
Ord, Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show, ReadPrec [Mode]
ReadPrec Mode
Int -> ReadS Mode
ReadS [Mode]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Mode]
$creadListPrec :: ReadPrec [Mode]
readPrec :: ReadPrec Mode
$creadPrec :: ReadPrec Mode
readList :: ReadS [Mode]
$creadList :: ReadS [Mode]
readsPrec :: Int -> ReadS Mode
$creadsPrec :: Int -> ReadS Mode
Read, Mode
forall a. a -> a -> Bounded a
maxBound :: Mode
$cmaxBound :: Mode
minBound :: Mode
$cminBound :: Mode
Bounded, Int -> Mode
Mode -> Int
Mode -> [Mode]
Mode -> Mode
Mode -> Mode -> [Mode]
Mode -> Mode -> Mode -> [Mode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Mode -> Mode -> Mode -> [Mode]
$cenumFromThenTo :: Mode -> Mode -> Mode -> [Mode]
enumFromTo :: Mode -> Mode -> [Mode]
$cenumFromTo :: Mode -> Mode -> [Mode]
enumFromThen :: Mode -> Mode -> [Mode]
$cenumFromThen :: Mode -> Mode -> [Mode]
enumFrom :: Mode -> [Mode]
$cenumFrom :: Mode -> [Mode]
fromEnum :: Mode -> Int
$cfromEnum :: Mode -> Int
toEnum :: Int -> Mode
$ctoEnum :: Int -> Mode
pred :: Mode -> Mode
$cpred :: Mode -> Mode
succ :: Mode -> Mode
$csucc :: Mode -> Mode
Enum)

data Visibility = VisibilityUnobscured |
                  VisibilityPartiallyObscured |
                  VisibilityFullyObscured 
                  deriving (Visibility -> Visibility -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Visibility -> Visibility -> Bool
$c/= :: Visibility -> Visibility -> Bool
== :: Visibility -> Visibility -> Bool
$c== :: Visibility -> Visibility -> Bool
Eq, Eq Visibility
Visibility -> Visibility -> Bool
Visibility -> Visibility -> Ordering
Visibility -> Visibility -> Visibility
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Visibility -> Visibility -> Visibility
$cmin :: Visibility -> Visibility -> Visibility
max :: Visibility -> Visibility -> Visibility
$cmax :: Visibility -> Visibility -> Visibility
>= :: Visibility -> Visibility -> Bool
$c>= :: Visibility -> Visibility -> Bool
> :: Visibility -> Visibility -> Bool
$c> :: Visibility -> Visibility -> Bool
<= :: Visibility -> Visibility -> Bool
$c<= :: Visibility -> Visibility -> Bool
< :: Visibility -> Visibility -> Bool
$c< :: Visibility -> Visibility -> Bool
compare :: Visibility -> Visibility -> Ordering
$ccompare :: Visibility -> Visibility -> Ordering
Ord, Int -> Visibility -> ShowS
[Visibility] -> ShowS
Visibility -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Visibility] -> ShowS
$cshowList :: [Visibility] -> ShowS
show :: Visibility -> String
$cshow :: Visibility -> String
showsPrec :: Int -> Visibility -> ShowS
$cshowsPrec :: Int -> Visibility -> ShowS
Show, ReadPrec [Visibility]
ReadPrec Visibility
Int -> ReadS Visibility
ReadS [Visibility]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Visibility]
$creadListPrec :: ReadPrec [Visibility]
readPrec :: ReadPrec Visibility
$creadPrec :: ReadPrec Visibility
readList :: ReadS [Visibility]
$creadList :: ReadS [Visibility]
readsPrec :: Int -> ReadS Visibility
$creadsPrec :: Int -> ReadS Visibility
Read, Visibility
forall a. a -> a -> Bounded a
maxBound :: Visibility
$cmaxBound :: Visibility
minBound :: Visibility
$cminBound :: Visibility
Bounded, Int -> Visibility
Visibility -> Int
Visibility -> [Visibility]
Visibility -> Visibility
Visibility -> Visibility -> [Visibility]
Visibility -> Visibility -> Visibility -> [Visibility]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Visibility -> Visibility -> Visibility -> [Visibility]
$cenumFromThenTo :: Visibility -> Visibility -> Visibility -> [Visibility]
enumFromTo :: Visibility -> Visibility -> [Visibility]
$cenumFromTo :: Visibility -> Visibility -> [Visibility]
enumFromThen :: Visibility -> Visibility -> [Visibility]
$cenumFromThen :: Visibility -> Visibility -> [Visibility]
enumFrom :: Visibility -> [Visibility]
$cenumFrom :: Visibility -> [Visibility]
fromEnum :: Visibility -> Int
$cfromEnum :: Visibility -> Int
toEnum :: Int -> Visibility
$ctoEnum :: Int -> Visibility
pred :: Visibility -> Visibility
$cpred :: Visibility -> Visibility
succ :: Visibility -> Visibility
$csucc :: Visibility -> Visibility
Enum)

data ClientData = Byte String |
                  Short [Int] |
                  Long [Int] 
                  deriving (ClientData -> ClientData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientData -> ClientData -> Bool
$c/= :: ClientData -> ClientData -> Bool
== :: ClientData -> ClientData -> Bool
$c== :: ClientData -> ClientData -> Bool
Eq, Eq ClientData
ClientData -> ClientData -> Bool
ClientData -> ClientData -> Ordering
ClientData -> ClientData -> ClientData
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ClientData -> ClientData -> ClientData
$cmin :: ClientData -> ClientData -> ClientData
max :: ClientData -> ClientData -> ClientData
$cmax :: ClientData -> ClientData -> ClientData
>= :: ClientData -> ClientData -> Bool
$c>= :: ClientData -> ClientData -> Bool
> :: ClientData -> ClientData -> Bool
$c> :: ClientData -> ClientData -> Bool
<= :: ClientData -> ClientData -> Bool
$c<= :: ClientData -> ClientData -> Bool
< :: ClientData -> ClientData -> Bool
$c< :: ClientData -> ClientData -> Bool
compare :: ClientData -> ClientData -> Ordering
$ccompare :: ClientData -> ClientData -> Ordering
Ord, Int -> ClientData -> ShowS
[ClientData] -> ShowS
ClientData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientData] -> ShowS
$cshowList :: [ClientData] -> ShowS
show :: ClientData -> String
$cshow :: ClientData -> String
showsPrec :: Int -> ClientData -> ShowS
$cshowsPrec :: Int -> ClientData -> ShowS
Show, ReadPrec [ClientData]
ReadPrec ClientData
Int -> ReadS ClientData
ReadS [ClientData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ClientData]
$creadListPrec :: ReadPrec [ClientData]
readPrec :: ReadPrec ClientData
$creadPrec :: ReadPrec ClientData
readList :: ReadS [ClientData]
$creadList :: ReadS [ClientData]
readsPrec :: Int -> ReadS ClientData
$creadsPrec :: Int -> ReadS ClientData
Read)

data XEvent
  = FocusIn   { XEvent -> Detail
detail::Detail, XEvent -> Mode
mode::Mode }
  | FocusOut  { detail::Detail, mode::Mode }
  | KeymapNotify
  | GraphicsExpose { XEvent -> Rect
rect::Rect, XEvent -> Int
count::Int, XEvent -> Int
major_code, XEvent -> Int
minor_code::Int}
  | KeyEvent { XEvent -> Int
time::Time, XEvent -> Point
pos,XEvent -> Point
rootPos::Point, XEvent -> ModState
state::ModState, XEvent -> Pressed
type'::Pressed, XEvent -> KeyCode
keycode::KeyCode, XEvent -> String
keySym::KeySym, XEvent -> String
keyLookup::KeyLookup }
  | ButtonEvent { time::Time, pos,rootPos::Point, state::ModState, type'::Pressed, XEvent -> Button
button::Button}
  | MotionNotify { time::Time, pos,rootPos::Point, state::ModState }
  | EnterNotify  { time::Time, pos,rootPos::Point, detail::Detail, mode::Mode, XEvent -> Bool
focus::Bool }
  | LeaveNotify  { time::Time, pos,rootPos::Point, detail::Detail, mode::Mode, focus::Bool }
  | Expose {rect::Rect, count::Int}
  | NoExpose
  | VisibilityNotify Visibility
  | CreateNotify Window
  | DestroyNotify Window
  | UnmapNotify Window
  | MapNotify Window
  | MapRequest Window
  | ReparentNotify
  | ConfigureNotify Rect Int
  | ConfigureRequest
  | GravityNotify
  | ResizeRequest Point
  | CirculateNotify
  | CirculateRequest
  | PropertyNotify
  | SelectionClear Atom
  | SelectionRequest Time Window Selection
  | SelectionNotify Time Selection
  | ColormapNotify
  | ClientMessage Atom ClientData
  | MappingNotify
  -- Pseudo event below:
--  | IOResponse Response
--
--  | LayoutPlace Rect
--  | LayoutSize Size
--  | LayoutPos Point -- Position in parent window. Occationally useful.
  | YourWindowId Window
  | MenuPopupMode Bool -- used by buttonmachine to adjust its behaviour
  deriving (Int -> XEvent -> ShowS
[XEvent] -> ShowS
XEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XEvent] -> ShowS
$cshowList :: [XEvent] -> ShowS
show :: XEvent -> String
$cshow :: XEvent -> String
showsPrec :: Int -> XEvent -> ShowS
$cshowsPrec :: Int -> XEvent -> ShowS
Show,ReadPrec [XEvent]
ReadPrec XEvent
Int -> ReadS XEvent
ReadS [XEvent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [XEvent]
$creadListPrec :: ReadPrec [XEvent]
readPrec :: ReadPrec XEvent
$creadPrec :: ReadPrec XEvent
readList :: ReadS [XEvent]
$creadList :: ReadS [XEvent]
readsPrec :: Int -> ReadS XEvent
$creadsPrec :: Int -> ReadS XEvent
Read)

type Event = XEvent

data XResponse
  = DisplayOpened Display
  | WindowCreated Window
  | GCCreated GCId
  | CursorCreated CursorId
  | PointerGrabbed GrabPointerResult
  | FontLoaded FontId
  | LMLFontQueried FontStruct
  | ColorAllocated (Maybe Color)
  | PixmapCreated PixmapId
  | BitmapRead BitmapReturn
  | RmDatabaseCreated RmDatabase
  | GotResource (Maybe (String, RmValue))
  | CoordinatesTranslated Point
  | GotAtom Atom
  | GotAtomName (Maybe String)
  | GotEvent (Window, XEvent)
  | GotWindowProperty Atom Int Int Int String
  | PointerQueried Bool Point Point ModState
  | FontQueried (Maybe FontStructList)
  | ColorQueried Color
  | TreeQueried Window Window [Window]  -- root parent children
  | GotDefaultRootWindow Window
  | GotGeometry Rect Int Int
  | GotVisual Visual
  | Synced
  | TextExtents16Queried Int Int CharStruct -- ascent descent overall
  | GotFontList [FontName]
  | GotFontListWithInfo [(FontName,FontStructList)]
--  | GotFontListWithInfo [(FontStructList)]
  | DbeExtensionQueried Int Int Int -- status (/=0 means ok), major, minor
  | DbeBuffersSwapped Int -- status (useless?)
  | DbeBackBufferNameAllocated DbeBackBufferId
  deriving (Int -> XResponse -> ShowS
[XResponse] -> ShowS
XResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XResponse] -> ShowS
$cshowList :: [XResponse] -> ShowS
show :: XResponse -> String
$cshow :: XResponse -> String
showsPrec :: Int -> XResponse -> ShowS
$cshowsPrec :: Int -> XResponse -> ShowS
Show,ReadPrec [XResponse]
ReadPrec XResponse
Int -> ReadS XResponse
ReadS [XResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [XResponse]
$creadListPrec :: ReadPrec [XResponse]
readPrec :: ReadPrec XResponse
$creadPrec :: ReadPrec XResponse
readList :: ReadS [XResponse]
$creadList :: ReadS [XResponse]
readsPrec :: Int -> ReadS XResponse
$creadsPrec :: Int -> ReadS XResponse
Read)

data BitmapReturn
  = BitmapBad
  | BitmapReturn Size (Maybe Point) PixmapId 
  deriving (BitmapReturn -> BitmapReturn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BitmapReturn -> BitmapReturn -> Bool
$c/= :: BitmapReturn -> BitmapReturn -> Bool
== :: BitmapReturn -> BitmapReturn -> Bool
$c== :: BitmapReturn -> BitmapReturn -> Bool
Eq, Eq BitmapReturn
BitmapReturn -> BitmapReturn -> Bool
BitmapReturn -> BitmapReturn -> Ordering
BitmapReturn -> BitmapReturn -> BitmapReturn
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BitmapReturn -> BitmapReturn -> BitmapReturn
$cmin :: BitmapReturn -> BitmapReturn -> BitmapReturn
max :: BitmapReturn -> BitmapReturn -> BitmapReturn
$cmax :: BitmapReturn -> BitmapReturn -> BitmapReturn
>= :: BitmapReturn -> BitmapReturn -> Bool
$c>= :: BitmapReturn -> BitmapReturn -> Bool
> :: BitmapReturn -> BitmapReturn -> Bool
$c> :: BitmapReturn -> BitmapReturn -> Bool
<= :: BitmapReturn -> BitmapReturn -> Bool
$c<= :: BitmapReturn -> BitmapReturn -> Bool
< :: BitmapReturn -> BitmapReturn -> Bool
$c< :: BitmapReturn -> BitmapReturn -> Bool
compare :: BitmapReturn -> BitmapReturn -> Ordering
$ccompare :: BitmapReturn -> BitmapReturn -> Ordering
Ord, Int -> BitmapReturn -> ShowS
[BitmapReturn] -> ShowS
BitmapReturn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BitmapReturn] -> ShowS
$cshowList :: [BitmapReturn] -> ShowS
show :: BitmapReturn -> String
$cshow :: BitmapReturn -> String
showsPrec :: Int -> BitmapReturn -> ShowS
$cshowsPrec :: Int -> BitmapReturn -> ShowS
Show, ReadPrec [BitmapReturn]
ReadPrec BitmapReturn
Int -> ReadS BitmapReturn
ReadS [BitmapReturn]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BitmapReturn]
$creadListPrec :: ReadPrec [BitmapReturn]
readPrec :: ReadPrec BitmapReturn
$creadPrec :: ReadPrec BitmapReturn
readList :: ReadS [BitmapReturn]
$creadList :: ReadS [BitmapReturn]
readsPrec :: Int -> ReadS BitmapReturn
$creadsPrec :: Int -> ReadS BitmapReturn
Read)