module Xtypes(module Xtypes,module T) where
--import Geometry(Size, Point)
import EventMask as T
import AuxTypes as T
import ResourceIds as T
import Bitmap as T
import Data.Ix
import Data.Bits(xor)
import Data.Word(Word)

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

newtype Display = Display Int deriving (Eq, Ord, Show, Read)
type XDisplay = Display

noDisplay = Display (-1)

type KeyLookup = String
type Width = Int

newtype Pixel = Pixel Word deriving (Eq, Ord, Show, Read)

type PlaneMask = Pixel

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

data RGB = RGB Int Int Int deriving ( Eq, Ord, Show, Read, Ix )
data Color = Color { colorPixel::Pixel, colorRGB::RGB }
             deriving (Eq, Ord, Show, Read)

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

data Selection = Selection Atom Atom Atom  deriving (Eq, Ord, Show, Read)


newtype PropertyMode = PropertyMode Int deriving (Eq, Ord, Show, Read)

propModeReplace = PropertyMode 0
propModePrepend = PropertyMode 1
propModeAppend  = PropertyMode 2

--data EventMask -- moved to EventMask.hs

data BackingStore
  = NotUseful | WhenMapped | Always 
  deriving (Eq, Ord, Show, Read, Bounded, Enum)

data GrabPointerResult
  = GrabSuccess
  | AlreadyGrabbed
  | GrabInvalidTime
  | GrabNotViewable
  | GrabFrozen 
  deriving (Eq, Ord, Show, Read, Bounded, 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 (Eq, Ord, Show, Read, Bounded, Enum)


data CoordMode = CoordModeOrigin | CoordModePrevious 
  deriving (Eq, Ord, Show, Read, Bounded, Enum)

data Shape = Complex | Nonconvex | Convex
  deriving (Eq, Ord, Show, Read, Bounded, Enum)


-- Same order as in X.h
data GCLineStyle = LineSolid | LineOnOffDash | LineDoubleDash 
  deriving (Eq, Ord, Show, Read, Bounded, Enum)

data GCCapStyle = CapNotLast | CapButt | CapRound | CapProjecting 
  deriving (Eq, Ord, Show, Read, Bounded, Enum)

data GCJoinStyle = JoinMiter | JoinRound | JoinBevel
  deriving (Eq, Ord, Show, Read, Bounded, Enum)
  
data GCSubwindowMode = ClipByChildren | IncludeInferiors 
  deriving (Eq, Ord, Show, Read, Bounded, Enum)

data GCFillStyle = FillSolid | FillTiled | FillStippled | FillOpaqueStippled
  deriving (Eq, Ord, Show, Read, Bounded, Enum)

data GCArcMode = ArcChord | ArcPieSlice
  deriving (Eq, Ord, Show, Read, Bounded, 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
  | GCArcMode GCArcMode
  deriving (Eq, Ord, Show, Read)

type GCAttributeList = [GCAttributes Pixel FontId]

--invertGCattrs = invertColorGCattrs white black

invertColorGCattrs bgcol fgcol =
    [GCFunction GXxor, GCForeground (invcol bgcol fgcol)]

invcol (Pixel bg) (Pixel fg) = Pixel (xor bg 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 (Eq, Ord, Show, Read)

data WindowChanges
  = CWX Int
  | CWY Int
  | CWWidth Int
  | CWHeight Int
  | CWBorderWidth Int
  | CWStackMode StackMode 
  deriving (Eq, Ord, Show, Read)

data StackMode
  = StackAbove | StackBelow | TopIf | BottomIf | Opposite 
  deriving (Eq, Ord, Read, Show, Bounded, Enum)

getBWidth cws = case cws of
   [] -> Nothing
   CWBorderWidth bw':_ -> Just bw'
   _:cws -> getBWidth cws

-- DBE (double buffering extension):
data SwapAction
  = DbeUndefined | DbeBackground | DbeUntouched | DbeCopied
  deriving (Eq, Ord, Show, Read, Bounded, Enum)

--------------------------------------------------------------------------------

newtype ImageFormat = ImageFormat Int deriving (Eq, Ord, Read, Show)

xyBitmap = ImageFormat 0
xyPixmap = ImageFormat 1
zPixmap  = ImageFormat 2

--------------------------------------------------------------------------------

type BitmapData = Bitmap [Int]

data BitmapReturn = BitmapBad | BitmapReturn (Bitmap PixmapId)
  deriving (Eq, Ord, Show, Read)

--------------------------------------------------------------------------------

data CharStruct = CharStruct {char_lbearing, char_rbearing,
                              char_width, char_ascent, char_descent :: !Int}
		  deriving (Eq, Ord, Show, Read)

data FontDirection = FontLeftToRight | FontRightToLeft 
                     deriving (Eq, Ord, Show, Read, Enum)

data FontProp = FontProp Atom Int deriving (Eq, Ord, Show, Read)

-- Only 8-bit characters and 2-byte matrixes. See fsl2fs too!
type FontStructList = FontStructF [CharStruct]
data FontStructF per_char =
    FontStruct {font_id :: FontId,
                font_dir :: FontDirection,
                first_char, last_char :: !Char,
                font_complete :: !Bool, -- all chars exist
                default_char :: !Char,
                font_prop :: [FontProp],
                max_bounds, min_bounds :: !CharStruct,
                per_char :: Maybe per_char,
                font_ascent, font_descent :: !Int
                  -- ^ logical extent above/below baseline for spacing
               }
    deriving (Eq, Ord, Show, Read)
{-
font_id      (FontStruct fid fd fc lc all' dc fps minb maxb ca asc de) = fid
font_ascent  (FontStruct fid fd fc lc all' dc fps minb maxb ca asc de) = asc
font_descent (FontStruct fid fd fc lc all' dc fps minb maxb ca asc de) = de
per_char     (FontStruct fid fd fc lc all' dc fps minb maxb ca asc de) = ca
max_bounds   (FontStruct fid fd fc lc all' dc fps minb maxb ca asc de) = maxb
min_bounds   (FontStruct fid fd fc lc all' dc fps minb maxb ca asc de) = minb
font_range   (FontStruct fid fd fc lc all' dc fps minb maxb ca asc de) = (fc,lc)
default_char (FontStruct fid fd fc lc all' dc fps minb maxb ca asc de) = dc
font_prop    (FontStruct fid fd fc lc all' dc fps minb maxb ca asc de) = fps
-}