module Xtypes(module Xtypes,module EventMask,module AuxTypes,module ResourceIds,module Image) where
--import Geometry(Line, Point, Rect)
import EventMask
import AuxTypes
import ResourceIds
import Image
import Data.Ix
import HbcWord

-- #ifdef __NHC__
-- Bug in export of newtype
-- #define newtype data
-- #endif

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

noDisplay :: Display
noDisplay = Int -> Display
Display (-Int
1)

type KeyLookup = String
type Width = Int

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

type PlaneMask = Pixel

pixel0 :: Pixel
pixel0 = Word -> Pixel
Pixel Word
0
pixel1 :: Pixel
pixel1 = Word -> Pixel
Pixel Word
1
--black = Pixel 0 -- not always true !!
--white = Pixel 1 -- not always true !!

data RGB = RGB Int Int Int deriving ( RGB -> RGB -> Bool
(RGB -> RGB -> Bool) -> (RGB -> RGB -> Bool) -> Eq RGB
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RGB -> RGB -> Bool
$c/= :: RGB -> RGB -> Bool
== :: RGB -> RGB -> Bool
$c== :: RGB -> RGB -> Bool
Eq, Eq RGB
Eq RGB
-> (RGB -> RGB -> Ordering)
-> (RGB -> RGB -> Bool)
-> (RGB -> RGB -> Bool)
-> (RGB -> RGB -> Bool)
-> (RGB -> RGB -> Bool)
-> (RGB -> RGB -> RGB)
-> (RGB -> RGB -> RGB)
-> Ord RGB
RGB -> RGB -> Bool
RGB -> RGB -> Ordering
RGB -> RGB -> RGB
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 :: RGB -> RGB -> RGB
$cmin :: RGB -> RGB -> RGB
max :: RGB -> RGB -> RGB
$cmax :: RGB -> RGB -> RGB
>= :: RGB -> RGB -> Bool
$c>= :: RGB -> RGB -> Bool
> :: RGB -> RGB -> Bool
$c> :: RGB -> RGB -> Bool
<= :: RGB -> RGB -> Bool
$c<= :: RGB -> RGB -> Bool
< :: RGB -> RGB -> Bool
$c< :: RGB -> RGB -> Bool
compare :: RGB -> RGB -> Ordering
$ccompare :: RGB -> RGB -> Ordering
$cp1Ord :: Eq RGB
Ord, Int -> RGB -> ShowS
[RGB] -> ShowS
RGB -> String
(Int -> RGB -> ShowS)
-> (RGB -> String) -> ([RGB] -> ShowS) -> Show RGB
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RGB] -> ShowS
$cshowList :: [RGB] -> ShowS
show :: RGB -> String
$cshow :: RGB -> String
showsPrec :: Int -> RGB -> ShowS
$cshowsPrec :: Int -> RGB -> ShowS
Show, ReadPrec [RGB]
ReadPrec RGB
Int -> ReadS RGB
ReadS [RGB]
(Int -> ReadS RGB)
-> ReadS [RGB] -> ReadPrec RGB -> ReadPrec [RGB] -> Read RGB
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RGB]
$creadListPrec :: ReadPrec [RGB]
readPrec :: ReadPrec RGB
$creadPrec :: ReadPrec RGB
readList :: ReadS [RGB]
$creadList :: ReadS [RGB]
readsPrec :: Int -> ReadS RGB
$creadsPrec :: Int -> ReadS RGB
Read, Ord RGB
Ord RGB
-> ((RGB, RGB) -> [RGB])
-> ((RGB, RGB) -> RGB -> Int)
-> ((RGB, RGB) -> RGB -> Int)
-> ((RGB, RGB) -> RGB -> Bool)
-> ((RGB, RGB) -> Int)
-> ((RGB, RGB) -> Int)
-> Ix RGB
(RGB, RGB) -> Int
(RGB, RGB) -> [RGB]
(RGB, RGB) -> RGB -> Bool
(RGB, RGB) -> RGB -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (RGB, RGB) -> Int
$cunsafeRangeSize :: (RGB, RGB) -> Int
rangeSize :: (RGB, RGB) -> Int
$crangeSize :: (RGB, RGB) -> Int
inRange :: (RGB, RGB) -> RGB -> Bool
$cinRange :: (RGB, RGB) -> RGB -> Bool
unsafeIndex :: (RGB, RGB) -> RGB -> Int
$cunsafeIndex :: (RGB, RGB) -> RGB -> Int
index :: (RGB, RGB) -> RGB -> Int
$cindex :: (RGB, RGB) -> RGB -> Int
range :: (RGB, RGB) -> [RGB]
$crange :: (RGB, RGB) -> [RGB]
$cp1Ix :: Ord RGB
Ix )
data Color = Color { Color -> Pixel
colorPixel::Pixel, Color -> RGB
colorRGB::RGB }
             deriving (Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq, Eq Color
Eq Color
-> (Color -> Color -> Ordering)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Color)
-> (Color -> Color -> Color)
-> Ord Color
Color -> Color -> Bool
Color -> Color -> Ordering
Color -> Color -> Color
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 :: Color -> Color -> Color
$cmin :: Color -> Color -> Color
max :: Color -> Color -> Color
$cmax :: Color -> Color -> Color
>= :: Color -> Color -> Bool
$c>= :: Color -> Color -> Bool
> :: Color -> Color -> Bool
$c> :: Color -> Color -> Bool
<= :: Color -> Color -> Bool
$c<= :: Color -> Color -> Bool
< :: Color -> Color -> Bool
$c< :: Color -> Color -> Bool
compare :: Color -> Color -> Ordering
$ccompare :: Color -> Color -> Ordering
$cp1Ord :: Eq Color
Ord, Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> ShowS
$cshowsPrec :: Int -> Color -> ShowS
Show, ReadPrec [Color]
ReadPrec Color
Int -> ReadS Color
ReadS [Color]
(Int -> ReadS Color)
-> ReadS [Color]
-> ReadPrec Color
-> ReadPrec [Color]
-> Read Color
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Color]
$creadListPrec :: ReadPrec [Color]
readPrec :: ReadPrec Color
$creadPrec :: ReadPrec Color
readList :: ReadS [Color]
$creadList :: ReadS [Color]
readsPrec :: Int -> ReadS Color
$creadsPrec :: Int -> ReadS Color
Read)

maxRGB :: Int -- for hugs
maxRGB :: Int
maxRGB = Int
65535
grayRGB :: Int -> RGB
grayRGB Int
x = Int -> Int -> Int -> RGB
RGB Int
x Int
x Int
x
whiteRGB :: RGB
whiteRGB = Int -> RGB
grayRGB Int
maxRGB
blackRGB :: RGB
blackRGB = Int -> RGB
grayRGB Int
0

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


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

propModeReplace :: PropertyMode
propModeReplace = Int -> PropertyMode
PropertyMode Int
0
propModePrepend :: PropertyMode
propModePrepend = Int -> PropertyMode
PropertyMode Int
1
propModeAppend :: PropertyMode
propModeAppend  = Int -> PropertyMode
PropertyMode Int
2

--data EventMask -- moved to EventMask.hs

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

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

-- Same order as in X.h
data GCFunction
  = GXclear
  | GXand
  | GXandReverse
  | GXcopy
  | GXandInverted
  | GXnoop
  | GXxor
  | GXor
  | GXnor
  | GXequiv
  | GXinvert
  | GXorReverse
  | GXCopyInverted
  | GXorInverted
  | GXnand
  | GXset 
  deriving (GCFunction -> GCFunction -> Bool
(GCFunction -> GCFunction -> Bool)
-> (GCFunction -> GCFunction -> Bool) -> Eq GCFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GCFunction -> GCFunction -> Bool
$c/= :: GCFunction -> GCFunction -> Bool
== :: GCFunction -> GCFunction -> Bool
$c== :: GCFunction -> GCFunction -> Bool
Eq, Eq GCFunction
Eq GCFunction
-> (GCFunction -> GCFunction -> Ordering)
-> (GCFunction -> GCFunction -> Bool)
-> (GCFunction -> GCFunction -> Bool)
-> (GCFunction -> GCFunction -> Bool)
-> (GCFunction -> GCFunction -> Bool)
-> (GCFunction -> GCFunction -> GCFunction)
-> (GCFunction -> GCFunction -> GCFunction)
-> Ord GCFunction
GCFunction -> GCFunction -> Bool
GCFunction -> GCFunction -> Ordering
GCFunction -> GCFunction -> GCFunction
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 :: GCFunction -> GCFunction -> GCFunction
$cmin :: GCFunction -> GCFunction -> GCFunction
max :: GCFunction -> GCFunction -> GCFunction
$cmax :: GCFunction -> GCFunction -> GCFunction
>= :: GCFunction -> GCFunction -> Bool
$c>= :: GCFunction -> GCFunction -> Bool
> :: GCFunction -> GCFunction -> Bool
$c> :: GCFunction -> GCFunction -> Bool
<= :: GCFunction -> GCFunction -> Bool
$c<= :: GCFunction -> GCFunction -> Bool
< :: GCFunction -> GCFunction -> Bool
$c< :: GCFunction -> GCFunction -> Bool
compare :: GCFunction -> GCFunction -> Ordering
$ccompare :: GCFunction -> GCFunction -> Ordering
$cp1Ord :: Eq GCFunction
Ord, Int -> GCFunction -> ShowS
[GCFunction] -> ShowS
GCFunction -> String
(Int -> GCFunction -> ShowS)
-> (GCFunction -> String)
-> ([GCFunction] -> ShowS)
-> Show GCFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GCFunction] -> ShowS
$cshowList :: [GCFunction] -> ShowS
show :: GCFunction -> String
$cshow :: GCFunction -> String
showsPrec :: Int -> GCFunction -> ShowS
$cshowsPrec :: Int -> GCFunction -> ShowS
Show, ReadPrec [GCFunction]
ReadPrec GCFunction
Int -> ReadS GCFunction
ReadS [GCFunction]
(Int -> ReadS GCFunction)
-> ReadS [GCFunction]
-> ReadPrec GCFunction
-> ReadPrec [GCFunction]
-> Read GCFunction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GCFunction]
$creadListPrec :: ReadPrec [GCFunction]
readPrec :: ReadPrec GCFunction
$creadPrec :: ReadPrec GCFunction
readList :: ReadS [GCFunction]
$creadList :: ReadS [GCFunction]
readsPrec :: Int -> ReadS GCFunction
$creadsPrec :: Int -> ReadS GCFunction
Read, GCFunction
GCFunction -> GCFunction -> Bounded GCFunction
forall a. a -> a -> Bounded a
maxBound :: GCFunction
$cmaxBound :: GCFunction
minBound :: GCFunction
$cminBound :: GCFunction
Bounded, Int -> GCFunction
GCFunction -> Int
GCFunction -> [GCFunction]
GCFunction -> GCFunction
GCFunction -> GCFunction -> [GCFunction]
GCFunction -> GCFunction -> GCFunction -> [GCFunction]
(GCFunction -> GCFunction)
-> (GCFunction -> GCFunction)
-> (Int -> GCFunction)
-> (GCFunction -> Int)
-> (GCFunction -> [GCFunction])
-> (GCFunction -> GCFunction -> [GCFunction])
-> (GCFunction -> GCFunction -> [GCFunction])
-> (GCFunction -> GCFunction -> GCFunction -> [GCFunction])
-> Enum GCFunction
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 :: GCFunction -> GCFunction -> GCFunction -> [GCFunction]
$cenumFromThenTo :: GCFunction -> GCFunction -> GCFunction -> [GCFunction]
enumFromTo :: GCFunction -> GCFunction -> [GCFunction]
$cenumFromTo :: GCFunction -> GCFunction -> [GCFunction]
enumFromThen :: GCFunction -> GCFunction -> [GCFunction]
$cenumFromThen :: GCFunction -> GCFunction -> [GCFunction]
enumFrom :: GCFunction -> [GCFunction]
$cenumFrom :: GCFunction -> [GCFunction]
fromEnum :: GCFunction -> Int
$cfromEnum :: GCFunction -> Int
toEnum :: Int -> GCFunction
$ctoEnum :: Int -> GCFunction
pred :: GCFunction -> GCFunction
$cpred :: GCFunction -> GCFunction
succ :: GCFunction -> GCFunction
$csucc :: GCFunction -> GCFunction
Enum)


-- Same order as in X.h
data GCLineStyle
  = LineSolid | LineDoubleDash | LineOnOffDash 
  deriving (GCLineStyle -> GCLineStyle -> Bool
(GCLineStyle -> GCLineStyle -> Bool)
-> (GCLineStyle -> GCLineStyle -> Bool) -> Eq GCLineStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GCLineStyle -> GCLineStyle -> Bool
$c/= :: GCLineStyle -> GCLineStyle -> Bool
== :: GCLineStyle -> GCLineStyle -> Bool
$c== :: GCLineStyle -> GCLineStyle -> Bool
Eq, Eq GCLineStyle
Eq GCLineStyle
-> (GCLineStyle -> GCLineStyle -> Ordering)
-> (GCLineStyle -> GCLineStyle -> Bool)
-> (GCLineStyle -> GCLineStyle -> Bool)
-> (GCLineStyle -> GCLineStyle -> Bool)
-> (GCLineStyle -> GCLineStyle -> Bool)
-> (GCLineStyle -> GCLineStyle -> GCLineStyle)
-> (GCLineStyle -> GCLineStyle -> GCLineStyle)
-> Ord GCLineStyle
GCLineStyle -> GCLineStyle -> Bool
GCLineStyle -> GCLineStyle -> Ordering
GCLineStyle -> GCLineStyle -> GCLineStyle
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 :: GCLineStyle -> GCLineStyle -> GCLineStyle
$cmin :: GCLineStyle -> GCLineStyle -> GCLineStyle
max :: GCLineStyle -> GCLineStyle -> GCLineStyle
$cmax :: GCLineStyle -> GCLineStyle -> GCLineStyle
>= :: GCLineStyle -> GCLineStyle -> Bool
$c>= :: GCLineStyle -> GCLineStyle -> Bool
> :: GCLineStyle -> GCLineStyle -> Bool
$c> :: GCLineStyle -> GCLineStyle -> Bool
<= :: GCLineStyle -> GCLineStyle -> Bool
$c<= :: GCLineStyle -> GCLineStyle -> Bool
< :: GCLineStyle -> GCLineStyle -> Bool
$c< :: GCLineStyle -> GCLineStyle -> Bool
compare :: GCLineStyle -> GCLineStyle -> Ordering
$ccompare :: GCLineStyle -> GCLineStyle -> Ordering
$cp1Ord :: Eq GCLineStyle
Ord, Int -> GCLineStyle -> ShowS
[GCLineStyle] -> ShowS
GCLineStyle -> String
(Int -> GCLineStyle -> ShowS)
-> (GCLineStyle -> String)
-> ([GCLineStyle] -> ShowS)
-> Show GCLineStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GCLineStyle] -> ShowS
$cshowList :: [GCLineStyle] -> ShowS
show :: GCLineStyle -> String
$cshow :: GCLineStyle -> String
showsPrec :: Int -> GCLineStyle -> ShowS
$cshowsPrec :: Int -> GCLineStyle -> ShowS
Show, ReadPrec [GCLineStyle]
ReadPrec GCLineStyle
Int -> ReadS GCLineStyle
ReadS [GCLineStyle]
(Int -> ReadS GCLineStyle)
-> ReadS [GCLineStyle]
-> ReadPrec GCLineStyle
-> ReadPrec [GCLineStyle]
-> Read GCLineStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GCLineStyle]
$creadListPrec :: ReadPrec [GCLineStyle]
readPrec :: ReadPrec GCLineStyle
$creadPrec :: ReadPrec GCLineStyle
readList :: ReadS [GCLineStyle]
$creadList :: ReadS [GCLineStyle]
readsPrec :: Int -> ReadS GCLineStyle
$creadsPrec :: Int -> ReadS GCLineStyle
Read, GCLineStyle
GCLineStyle -> GCLineStyle -> Bounded GCLineStyle
forall a. a -> a -> Bounded a
maxBound :: GCLineStyle
$cmaxBound :: GCLineStyle
minBound :: GCLineStyle
$cminBound :: GCLineStyle
Bounded, Int -> GCLineStyle
GCLineStyle -> Int
GCLineStyle -> [GCLineStyle]
GCLineStyle -> GCLineStyle
GCLineStyle -> GCLineStyle -> [GCLineStyle]
GCLineStyle -> GCLineStyle -> GCLineStyle -> [GCLineStyle]
(GCLineStyle -> GCLineStyle)
-> (GCLineStyle -> GCLineStyle)
-> (Int -> GCLineStyle)
-> (GCLineStyle -> Int)
-> (GCLineStyle -> [GCLineStyle])
-> (GCLineStyle -> GCLineStyle -> [GCLineStyle])
-> (GCLineStyle -> GCLineStyle -> [GCLineStyle])
-> (GCLineStyle -> GCLineStyle -> GCLineStyle -> [GCLineStyle])
-> Enum GCLineStyle
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 :: GCLineStyle -> GCLineStyle -> GCLineStyle -> [GCLineStyle]
$cenumFromThenTo :: GCLineStyle -> GCLineStyle -> GCLineStyle -> [GCLineStyle]
enumFromTo :: GCLineStyle -> GCLineStyle -> [GCLineStyle]
$cenumFromTo :: GCLineStyle -> GCLineStyle -> [GCLineStyle]
enumFromThen :: GCLineStyle -> GCLineStyle -> [GCLineStyle]
$cenumFromThen :: GCLineStyle -> GCLineStyle -> [GCLineStyle]
enumFrom :: GCLineStyle -> [GCLineStyle]
$cenumFrom :: GCLineStyle -> [GCLineStyle]
fromEnum :: GCLineStyle -> Int
$cfromEnum :: GCLineStyle -> Int
toEnum :: Int -> GCLineStyle
$ctoEnum :: Int -> GCLineStyle
pred :: GCLineStyle -> GCLineStyle
$cpred :: GCLineStyle -> GCLineStyle
succ :: GCLineStyle -> GCLineStyle
$csucc :: GCLineStyle -> GCLineStyle
Enum)

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

data GCJoinStyle
  = JoinMiter | JoinRound | JoinBevel
  deriving (GCJoinStyle -> GCJoinStyle -> Bool
(GCJoinStyle -> GCJoinStyle -> Bool)
-> (GCJoinStyle -> GCJoinStyle -> Bool) -> Eq GCJoinStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GCJoinStyle -> GCJoinStyle -> Bool
$c/= :: GCJoinStyle -> GCJoinStyle -> Bool
== :: GCJoinStyle -> GCJoinStyle -> Bool
$c== :: GCJoinStyle -> GCJoinStyle -> Bool
Eq, Eq GCJoinStyle
Eq GCJoinStyle
-> (GCJoinStyle -> GCJoinStyle -> Ordering)
-> (GCJoinStyle -> GCJoinStyle -> Bool)
-> (GCJoinStyle -> GCJoinStyle -> Bool)
-> (GCJoinStyle -> GCJoinStyle -> Bool)
-> (GCJoinStyle -> GCJoinStyle -> Bool)
-> (GCJoinStyle -> GCJoinStyle -> GCJoinStyle)
-> (GCJoinStyle -> GCJoinStyle -> GCJoinStyle)
-> Ord GCJoinStyle
GCJoinStyle -> GCJoinStyle -> Bool
GCJoinStyle -> GCJoinStyle -> Ordering
GCJoinStyle -> GCJoinStyle -> GCJoinStyle
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 :: GCJoinStyle -> GCJoinStyle -> GCJoinStyle
$cmin :: GCJoinStyle -> GCJoinStyle -> GCJoinStyle
max :: GCJoinStyle -> GCJoinStyle -> GCJoinStyle
$cmax :: GCJoinStyle -> GCJoinStyle -> GCJoinStyle
>= :: GCJoinStyle -> GCJoinStyle -> Bool
$c>= :: GCJoinStyle -> GCJoinStyle -> Bool
> :: GCJoinStyle -> GCJoinStyle -> Bool
$c> :: GCJoinStyle -> GCJoinStyle -> Bool
<= :: GCJoinStyle -> GCJoinStyle -> Bool
$c<= :: GCJoinStyle -> GCJoinStyle -> Bool
< :: GCJoinStyle -> GCJoinStyle -> Bool
$c< :: GCJoinStyle -> GCJoinStyle -> Bool
compare :: GCJoinStyle -> GCJoinStyle -> Ordering
$ccompare :: GCJoinStyle -> GCJoinStyle -> Ordering
$cp1Ord :: Eq GCJoinStyle
Ord, Int -> GCJoinStyle -> ShowS
[GCJoinStyle] -> ShowS
GCJoinStyle -> String
(Int -> GCJoinStyle -> ShowS)
-> (GCJoinStyle -> String)
-> ([GCJoinStyle] -> ShowS)
-> Show GCJoinStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GCJoinStyle] -> ShowS
$cshowList :: [GCJoinStyle] -> ShowS
show :: GCJoinStyle -> String
$cshow :: GCJoinStyle -> String
showsPrec :: Int -> GCJoinStyle -> ShowS
$cshowsPrec :: Int -> GCJoinStyle -> ShowS
Show, ReadPrec [GCJoinStyle]
ReadPrec GCJoinStyle
Int -> ReadS GCJoinStyle
ReadS [GCJoinStyle]
(Int -> ReadS GCJoinStyle)
-> ReadS [GCJoinStyle]
-> ReadPrec GCJoinStyle
-> ReadPrec [GCJoinStyle]
-> Read GCJoinStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GCJoinStyle]
$creadListPrec :: ReadPrec [GCJoinStyle]
readPrec :: ReadPrec GCJoinStyle
$creadPrec :: ReadPrec GCJoinStyle
readList :: ReadS [GCJoinStyle]
$creadList :: ReadS [GCJoinStyle]
readsPrec :: Int -> ReadS GCJoinStyle
$creadsPrec :: Int -> ReadS GCJoinStyle
Read, GCJoinStyle
GCJoinStyle -> GCJoinStyle -> Bounded GCJoinStyle
forall a. a -> a -> Bounded a
maxBound :: GCJoinStyle
$cmaxBound :: GCJoinStyle
minBound :: GCJoinStyle
$cminBound :: GCJoinStyle
Bounded, Int -> GCJoinStyle
GCJoinStyle -> Int
GCJoinStyle -> [GCJoinStyle]
GCJoinStyle -> GCJoinStyle
GCJoinStyle -> GCJoinStyle -> [GCJoinStyle]
GCJoinStyle -> GCJoinStyle -> GCJoinStyle -> [GCJoinStyle]
(GCJoinStyle -> GCJoinStyle)
-> (GCJoinStyle -> GCJoinStyle)
-> (Int -> GCJoinStyle)
-> (GCJoinStyle -> Int)
-> (GCJoinStyle -> [GCJoinStyle])
-> (GCJoinStyle -> GCJoinStyle -> [GCJoinStyle])
-> (GCJoinStyle -> GCJoinStyle -> [GCJoinStyle])
-> (GCJoinStyle -> GCJoinStyle -> GCJoinStyle -> [GCJoinStyle])
-> Enum GCJoinStyle
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 :: GCJoinStyle -> GCJoinStyle -> GCJoinStyle -> [GCJoinStyle]
$cenumFromThenTo :: GCJoinStyle -> GCJoinStyle -> GCJoinStyle -> [GCJoinStyle]
enumFromTo :: GCJoinStyle -> GCJoinStyle -> [GCJoinStyle]
$cenumFromTo :: GCJoinStyle -> GCJoinStyle -> [GCJoinStyle]
enumFromThen :: GCJoinStyle -> GCJoinStyle -> [GCJoinStyle]
$cenumFromThen :: GCJoinStyle -> GCJoinStyle -> [GCJoinStyle]
enumFrom :: GCJoinStyle -> [GCJoinStyle]
$cenumFrom :: GCJoinStyle -> [GCJoinStyle]
fromEnum :: GCJoinStyle -> Int
$cfromEnum :: GCJoinStyle -> Int
toEnum :: Int -> GCJoinStyle
$ctoEnum :: Int -> GCJoinStyle
pred :: GCJoinStyle -> GCJoinStyle
$cpred :: GCJoinStyle -> GCJoinStyle
succ :: GCJoinStyle -> GCJoinStyle
$csucc :: GCJoinStyle -> GCJoinStyle
Enum)
  
data GCSubwindowMode
  = ClipByChildren | IncludeInferiors 
  deriving (GCSubwindowMode -> GCSubwindowMode -> Bool
(GCSubwindowMode -> GCSubwindowMode -> Bool)
-> (GCSubwindowMode -> GCSubwindowMode -> Bool)
-> Eq GCSubwindowMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GCSubwindowMode -> GCSubwindowMode -> Bool
$c/= :: GCSubwindowMode -> GCSubwindowMode -> Bool
== :: GCSubwindowMode -> GCSubwindowMode -> Bool
$c== :: GCSubwindowMode -> GCSubwindowMode -> Bool
Eq, Eq GCSubwindowMode
Eq GCSubwindowMode
-> (GCSubwindowMode -> GCSubwindowMode -> Ordering)
-> (GCSubwindowMode -> GCSubwindowMode -> Bool)
-> (GCSubwindowMode -> GCSubwindowMode -> Bool)
-> (GCSubwindowMode -> GCSubwindowMode -> Bool)
-> (GCSubwindowMode -> GCSubwindowMode -> Bool)
-> (GCSubwindowMode -> GCSubwindowMode -> GCSubwindowMode)
-> (GCSubwindowMode -> GCSubwindowMode -> GCSubwindowMode)
-> Ord GCSubwindowMode
GCSubwindowMode -> GCSubwindowMode -> Bool
GCSubwindowMode -> GCSubwindowMode -> Ordering
GCSubwindowMode -> GCSubwindowMode -> GCSubwindowMode
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 :: GCSubwindowMode -> GCSubwindowMode -> GCSubwindowMode
$cmin :: GCSubwindowMode -> GCSubwindowMode -> GCSubwindowMode
max :: GCSubwindowMode -> GCSubwindowMode -> GCSubwindowMode
$cmax :: GCSubwindowMode -> GCSubwindowMode -> GCSubwindowMode
>= :: GCSubwindowMode -> GCSubwindowMode -> Bool
$c>= :: GCSubwindowMode -> GCSubwindowMode -> Bool
> :: GCSubwindowMode -> GCSubwindowMode -> Bool
$c> :: GCSubwindowMode -> GCSubwindowMode -> Bool
<= :: GCSubwindowMode -> GCSubwindowMode -> Bool
$c<= :: GCSubwindowMode -> GCSubwindowMode -> Bool
< :: GCSubwindowMode -> GCSubwindowMode -> Bool
$c< :: GCSubwindowMode -> GCSubwindowMode -> Bool
compare :: GCSubwindowMode -> GCSubwindowMode -> Ordering
$ccompare :: GCSubwindowMode -> GCSubwindowMode -> Ordering
$cp1Ord :: Eq GCSubwindowMode
Ord, Int -> GCSubwindowMode -> ShowS
[GCSubwindowMode] -> ShowS
GCSubwindowMode -> String
(Int -> GCSubwindowMode -> ShowS)
-> (GCSubwindowMode -> String)
-> ([GCSubwindowMode] -> ShowS)
-> Show GCSubwindowMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GCSubwindowMode] -> ShowS
$cshowList :: [GCSubwindowMode] -> ShowS
show :: GCSubwindowMode -> String
$cshow :: GCSubwindowMode -> String
showsPrec :: Int -> GCSubwindowMode -> ShowS
$cshowsPrec :: Int -> GCSubwindowMode -> ShowS
Show, ReadPrec [GCSubwindowMode]
ReadPrec GCSubwindowMode
Int -> ReadS GCSubwindowMode
ReadS [GCSubwindowMode]
(Int -> ReadS GCSubwindowMode)
-> ReadS [GCSubwindowMode]
-> ReadPrec GCSubwindowMode
-> ReadPrec [GCSubwindowMode]
-> Read GCSubwindowMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GCSubwindowMode]
$creadListPrec :: ReadPrec [GCSubwindowMode]
readPrec :: ReadPrec GCSubwindowMode
$creadPrec :: ReadPrec GCSubwindowMode
readList :: ReadS [GCSubwindowMode]
$creadList :: ReadS [GCSubwindowMode]
readsPrec :: Int -> ReadS GCSubwindowMode
$creadsPrec :: Int -> ReadS GCSubwindowMode
Read, GCSubwindowMode
GCSubwindowMode -> GCSubwindowMode -> Bounded GCSubwindowMode
forall a. a -> a -> Bounded a
maxBound :: GCSubwindowMode
$cmaxBound :: GCSubwindowMode
minBound :: GCSubwindowMode
$cminBound :: GCSubwindowMode
Bounded, Int -> GCSubwindowMode
GCSubwindowMode -> Int
GCSubwindowMode -> [GCSubwindowMode]
GCSubwindowMode -> GCSubwindowMode
GCSubwindowMode -> GCSubwindowMode -> [GCSubwindowMode]
GCSubwindowMode
-> GCSubwindowMode -> GCSubwindowMode -> [GCSubwindowMode]
(GCSubwindowMode -> GCSubwindowMode)
-> (GCSubwindowMode -> GCSubwindowMode)
-> (Int -> GCSubwindowMode)
-> (GCSubwindowMode -> Int)
-> (GCSubwindowMode -> [GCSubwindowMode])
-> (GCSubwindowMode -> GCSubwindowMode -> [GCSubwindowMode])
-> (GCSubwindowMode -> GCSubwindowMode -> [GCSubwindowMode])
-> (GCSubwindowMode
    -> GCSubwindowMode -> GCSubwindowMode -> [GCSubwindowMode])
-> Enum GCSubwindowMode
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 :: GCSubwindowMode
-> GCSubwindowMode -> GCSubwindowMode -> [GCSubwindowMode]
$cenumFromThenTo :: GCSubwindowMode
-> GCSubwindowMode -> GCSubwindowMode -> [GCSubwindowMode]
enumFromTo :: GCSubwindowMode -> GCSubwindowMode -> [GCSubwindowMode]
$cenumFromTo :: GCSubwindowMode -> GCSubwindowMode -> [GCSubwindowMode]
enumFromThen :: GCSubwindowMode -> GCSubwindowMode -> [GCSubwindowMode]
$cenumFromThen :: GCSubwindowMode -> GCSubwindowMode -> [GCSubwindowMode]
enumFrom :: GCSubwindowMode -> [GCSubwindowMode]
$cenumFrom :: GCSubwindowMode -> [GCSubwindowMode]
fromEnum :: GCSubwindowMode -> Int
$cfromEnum :: GCSubwindowMode -> Int
toEnum :: Int -> GCSubwindowMode
$ctoEnum :: Int -> GCSubwindowMode
pred :: GCSubwindowMode -> GCSubwindowMode
$cpred :: GCSubwindowMode -> GCSubwindowMode
succ :: GCSubwindowMode -> GCSubwindowMode
$csucc :: GCSubwindowMode -> GCSubwindowMode
Enum)

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

data GCAttributes a b
  = GCFunction GCFunction
  | GCForeground a
  | GCBackground a
  | GCLineWidth Width
  | GCLineStyle GCLineStyle
  | GCFont b
  | GCCapStyle GCCapStyle
  | GCSubwindowMode GCSubwindowMode
  | GCGraphicsExposures Bool
  | GCFillStyle GCFillStyle
  | GCTile PixmapId
  | GCStipple PixmapId
  | GCJoinStyle GCJoinStyle
  deriving (GCAttributes a b -> GCAttributes a b -> Bool
(GCAttributes a b -> GCAttributes a b -> Bool)
-> (GCAttributes a b -> GCAttributes a b -> Bool)
-> Eq (GCAttributes a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
GCAttributes a b -> GCAttributes a b -> Bool
/= :: GCAttributes a b -> GCAttributes a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
GCAttributes a b -> GCAttributes a b -> Bool
== :: GCAttributes a b -> GCAttributes a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
GCAttributes a b -> GCAttributes a b -> Bool
Eq, Eq (GCAttributes a b)
Eq (GCAttributes a b)
-> (GCAttributes a b -> GCAttributes a b -> Ordering)
-> (GCAttributes a b -> GCAttributes a b -> Bool)
-> (GCAttributes a b -> GCAttributes a b -> Bool)
-> (GCAttributes a b -> GCAttributes a b -> Bool)
-> (GCAttributes a b -> GCAttributes a b -> Bool)
-> (GCAttributes a b -> GCAttributes a b -> GCAttributes a b)
-> (GCAttributes a b -> GCAttributes a b -> GCAttributes a b)
-> Ord (GCAttributes a b)
GCAttributes a b -> GCAttributes a b -> Bool
GCAttributes a b -> GCAttributes a b -> Ordering
GCAttributes a b -> GCAttributes a b -> GCAttributes a b
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
forall a b. (Ord a, Ord b) => Eq (GCAttributes a b)
forall a b.
(Ord a, Ord b) =>
GCAttributes a b -> GCAttributes a b -> Bool
forall a b.
(Ord a, Ord b) =>
GCAttributes a b -> GCAttributes a b -> Ordering
forall a b.
(Ord a, Ord b) =>
GCAttributes a b -> GCAttributes a b -> GCAttributes a b
min :: GCAttributes a b -> GCAttributes a b -> GCAttributes a b
$cmin :: forall a b.
(Ord a, Ord b) =>
GCAttributes a b -> GCAttributes a b -> GCAttributes a b
max :: GCAttributes a b -> GCAttributes a b -> GCAttributes a b
$cmax :: forall a b.
(Ord a, Ord b) =>
GCAttributes a b -> GCAttributes a b -> GCAttributes a b
>= :: GCAttributes a b -> GCAttributes a b -> Bool
$c>= :: forall a b.
(Ord a, Ord b) =>
GCAttributes a b -> GCAttributes a b -> Bool
> :: GCAttributes a b -> GCAttributes a b -> Bool
$c> :: forall a b.
(Ord a, Ord b) =>
GCAttributes a b -> GCAttributes a b -> Bool
<= :: GCAttributes a b -> GCAttributes a b -> Bool
$c<= :: forall a b.
(Ord a, Ord b) =>
GCAttributes a b -> GCAttributes a b -> Bool
< :: GCAttributes a b -> GCAttributes a b -> Bool
$c< :: forall a b.
(Ord a, Ord b) =>
GCAttributes a b -> GCAttributes a b -> Bool
compare :: GCAttributes a b -> GCAttributes a b -> Ordering
$ccompare :: forall a b.
(Ord a, Ord b) =>
GCAttributes a b -> GCAttributes a b -> Ordering
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (GCAttributes a b)
Ord, Int -> GCAttributes a b -> ShowS
[GCAttributes a b] -> ShowS
GCAttributes a b -> String
(Int -> GCAttributes a b -> ShowS)
-> (GCAttributes a b -> String)
-> ([GCAttributes a b] -> ShowS)
-> Show (GCAttributes a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> GCAttributes a b -> ShowS
forall a b. (Show a, Show b) => [GCAttributes a b] -> ShowS
forall a b. (Show a, Show b) => GCAttributes a b -> String
showList :: [GCAttributes a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [GCAttributes a b] -> ShowS
show :: GCAttributes a b -> String
$cshow :: forall a b. (Show a, Show b) => GCAttributes a b -> String
showsPrec :: Int -> GCAttributes a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> GCAttributes a b -> ShowS
Show, ReadPrec [GCAttributes a b]
ReadPrec (GCAttributes a b)
Int -> ReadS (GCAttributes a b)
ReadS [GCAttributes a b]
(Int -> ReadS (GCAttributes a b))
-> ReadS [GCAttributes a b]
-> ReadPrec (GCAttributes a b)
-> ReadPrec [GCAttributes a b]
-> Read (GCAttributes a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b. (Read a, Read b) => ReadPrec [GCAttributes a b]
forall a b. (Read a, Read b) => ReadPrec (GCAttributes a b)
forall a b. (Read a, Read b) => Int -> ReadS (GCAttributes a b)
forall a b. (Read a, Read b) => ReadS [GCAttributes a b]
readListPrec :: ReadPrec [GCAttributes a b]
$creadListPrec :: forall a b. (Read a, Read b) => ReadPrec [GCAttributes a b]
readPrec :: ReadPrec (GCAttributes a b)
$creadPrec :: forall a b. (Read a, Read b) => ReadPrec (GCAttributes a b)
readList :: ReadS [GCAttributes a b]
$creadList :: forall a b. (Read a, Read b) => ReadS [GCAttributes a b]
readsPrec :: Int -> ReadS (GCAttributes a b)
$creadsPrec :: forall a b. (Read a, Read b) => Int -> ReadS (GCAttributes a b)
Read)

type GCAttributeList = [GCAttributes Pixel FontId]

--invertGCattrs = invertColorGCattrs white black

invertColorGCattrs :: Pixel -> Pixel -> [GCAttributes Pixel b]
invertColorGCattrs Pixel
bgcol Pixel
fgcol =
    [GCFunction -> GCAttributes Pixel b
forall a b. GCFunction -> GCAttributes a b
GCFunction GCFunction
GXxor, Pixel -> GCAttributes Pixel b
forall a b. a -> GCAttributes a b
GCForeground (Pixel -> Pixel -> Pixel
invcol Pixel
bgcol Pixel
fgcol)]

invcol :: Pixel -> Pixel -> Pixel
invcol (Pixel Word
bg) (Pixel Word
fg) = Word -> Pixel
Pixel (Word -> Word -> Word
forall a. Bits a => a -> a -> a
bitXor Word
bg Word
fg)

data WindowAttributes
  = CWEventMask [EventMask]
  | CWBackingStore BackingStore
  | CWSaveUnder Bool
  | CWDontPropagate [EventMask]
  | CWOverrideRedirect Bool
  | CWBackPixel Pixel
  | CWCursor CursorId
  | CWBitGravity Gravity
  | CWWinGravity Gravity
  | CWBackPixmap PixmapId
  | CWBorderPixmap PixmapId
  | CWBorderPixel Pixel
  deriving (WindowAttributes -> WindowAttributes -> Bool
(WindowAttributes -> WindowAttributes -> Bool)
-> (WindowAttributes -> WindowAttributes -> Bool)
-> Eq WindowAttributes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowAttributes -> WindowAttributes -> Bool
$c/= :: WindowAttributes -> WindowAttributes -> Bool
== :: WindowAttributes -> WindowAttributes -> Bool
$c== :: WindowAttributes -> WindowAttributes -> Bool
Eq, Eq WindowAttributes
Eq WindowAttributes
-> (WindowAttributes -> WindowAttributes -> Ordering)
-> (WindowAttributes -> WindowAttributes -> Bool)
-> (WindowAttributes -> WindowAttributes -> Bool)
-> (WindowAttributes -> WindowAttributes -> Bool)
-> (WindowAttributes -> WindowAttributes -> Bool)
-> (WindowAttributes -> WindowAttributes -> WindowAttributes)
-> (WindowAttributes -> WindowAttributes -> WindowAttributes)
-> Ord WindowAttributes
WindowAttributes -> WindowAttributes -> Bool
WindowAttributes -> WindowAttributes -> Ordering
WindowAttributes -> WindowAttributes -> WindowAttributes
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 :: WindowAttributes -> WindowAttributes -> WindowAttributes
$cmin :: WindowAttributes -> WindowAttributes -> WindowAttributes
max :: WindowAttributes -> WindowAttributes -> WindowAttributes
$cmax :: WindowAttributes -> WindowAttributes -> WindowAttributes
>= :: WindowAttributes -> WindowAttributes -> Bool
$c>= :: WindowAttributes -> WindowAttributes -> Bool
> :: WindowAttributes -> WindowAttributes -> Bool
$c> :: WindowAttributes -> WindowAttributes -> Bool
<= :: WindowAttributes -> WindowAttributes -> Bool
$c<= :: WindowAttributes -> WindowAttributes -> Bool
< :: WindowAttributes -> WindowAttributes -> Bool
$c< :: WindowAttributes -> WindowAttributes -> Bool
compare :: WindowAttributes -> WindowAttributes -> Ordering
$ccompare :: WindowAttributes -> WindowAttributes -> Ordering
$cp1Ord :: Eq WindowAttributes
Ord, Int -> WindowAttributes -> ShowS
[WindowAttributes] -> ShowS
WindowAttributes -> String
(Int -> WindowAttributes -> ShowS)
-> (WindowAttributes -> String)
-> ([WindowAttributes] -> ShowS)
-> Show WindowAttributes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WindowAttributes] -> ShowS
$cshowList :: [WindowAttributes] -> ShowS
show :: WindowAttributes -> String
$cshow :: WindowAttributes -> String
showsPrec :: Int -> WindowAttributes -> ShowS
$cshowsPrec :: Int -> WindowAttributes -> ShowS
Show, ReadPrec [WindowAttributes]
ReadPrec WindowAttributes
Int -> ReadS WindowAttributes
ReadS [WindowAttributes]
(Int -> ReadS WindowAttributes)
-> ReadS [WindowAttributes]
-> ReadPrec WindowAttributes
-> ReadPrec [WindowAttributes]
-> Read WindowAttributes
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WindowAttributes]
$creadListPrec :: ReadPrec [WindowAttributes]
readPrec :: ReadPrec WindowAttributes
$creadPrec :: ReadPrec WindowAttributes
readList :: ReadS [WindowAttributes]
$creadList :: ReadS [WindowAttributes]
readsPrec :: Int -> ReadS WindowAttributes
$creadsPrec :: Int -> ReadS WindowAttributes
Read)

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

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


-- DBE (double buffering extension):
data SwapAction
  = DbeUndefined | DbeBackground | DbeUntouched | DbeCopied
  deriving (SwapAction -> SwapAction -> Bool
(SwapAction -> SwapAction -> Bool)
-> (SwapAction -> SwapAction -> Bool) -> Eq SwapAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SwapAction -> SwapAction -> Bool
$c/= :: SwapAction -> SwapAction -> Bool
== :: SwapAction -> SwapAction -> Bool
$c== :: SwapAction -> SwapAction -> Bool
Eq, Eq SwapAction
Eq SwapAction
-> (SwapAction -> SwapAction -> Ordering)
-> (SwapAction -> SwapAction -> Bool)
-> (SwapAction -> SwapAction -> Bool)
-> (SwapAction -> SwapAction -> Bool)
-> (SwapAction -> SwapAction -> Bool)
-> (SwapAction -> SwapAction -> SwapAction)
-> (SwapAction -> SwapAction -> SwapAction)
-> Ord SwapAction
SwapAction -> SwapAction -> Bool
SwapAction -> SwapAction -> Ordering
SwapAction -> SwapAction -> SwapAction
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 :: SwapAction -> SwapAction -> SwapAction
$cmin :: SwapAction -> SwapAction -> SwapAction
max :: SwapAction -> SwapAction -> SwapAction
$cmax :: SwapAction -> SwapAction -> SwapAction
>= :: SwapAction -> SwapAction -> Bool
$c>= :: SwapAction -> SwapAction -> Bool
> :: SwapAction -> SwapAction -> Bool
$c> :: SwapAction -> SwapAction -> Bool
<= :: SwapAction -> SwapAction -> Bool
$c<= :: SwapAction -> SwapAction -> Bool
< :: SwapAction -> SwapAction -> Bool
$c< :: SwapAction -> SwapAction -> Bool
compare :: SwapAction -> SwapAction -> Ordering
$ccompare :: SwapAction -> SwapAction -> Ordering
$cp1Ord :: Eq SwapAction
Ord, Int -> SwapAction -> ShowS
[SwapAction] -> ShowS
SwapAction -> String
(Int -> SwapAction -> ShowS)
-> (SwapAction -> String)
-> ([SwapAction] -> ShowS)
-> Show SwapAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SwapAction] -> ShowS
$cshowList :: [SwapAction] -> ShowS
show :: SwapAction -> String
$cshow :: SwapAction -> String
showsPrec :: Int -> SwapAction -> ShowS
$cshowsPrec :: Int -> SwapAction -> ShowS
Show, ReadPrec [SwapAction]
ReadPrec SwapAction
Int -> ReadS SwapAction
ReadS [SwapAction]
(Int -> ReadS SwapAction)
-> ReadS [SwapAction]
-> ReadPrec SwapAction
-> ReadPrec [SwapAction]
-> Read SwapAction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SwapAction]
$creadListPrec :: ReadPrec [SwapAction]
readPrec :: ReadPrec SwapAction
$creadPrec :: ReadPrec SwapAction
readList :: ReadS [SwapAction]
$creadList :: ReadS [SwapAction]
readsPrec :: Int -> ReadS SwapAction
$creadsPrec :: Int -> ReadS SwapAction
Read, SwapAction
SwapAction -> SwapAction -> Bounded SwapAction
forall a. a -> a -> Bounded a
maxBound :: SwapAction
$cmaxBound :: SwapAction
minBound :: SwapAction
$cminBound :: SwapAction
Bounded, Int -> SwapAction
SwapAction -> Int
SwapAction -> [SwapAction]
SwapAction -> SwapAction
SwapAction -> SwapAction -> [SwapAction]
SwapAction -> SwapAction -> SwapAction -> [SwapAction]
(SwapAction -> SwapAction)
-> (SwapAction -> SwapAction)
-> (Int -> SwapAction)
-> (SwapAction -> Int)
-> (SwapAction -> [SwapAction])
-> (SwapAction -> SwapAction -> [SwapAction])
-> (SwapAction -> SwapAction -> [SwapAction])
-> (SwapAction -> SwapAction -> SwapAction -> [SwapAction])
-> Enum SwapAction
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 :: SwapAction -> SwapAction -> SwapAction -> [SwapAction]
$cenumFromThenTo :: SwapAction -> SwapAction -> SwapAction -> [SwapAction]
enumFromTo :: SwapAction -> SwapAction -> [SwapAction]
$cenumFromTo :: SwapAction -> SwapAction -> [SwapAction]
enumFromThen :: SwapAction -> SwapAction -> [SwapAction]
$cenumFromThen :: SwapAction -> SwapAction -> [SwapAction]
enumFrom :: SwapAction -> [SwapAction]
$cenumFrom :: SwapAction -> [SwapAction]
fromEnum :: SwapAction -> Int
$cfromEnum :: SwapAction -> Int
toEnum :: Int -> SwapAction
$ctoEnum :: Int -> SwapAction
pred :: SwapAction -> SwapAction
$cpred :: SwapAction -> SwapAction
succ :: SwapAction -> SwapAction
$csucc :: SwapAction -> SwapAction
Enum)