module ResourceIds where
--import Data.Word(Word32)

newtype XID = XID Int deriving (XID -> XID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XID -> XID -> Bool
$c/= :: XID -> XID -> Bool
== :: XID -> XID -> Bool
$c== :: XID -> XID -> Bool
Eq,Eq XID
XID -> XID -> Bool
XID -> XID -> Ordering
XID -> XID -> XID
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 :: XID -> XID -> XID
$cmin :: XID -> XID -> XID
max :: XID -> XID -> XID
$cmax :: XID -> XID -> XID
>= :: XID -> XID -> Bool
$c>= :: XID -> XID -> Bool
> :: XID -> XID -> Bool
$c> :: XID -> XID -> Bool
<= :: XID -> XID -> Bool
$c<= :: XID -> XID -> Bool
< :: XID -> XID -> Bool
$c< :: XID -> XID -> Bool
compare :: XID -> XID -> Ordering
$ccompare :: XID -> XID -> Ordering
Ord)

instance Show XID where showsPrec :: Int -> XID -> ShowS
showsPrec Int
d (XID Int
w32) = forall a. Show a => Int -> a -> ShowS
showsPrec Int
d Int
w32
instance Read XID where readsPrec :: Int -> ReadS XID
readsPrec Int
d String
s = [(Int -> XID
XID Int
w,String
r)|(Int
w,String
r)<-forall a. Read a => Int -> ReadS a
readsPrec Int
d String
s]

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

type Window = WindowId
type XWId = WindowId

rootWindow :: WindowId
rootWindow = XID -> WindowId
WindowId (Int -> XID
XID Int
0)
noWindow :: WindowId
noWindow = XID -> WindowId
WindowId (Int -> XID
XID (-Int
1))
windowNone :: WindowId
windowNone = XID -> WindowId
WindowId (Int -> XID
XID Int
0)

newtype PixmapId = PixmapId XID deriving (PixmapId -> PixmapId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PixmapId -> PixmapId -> Bool
$c/= :: PixmapId -> PixmapId -> Bool
== :: PixmapId -> PixmapId -> Bool
$c== :: PixmapId -> PixmapId -> Bool
Eq, Eq PixmapId
PixmapId -> PixmapId -> Bool
PixmapId -> PixmapId -> Ordering
PixmapId -> PixmapId -> PixmapId
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 :: PixmapId -> PixmapId -> PixmapId
$cmin :: PixmapId -> PixmapId -> PixmapId
max :: PixmapId -> PixmapId -> PixmapId
$cmax :: PixmapId -> PixmapId -> PixmapId
>= :: PixmapId -> PixmapId -> Bool
$c>= :: PixmapId -> PixmapId -> Bool
> :: PixmapId -> PixmapId -> Bool
$c> :: PixmapId -> PixmapId -> Bool
<= :: PixmapId -> PixmapId -> Bool
$c<= :: PixmapId -> PixmapId -> Bool
< :: PixmapId -> PixmapId -> Bool
$c< :: PixmapId -> PixmapId -> Bool
compare :: PixmapId -> PixmapId -> Ordering
$ccompare :: PixmapId -> PixmapId -> Ordering
Ord, Int -> PixmapId -> ShowS
[PixmapId] -> ShowS
PixmapId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PixmapId] -> ShowS
$cshowList :: [PixmapId] -> ShowS
show :: PixmapId -> String
$cshow :: PixmapId -> String
showsPrec :: Int -> PixmapId -> ShowS
$cshowsPrec :: Int -> PixmapId -> ShowS
Show, ReadPrec [PixmapId]
ReadPrec PixmapId
Int -> ReadS PixmapId
ReadS [PixmapId]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PixmapId]
$creadListPrec :: ReadPrec [PixmapId]
readPrec :: ReadPrec PixmapId
$creadPrec :: ReadPrec PixmapId
readList :: ReadS [PixmapId]
$creadList :: ReadS [PixmapId]
readsPrec :: Int -> ReadS PixmapId
$creadsPrec :: Int -> ReadS PixmapId
Read)
newtype DbeBackBufferId = DbeBackBufferId XID deriving (DbeBackBufferId -> DbeBackBufferId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DbeBackBufferId -> DbeBackBufferId -> Bool
$c/= :: DbeBackBufferId -> DbeBackBufferId -> Bool
== :: DbeBackBufferId -> DbeBackBufferId -> Bool
$c== :: DbeBackBufferId -> DbeBackBufferId -> Bool
Eq, Eq DbeBackBufferId
DbeBackBufferId -> DbeBackBufferId -> Bool
DbeBackBufferId -> DbeBackBufferId -> Ordering
DbeBackBufferId -> DbeBackBufferId -> DbeBackBufferId
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 :: DbeBackBufferId -> DbeBackBufferId -> DbeBackBufferId
$cmin :: DbeBackBufferId -> DbeBackBufferId -> DbeBackBufferId
max :: DbeBackBufferId -> DbeBackBufferId -> DbeBackBufferId
$cmax :: DbeBackBufferId -> DbeBackBufferId -> DbeBackBufferId
>= :: DbeBackBufferId -> DbeBackBufferId -> Bool
$c>= :: DbeBackBufferId -> DbeBackBufferId -> Bool
> :: DbeBackBufferId -> DbeBackBufferId -> Bool
$c> :: DbeBackBufferId -> DbeBackBufferId -> Bool
<= :: DbeBackBufferId -> DbeBackBufferId -> Bool
$c<= :: DbeBackBufferId -> DbeBackBufferId -> Bool
< :: DbeBackBufferId -> DbeBackBufferId -> Bool
$c< :: DbeBackBufferId -> DbeBackBufferId -> Bool
compare :: DbeBackBufferId -> DbeBackBufferId -> Ordering
$ccompare :: DbeBackBufferId -> DbeBackBufferId -> Ordering
Ord, Int -> DbeBackBufferId -> ShowS
[DbeBackBufferId] -> ShowS
DbeBackBufferId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DbeBackBufferId] -> ShowS
$cshowList :: [DbeBackBufferId] -> ShowS
show :: DbeBackBufferId -> String
$cshow :: DbeBackBufferId -> String
showsPrec :: Int -> DbeBackBufferId -> ShowS
$cshowsPrec :: Int -> DbeBackBufferId -> ShowS
Show, ReadPrec [DbeBackBufferId]
ReadPrec DbeBackBufferId
Int -> ReadS DbeBackBufferId
ReadS [DbeBackBufferId]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DbeBackBufferId]
$creadListPrec :: ReadPrec [DbeBackBufferId]
readPrec :: ReadPrec DbeBackBufferId
$creadPrec :: ReadPrec DbeBackBufferId
readList :: ReadS [DbeBackBufferId]
$creadList :: ReadS [DbeBackBufferId]
readsPrec :: Int -> ReadS DbeBackBufferId
$creadsPrec :: Int -> ReadS DbeBackBufferId
Read)
newtype FontId = FontId XID deriving (FontId -> FontId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontId -> FontId -> Bool
$c/= :: FontId -> FontId -> Bool
== :: FontId -> FontId -> Bool
$c== :: FontId -> FontId -> Bool
Eq, Eq FontId
FontId -> FontId -> Bool
FontId -> FontId -> Ordering
FontId -> FontId -> FontId
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 :: FontId -> FontId -> FontId
$cmin :: FontId -> FontId -> FontId
max :: FontId -> FontId -> FontId
$cmax :: FontId -> FontId -> FontId
>= :: FontId -> FontId -> Bool
$c>= :: FontId -> FontId -> Bool
> :: FontId -> FontId -> Bool
$c> :: FontId -> FontId -> Bool
<= :: FontId -> FontId -> Bool
$c<= :: FontId -> FontId -> Bool
< :: FontId -> FontId -> Bool
$c< :: FontId -> FontId -> Bool
compare :: FontId -> FontId -> Ordering
$ccompare :: FontId -> FontId -> Ordering
Ord, ReadPrec [FontId]
ReadPrec FontId
Int -> ReadS FontId
ReadS [FontId]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FontId]
$creadListPrec :: ReadPrec [FontId]
readPrec :: ReadPrec FontId
$creadPrec :: ReadPrec FontId
readList :: ReadS [FontId]
$creadList :: ReadS [FontId]
readsPrec :: Int -> ReadS FontId
$creadsPrec :: Int -> ReadS FontId
Read, Int -> FontId -> ShowS
[FontId] -> ShowS
FontId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontId] -> ShowS
$cshowList :: [FontId] -> ShowS
show :: FontId -> String
$cshow :: FontId -> String
showsPrec :: Int -> FontId -> ShowS
$cshowsPrec :: Int -> FontId -> ShowS
Show)
newtype GCId = GCId Int deriving (GCId -> GCId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GCId -> GCId -> Bool
$c/= :: GCId -> GCId -> Bool
== :: GCId -> GCId -> Bool
$c== :: GCId -> GCId -> Bool
Eq, Eq GCId
GCId -> GCId -> Bool
GCId -> GCId -> Ordering
GCId -> GCId -> GCId
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 :: GCId -> GCId -> GCId
$cmin :: GCId -> GCId -> GCId
max :: GCId -> GCId -> GCId
$cmax :: GCId -> GCId -> GCId
>= :: GCId -> GCId -> Bool
$c>= :: GCId -> GCId -> Bool
> :: GCId -> GCId -> Bool
$c> :: GCId -> GCId -> Bool
<= :: GCId -> GCId -> Bool
$c<= :: GCId -> GCId -> Bool
< :: GCId -> GCId -> Bool
$c< :: GCId -> GCId -> Bool
compare :: GCId -> GCId -> Ordering
$ccompare :: GCId -> GCId -> Ordering
Ord, ReadPrec [GCId]
ReadPrec GCId
Int -> ReadS GCId
ReadS [GCId]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GCId]
$creadListPrec :: ReadPrec [GCId]
readPrec :: ReadPrec GCId
$creadPrec :: ReadPrec GCId
readList :: ReadS [GCId]
$creadList :: ReadS [GCId]
readsPrec :: Int -> ReadS GCId
$creadsPrec :: Int -> ReadS GCId
Read, Int -> GCId -> ShowS
[GCId] -> ShowS
GCId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GCId] -> ShowS
$cshowList :: [GCId] -> ShowS
show :: GCId -> String
$cshow :: GCId -> String
showsPrec :: Int -> GCId -> ShowS
$cshowsPrec :: Int -> GCId -> ShowS
Show)
newtype CursorId = CursorId XID deriving (CursorId -> CursorId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CursorId -> CursorId -> Bool
$c/= :: CursorId -> CursorId -> Bool
== :: CursorId -> CursorId -> Bool
$c== :: CursorId -> CursorId -> Bool
Eq, Eq CursorId
CursorId -> CursorId -> Bool
CursorId -> CursorId -> Ordering
CursorId -> CursorId -> CursorId
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 :: CursorId -> CursorId -> CursorId
$cmin :: CursorId -> CursorId -> CursorId
max :: CursorId -> CursorId -> CursorId
$cmax :: CursorId -> CursorId -> CursorId
>= :: CursorId -> CursorId -> Bool
$c>= :: CursorId -> CursorId -> Bool
> :: CursorId -> CursorId -> Bool
$c> :: CursorId -> CursorId -> Bool
<= :: CursorId -> CursorId -> Bool
$c<= :: CursorId -> CursorId -> Bool
< :: CursorId -> CursorId -> Bool
$c< :: CursorId -> CursorId -> Bool
compare :: CursorId -> CursorId -> Ordering
$ccompare :: CursorId -> CursorId -> Ordering
Ord, ReadPrec [CursorId]
ReadPrec CursorId
Int -> ReadS CursorId
ReadS [CursorId]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CursorId]
$creadListPrec :: ReadPrec [CursorId]
readPrec :: ReadPrec CursorId
$creadPrec :: ReadPrec CursorId
readList :: ReadS [CursorId]
$creadList :: ReadS [CursorId]
readsPrec :: Int -> ReadS CursorId
$creadsPrec :: Int -> ReadS CursorId
Read, Int -> CursorId -> ShowS
[CursorId] -> ShowS
CursorId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CursorId] -> ShowS
$cshowList :: [CursorId] -> ShowS
show :: CursorId -> String
$cshow :: CursorId -> String
showsPrec :: Int -> CursorId -> ShowS
$cshowsPrec :: Int -> CursorId -> ShowS
Show)
newtype ColormapId = ColormapId XID deriving (ColormapId -> ColormapId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColormapId -> ColormapId -> Bool
$c/= :: ColormapId -> ColormapId -> Bool
== :: ColormapId -> ColormapId -> Bool
$c== :: ColormapId -> ColormapId -> Bool
Eq, Eq ColormapId
ColormapId -> ColormapId -> Bool
ColormapId -> ColormapId -> Ordering
ColormapId -> ColormapId -> ColormapId
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 :: ColormapId -> ColormapId -> ColormapId
$cmin :: ColormapId -> ColormapId -> ColormapId
max :: ColormapId -> ColormapId -> ColormapId
$cmax :: ColormapId -> ColormapId -> ColormapId
>= :: ColormapId -> ColormapId -> Bool
$c>= :: ColormapId -> ColormapId -> Bool
> :: ColormapId -> ColormapId -> Bool
$c> :: ColormapId -> ColormapId -> Bool
<= :: ColormapId -> ColormapId -> Bool
$c<= :: ColormapId -> ColormapId -> Bool
< :: ColormapId -> ColormapId -> Bool
$c< :: ColormapId -> ColormapId -> Bool
compare :: ColormapId -> ColormapId -> Ordering
$ccompare :: ColormapId -> ColormapId -> Ordering
Ord, ReadPrec [ColormapId]
ReadPrec ColormapId
Int -> ReadS ColormapId
ReadS [ColormapId]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ColormapId]
$creadListPrec :: ReadPrec [ColormapId]
readPrec :: ReadPrec ColormapId
$creadPrec :: ReadPrec ColormapId
readList :: ReadS [ColormapId]
$creadList :: ReadS [ColormapId]
readsPrec :: Int -> ReadS ColormapId
$creadsPrec :: Int -> ReadS ColormapId
Read, Int -> ColormapId -> ShowS
[ColormapId] -> ShowS
ColormapId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColormapId] -> ShowS
$cshowList :: [ColormapId] -> ShowS
show :: ColormapId -> String
$cshow :: ColormapId -> String
showsPrec :: Int -> ColormapId -> ShowS
$cshowsPrec :: Int -> ColormapId -> ShowS
Show)

defaultColormap :: ColormapId
defaultColormap = XID -> ColormapId
ColormapId (Int -> XID
XID Int
0)
cursorNone :: CursorId
cursorNone = XID -> CursorId
CursorId (Int -> XID
XID Int
0)

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


type ColorName = String
type FontName = String

type Time = Int
currentTime :: Int
currentTime = Int
0::Time

type Depth = Int

copyFromParent :: Int
copyFromParent = Int
0 :: Depth
parentRelative :: PixmapId
parentRelative = XID -> PixmapId
PixmapId (Int -> XID
XID Int
1)
none :: PixmapId
none = XID -> PixmapId
PixmapId (Int -> XID
XID Int
0)

rootGC :: GCId
rootGC = Int -> GCId
GCId Int
0