-- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./GI/Cairo/Render/Types.chs" #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DataKinds, TypeFamilies #-}
{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  GI.Cairo.Render.Types
-- Copyright   :  (c) Paolo Martini 2005
-- License     :  BSD-style (see cairo/COPYRIGHT)
--
-- Maintainer  :  p.martini@neuralnoise.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Haskell bindings to the cairo types.
-----------------------------------------------------------------------------



-- #hide
module GI.Cairo.Render.Types (
    PixelData
  , Matrix(Matrix), MatrixPtr
  , Cairo(Cairo), CairoPtr, unCairo
  , Surface(Surface), SurfacePtr, withSurface, mkSurface, manageSurface
  , Pattern(Pattern), unPattern
  , Status(..)
  , Operator(..)
  , Antialias(..)
  , FillRule(..)
  , LineCap(..)
  , LineJoin(..)
  , ScaledFont(..), unScaledFont
  , FontFace(..), unFontFace
  , Glyph, unGlyph
  , TextExtentsPtr
  , TextExtents(..)
  , FontExtentsPtr
  , FontExtents(..)
  , FontSlant(..)
  , FontWeight(..)
  , SubpixelOrder(..)
  , HintStyle(..)
  , HintMetrics(..)
  , FontOptions(..), FontOptionsPtr, withFontOptions, mkFontOptions
  , Path(..), unPath
  , RectangleInt(..), RectangleIntPtr
  , RegionOverlap(..)
  , Region(..), RegionPtr, withRegion, mkRegion
  , Content(..)
  , Format(..)
  , Extend(..)
  , Filter(..)

  , cIntConv
  , cFloatConv
  , cFromBool
  , cToBool
  , cToEnum
  , cFromEnum
  , peekFloatConv
  , withFloatConv

  ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp



import GI.Cairo.Render.Matrix
{-# LINE 67 "./GI/Cairo/Render/Types.chs" #-}


import Data.GI.Base.Overloading (ParentTypes, HasParentTypes)
import Data.GI.Base (ManagedPtr, TypedObject(..), GType(..), GBoxed(..))
import Foreign hiding (rotate)
import Foreign.C

import Control.Monad (liftM)


{-# LINE 76 "./GI/Cairo/Render/Types.chs" #-}


type PixelData = Ptr CUChar

foreign import ccall "cairo_gobject_context_get_type" 
  c_cairo_gobject_context_get_type :: IO GType

-- not visible
newtype Cairo = Cairo (ManagedPtr Cairo)
type CairoPtr = C2HSImp.Ptr (Cairo)
{-# LINE 85 "./GI/Cairo/Render/Types.chs" #-}

unCairo (Cairo x) = x

type instance ParentTypes Cairo = '[]
instance HasParentTypes Cairo

instance TypedObject Cairo where
  glibType :: IO GType
glibType = IO GType
c_cairo_gobject_context_get_type

instance GBoxed Cairo

-- | The medium to draw on.
newtype Surface = Surface { Surface -> ForeignPtr Surface
unSurface :: ForeignPtr Surface }
type SurfacePtr = C2HSImp.Ptr (Surface)
{-# LINE 98 "./GI/Cairo/Render/Types.chs" #-}

withSurface = withForeignPtr . unSurface 

mkSurface :: Ptr Surface -> IO Surface
mkSurface :: Ptr Surface -> IO Surface
mkSurface Ptr Surface
surfacePtr = do
  ForeignPtr Surface
surfaceForeignPtr <- Ptr Surface -> IO (ForeignPtr Surface)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr Surface
surfacePtr
  Surface -> IO Surface
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Surface -> Surface
Surface ForeignPtr Surface
surfaceForeignPtr)

manageSurface :: Surface -> IO ()
manageSurface :: Surface -> IO ()
manageSurface (Surface ForeignPtr Surface
surfaceForeignPtr) = do
  FinalizerPtr Surface -> ForeignPtr Surface -> IO ()
forall a. FinalizerPtr a -> ForeignPtr a -> IO ()
addForeignPtrFinalizer FinalizerPtr Surface
surfaceDestroy ForeignPtr Surface
surfaceForeignPtr

foreign import ccall unsafe "&cairo_surface_destroy"
  surfaceDestroy :: FinalizerPtr Surface

-- | Patterns can be simple solid colors, various kinds of gradients or
-- bitmaps. The current pattern for a 'Render' context is used by the 'stroke',
-- 'fill' and paint operations. These operations composite the current pattern
-- with the target surface using the currently selected 'Operator'.
--
newtype Pattern = Pattern (C2HSImp.Ptr (Pattern))
{-# LINE 118 "./GI/Cairo/Render/Types.chs" #-}

unPattern (Pattern x) = x

-- | Cairo status.
--
-- * 'Status' is used to indicate errors that can occur when using
--   Cairo. In some cases it is returned directly by functions. When using
--   'GI.Cairo.Render.Render', the last error, if any, is stored
--   in the monad and can be retrieved with 'GI.Cairo.Render.status'.
--
data Status = StatusSuccess
            | StatusNoMemory
            | StatusInvalidRestore
            | StatusInvalidPopGroup
            | StatusNoCurrentPoint
            | StatusInvalidMatrix
            | StatusInvalidStatus
            | StatusNullPointer
            | StatusInvalidString
            | StatusInvalidPathData
            | StatusReadError
            | StatusWriteError
            | StatusSurfaceFinished
            | StatusSurfaceTypeMismatch
            | StatusPatternTypeMismatch
            | StatusInvalidContent
            | StatusInvalidFormat
            | StatusInvalidVisual
            | StatusFileNotFound
            | StatusInvalidDash
            | StatusInvalidDscComment
            | StatusInvalidIndex
            | StatusClipNotRepresentable
            | StatusTempFileError
            | StatusInvalidStride
            | StatusFontTypeMismatch
            | StatusUserFontImmutable
            | StatusUserFontError
            | StatusNegativeCount
            | StatusInvalidClusters
            | StatusInvalidSlant
            | StatusInvalidWeight
            | StatusInvalidSize
            | StatusUserFontNotImplemented
            | StatusDeviceTypeMismatch
            | StatusDeviceError
            | StatusInvalidMeshConstruction
            | StatusDeviceFinished
            | StatusJbig2GlobalMissing
            | StatusPngError
            | StatusFreetypeError
            | StatusWin32GdiError
            | StatusTagError
            | StatusDwriteError
            | StatusSvgFontError
            | StatusLastStatus
  deriving (Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
/= :: Status -> Status -> Bool
Eq,Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Status -> ShowS
showsPrec :: Int -> Status -> ShowS
$cshow :: Status -> String
show :: Status -> String
$cshowList :: [Status] -> ShowS
showList :: [Status] -> ShowS
Show)
instance Enum Status where
  succ :: Status -> Status
succ Status
StatusSuccess = Status
StatusNoMemory
  succ Status
StatusNoMemory = Status
StatusInvalidRestore
  succ Status
StatusInvalidRestore = Status
StatusInvalidPopGroup
  succ Status
StatusInvalidPopGroup = Status
StatusNoCurrentPoint
  succ Status
StatusNoCurrentPoint = Status
StatusInvalidMatrix
  succ StatusInvalidMatrix = StatusInvalidStatus
  succ StatusInvalidStatus = StatusNullPointer
  succ StatusNullPointer = StatusInvalidString
  succ StatusInvalidString = StatusInvalidPathData
  succ StatusInvalidPathData = StatusReadError
  succ StatusReadError = StatusWriteError
  succ StatusWriteError = StatusSurfaceFinished
  succ StatusSurfaceFinished = StatusSurfaceTypeMismatch
  succ Status
StatusSurfaceTypeMismatch = Status
StatusPatternTypeMismatch
  succ StatusPatternTypeMismatch = StatusInvalidContent
  succ Status
StatusInvalidContent = Status
StatusInvalidFormat
  succ Status
StatusInvalidFormat = Status
StatusInvalidVisual
  succ StatusInvalidVisual = StatusFileNotFound
  succ Status
StatusFileNotFound = Status
StatusInvalidDash
  succ Status
StatusInvalidDash = Status
StatusInvalidDscComment
  succ StatusInvalidDscComment = StatusInvalidIndex
  succ Status
StatusInvalidIndex = Status
StatusClipNotRepresentable
  succ StatusClipNotRepresentable = StatusTempFileError
  succ StatusTempFileError = StatusInvalidStride
  succ StatusInvalidStride = StatusFontTypeMismatch
  succ StatusFontTypeMismatch = StatusUserFontImmutable
  succ StatusUserFontImmutable = StatusUserFontError
  succ StatusUserFontError = StatusNegativeCount
  succ StatusNegativeCount = StatusInvalidClusters
  succ StatusInvalidClusters = StatusInvalidSlant
  succ StatusInvalidSlant = StatusInvalidWeight
  succ Status
StatusInvalidWeight = Status
StatusInvalidSize
  succ Status
StatusInvalidSize = Status
StatusUserFontNotImplemented
  succ Status
StatusUserFontNotImplemented = Status
StatusDeviceTypeMismatch
  succ StatusDeviceTypeMismatch = Status
StatusDeviceError
  peek :: Ptr TextExtents -> IO TextExtents
succ Status
StatusDeviceError = Status
StatusInvalidMeshConstruction
  succ Status
StatusInvalidMeshConstruction = Status
StatusDeviceFinished
  succ Status
StatusDeviceFinished = Status
StatusJbig2GlobalMissing
  succ Status
StatusJbig2GlobalMissing = Status
StatusPngError
  succ Status
StatusPngError = Status
StatusFreetypeError
  succ Status
StatusFreetypeError = Status
StatusWin32GdiError
  succ Status
StatusWin32GdiError = Status
StatusTagError
  succ Status
StatusTagError = Status
StatusDwriteError
  succ StatusDwriteError = StatusSvgFontError
  succ Status
StatusSvgFontError = Status
StatusLastStatus
  succ Status
StatusLastStatus = String -> Status
forall a. HasCallStack => String -> a
error String
"Status.succ: StatusLastStatus has no successor"

  pred StatusNoMemory = StatusSuccess
  pred StatusInvalidRestore = StatusNoMemory
  pred StatusInvalidPopGroup = StatusInvalidRestore
  pred StatusNoCurrentPoint = StatusInvalidPopGroup
  pred StatusInvalidMatrix = StatusNoCurrentPoint
  pred StatusInvalidStatus = StatusInvalidMatrix
  pred StatusNullPointer = StatusInvalidStatus
  pred StatusInvalidString = StatusNullPointer
  pred StatusInvalidPathData = StatusInvalidString
  pred StatusReadError = StatusInvalidPathData
  pred StatusWriteError = StatusReadError
  pred StatusSurfaceFinished = StatusWriteError
  pred StatusSurfaceTypeMismatch = StatusSurfaceFinished
  pred StatusPatternTypeMismatch = StatusSurfaceTypeMismatch
  pred StatusInvalidContent = StatusPatternTypeMismatch
  pred StatusInvalidFormat = StatusInvalidContent
  pred StatusInvalidVisual = StatusInvalidFormat
  pred StatusFileNotFound = StatusInvalidVisual
  pred StatusInvalidDash = StatusFileNotFound
  pred StatusInvalidDscComment = StatusInvalidDash
  pred StatusInvalidIndex = StatusInvalidDscComment
  pred StatusClipNotRepresentable = StatusInvalidIndex
  pred StatusTempFileError = StatusClipNotRepresentable
  pred StatusInvalidStride = StatusTempFileError
  pred StatusFontTypeMismatch = StatusInvalidStride
  pred StatusUserFontImmutable = StatusFontTypeMismatch
  pred StatusUserFontError = StatusUserFontImmutable
  pred StatusNegativeCount = StatusUserFontError
  pred StatusInvalidClusters = StatusNegativeCount
  pred StatusInvalidSlant = StatusInvalidClusters
  pred StatusInvalidWeight = StatusInvalidSlant
  pred StatusInvalidSize = StatusInvalidWeight
  pred StatusUserFontNotImplemented = StatusInvalidSize
  pred StatusDeviceTypeMismatch = StatusUserFontNotImplemented
  pred StatusDeviceError = StatusDeviceTypeMismatch
  pred StatusInvalidMeshConstruction = StatusDeviceError
  pred StatusDeviceFinished = StatusInvalidMeshConstruction
  pred StatusJbig2GlobalMissing = StatusDeviceFinished
  pred StatusPngError = StatusJbig2GlobalMissing
  pred StatusFreetypeError = StatusPngError
  pred StatusWin32GdiError = StatusFreetypeError
  pred StatusTagError = StatusWin32GdiError
  pred StatusDwriteError = StatusTagError
  pred StatusSvgFontError = StatusDwriteError
  pred StatusLastStatus = StatusSvgFontError
  pred StatusSuccess = error "Status.pred: StatusSuccess has no predecessor"

  enumFromTo :: Status -> Status -> [Status]
enumFromTo Status
from Status
to = Status -> [Status]
go Status
from
    where
      end :: Int
end = Status -> Int
forall a. Enum a => a -> Int
fromEnum Status
to
      go :: Status -> [Status]
go Status
v = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Status -> Int
forall a. Enum a => a -> Int
fromEnum Status
v) Int
end of
                 Ordering
LT -> Status
v Status -> [Status] -> [Status]
forall a. a -> [a] -> [a]
: Status -> [Status]
go (Status -> Status
forall a. Enum a => a -> a
succ Status
v)
                 Ordering
EQ -> [Status
v]
                 Ordering
GT -> []

  enumFrom :: Status -> [Status]
enumFrom Status
from = Status -> Status -> [Status]
forall a. Enum a => a -> a -> [a]
enumFromTo Status
from Status
StatusLastStatus

  fromEnum :: Status -> Int
fromEnum Status
StatusSuccess = Int
0
  fromEnum Status
StatusNoMemory = Int
1
  fromEnum Status
StatusInvalidRestore = Int
2
  fromEnum Status
StatusInvalidPopGroup = Int
3
  fromEnum Status
StatusNoCurrentPoint = Int
4
  fromEnum StatusInvalidMatrix = 5
  fromEnum StatusInvalidStatus = 6
  fromEnum StatusNullPointer = 7
  fromEnum StatusInvalidString = 8
  fromEnum StatusInvalidPathData = 9
  fromEnum StatusReadError = 10
  fromEnum Status
StatusWriteError = Int
11
  fromEnum Status
StatusSurfaceFinished = Int
12
  fromEnum Status
StatusSurfaceTypeMismatch = Int
13
  fromEnum Status
StatusPatternTypeMismatch = Int
14
  fromEnum Status
StatusInvalidContent = Int
15
  fromEnum Status
StatusInvalidFormat = Int
16
  fromEnum Status
StatusInvalidVisual = Int
17
  fromEnum Status
StatusFileNotFound = Int
18
  fromEnum Status
StatusInvalidDash = Int
19
  fromEnum Status
StatusInvalidDscComment = Int
20
  fromEnum Status
StatusInvalidIndex = Int
21
  fromEnum Status
StatusClipNotRepresentable = Int
22
  fromEnum Status
StatusTempFileError = Int
23
  fromEnum Status
StatusInvalidStride = Int
24
  fromEnum Status
StatusFontTypeMismatch = Int
25
  fromEnum Status
StatusUserFontImmutable = Int
26
  fromEnum Status
StatusUserFontError = Int
27
  fromEnum StatusNegativeCount = 28
  fromEnum StatusInvalidClusters = 29
  fromEnum StatusInvalidSlant = 30
  fromEnum StatusInvalidWeight = 31
  fromEnum StatusInvalidSize = 32
  fromEnum StatusUserFontNotImplemented = 33
  fromEnum Status
StatusDeviceTypeMismatch = Int
34
  fromEnum Status
StatusDeviceError = Int
35
  fromEnum Status
StatusInvalidMeshConstruction = Int
36
  fromEnum Status
StatusDeviceFinished = Int
37
  fromEnum Status
StatusJbig2GlobalMissing = Int
38
  fromEnum Status
StatusPngError = Int
39
  fromEnum Status
StatusFreetypeError = Int
40
  fromEnum Status
StatusWin32GdiError = Int
41
  fromEnum Status
StatusTagError = Int
42
  fromEnum Status
StatusDwriteError = Int
43
  fromEnum Status
StatusSvgFontError = Int
44
  fromEnum Status
StatusLastStatus = Int
45

  toEnum :: Int -> Status
toEnum Int
0 = Status
StatusSuccess
  toEnum Int
1 = Status
StatusNoMemory
  toEnum 2 = StatusInvalidRestore
  toEnum Int
3 = Status
StatusInvalidPopGroup
  toEnum 4 = StatusNoCurrentPoint
  toEnum Int
5 = Status
StatusInvalidMatrix
  toEnum 6 = StatusInvalidStatus
  toEnum 7 = StatusNullPointer
  toEnum 8 = StatusInvalidString
  toEnum 9 = StatusInvalidPathData
  toEnum Int
10 = Status
StatusReadError
  toEnum 11 = StatusWriteError
  toEnum 12 = StatusSurfaceFinished
  toEnum Int
13 = Status
StatusSurfaceTypeMismatch
  toEnum Int
14 = Status
StatusPatternTypeMismatch
  toEnum Int
15 = Status
StatusInvalidContent
  toEnum Int
16 = Status
StatusInvalidFormat
  toEnum Int
17 = Status
StatusInvalidVisual
  toEnum Int
18 = Status
StatusFileNotFound
  toEnum Int
19 = Status
StatusInvalidDash
  toEnum Int
20 = Status
StatusInvalidDscComment
  toEnum Int
21 = Status
StatusInvalidIndex
  toEnum Int
22 = Status
StatusClipNotRepresentable
  toEnum Int
23 = Status
StatusTempFileError
  toEnum Int
24 = Status
StatusInvalidStride
  toEnum Int
25 = Status
StatusFontTypeMismatch
  toEnum 26 = StatusUserFontImmutable
  toEnum 27 = StatusUserFontError
  toEnum 28 = StatusNegativeCount
  toEnum 29 = StatusInvalidClusters
  toEnum 30 = StatusInvalidSlant
  toEnum 31 = StatusInvalidWeight
  toEnum Int
32 = Status
StatusInvalidSize
  toEnum 33 = StatusUserFontNotImplemented
  toEnum Int
34 = Status
StatusDeviceTypeMismatch
  toEnum Int
35 = Status
StatusDeviceError
  toEnum Int
36 = Status
StatusInvalidMeshConstruction
  toEnum 37 = StatusDeviceFinished
  toEnum Int
38 = Status
StatusJbig2GlobalMissing
  toEnum Int
39 = Status
StatusPngError
  toEnum 40 = StatusFreetypeError
  toEnum 41 = StatusWin32GdiError
  toEnum 42 = StatusTagError
  toEnum 43 = StatusDwriteError
  toEnum 44 = StatusSvgFontError
  toEnum 45 = StatusLastStatus
  toEnum unmatched = error ("Status.toEnum: Cannot match " ++ show unmatched)

{-# LINE 128 "./GI/Cairo/Render/Types.chs" #-}


-- | Composition operator for all drawing operations.
--
data Operator = OperatorClear
              | OperatorSource
              | OperatorOver
              | OperatorIn
              | OperatorOut
              | OperatorAtop
              | OperatorDest
              | OperatorDestOver
              | OperatorDestIn
              | OperatorDestOut
              | OperatorDestAtop
              | OperatorXor
              | OperatorAdd
              | OperatorSaturate
              | OperatorMultiply
              | OperatorScreen
              | OperatorOverlay
              | OperatorDarken
              | OperatorLighten
              | OperatorColorDodge
              | OperatorColorBurn
              | OperatorHardLight
              | OperatorSoftLight
              | OperatorDifference
              | OperatorExclusion
              | OperatorHslHue
              | OperatorHslSaturation
              | OperatorHslColor
              | OperatorHslLuminosity
  deriving (Enum,Eq,Show)

{-# LINE 132 "./GI/Cairo/Render/Types.chs" #-}


-- | Specifies the type of antialiasing to do when rendering text or shapes
--
-- ['AntialiasDefault']  Use the default antialiasing for the subsystem
-- and target device.
--
-- ['AntialiasNone']  Use a bilevel alpha mask.
--
-- ['AntialiasGray']  Perform single-color antialiasing (using shades of
-- gray for black text on a white background, for example).
--
-- ['AntialiasSubpixel']  Perform antialiasing by taking advantage of
-- the order of subpixel elements on devices such as LCD panels.
--
data Antialias = AntialiasDefault
               | AntialiasNone
               | AntialiasGray
               | AntialiasSubpixel
               | AntialiasFast
               | AntialiasGood
               | AntialiasBest
  deriving (Enum,Eq,Show)

{-# LINE 147 "./GI/Cairo/Render/Types.chs" #-}


-- | Specify how paths are filled.
--
-- * For both fill rules, whether or not a point is included in the fill is
--   determined by taking a ray from that point to infinity and looking at
--   intersections with the path. The ray can be in any direction, as long
--   as it doesn't pass through the end point of a segment or have a tricky
--   intersection such as intersecting tangent to the path. (Note that
--   filling is not actually implemented in this way. This is just a
--   description of the rule that is applied.)
--
-- ['FillRuleWinding']  If the path crosses the ray from left-to-right,
--   counts +1. If the path crosses the ray from right to left, counts -1.
--   (Left and right are determined from the perspective of looking along
--   the ray from the starting point.) If the total count is non-zero, the
--   point will be filled.
--
-- ['FillRuleEvenOdd']  Counts the total number of intersections,
--   without regard to the orientation of the contour. If the total number
--   of intersections is odd, the point will be filled.
--
data FillRule = FillRuleWinding
              | FillRuleEvenOdd
  deriving (Enum,Eq,Show)

{-# LINE 169 "./GI/Cairo/Render/Types.chs" #-}


-- | Specify line endings.
--
-- ['LineCapButt'] Start(stop) the line exactly at the start(end) point.
--
-- ['LineCapRound'] Use a round ending, the center of the circle is the
--   end point.
--
-- ['LineCapSquare'] Use squared ending, the center of the square is the
--   end point
--
data LineCap = LineCapButt
             | LineCapRound
             | LineCapSquare
  deriving (Enum,Eq,Show)

{-# LINE 181 "./GI/Cairo/Render/Types.chs" #-}


-- | Specify how lines join.
--
data LineJoin = LineJoinMiter
              | LineJoinRound
              | LineJoinBevel
  deriving (Enum,Eq,Show)

{-# LINE 185 "./GI/Cairo/Render/Types.chs" #-}


newtype ScaledFont = ScaledFont (C2HSImp.Ptr (ScaledFont))
{-# LINE 187 "./GI/Cairo/Render/Types.chs" #-}

unScaledFont (ScaledFont x) = x

newtype FontFace = FontFace (C2HSImp.Ptr (FontFace))
{-# LINE 190 "./GI/Cairo/Render/Types.chs" #-}

unFontFace (FontFace x) = x

newtype Glyph = Glyph (C2HSImp.Ptr (Glyph))
{-# LINE 193 "./GI/Cairo/Render/Types.chs" #-}

unGlyph (Glyph x) = x

type TextExtentsPtr = C2HSImp.Ptr (TextExtents)
{-# LINE 196 "./GI/Cairo/Render/Types.chs" #-}


-- | Specify the extents of a text.
data TextExtents = TextExtents {
    textExtentsXbearing :: Double
  , textExtentsYbearing :: Double
  , textExtentsWidth    :: Double
  , textExtentsHeight   :: Double
  , textExtentsXadvance :: Double
  , textExtentsYadvance :: Double
  }

instance Storable TextExtents where
  sizeOf _ = 48
{-# LINE 209 "./GI/Cairo/Render/Types.chs" #-}

  alignment _ = alignment (undefined :: CDouble)
  peek p = do
    x_bearing <- (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CDouble}) p
    y_bearing <- (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO C2HSImp.CDouble}) p
    width     <- (\ptr -> do {C2HSImp.peekByteOff ptr 16 :: IO C2HSImp.CDouble})     p
    height    <- (\ptr -> do {C2HSImp.peekByteOff ptr 24 :: IO C2HSImp.CDouble})    p
    x_advance <- (\ptr -> do {C2HSImp.peekByteOff ptr 32 :: IO C2HSImp.CDouble}) p
    y_advance <- (\ptr -> do {C2HSImp.peekByteOff ptr 40 :: IO C2HSImp.CDouble}) p
    return $ TextExtents (cFloatConv x_bearing) (cFloatConv y_bearing)
                         (cFloatConv width)     (cFloatConv height)
                         (cFloatConv x_advance) (cFloatConv y_advance)
  poke p (TextExtents x_bearing y_bearing width height x_advance y_advance) = do
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: C2HSImp.CDouble)}) p (cFloatConv x_bearing)
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: C2HSImp.CDouble)}) p (cFloatConv y_bearing)
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 16 (val :: C2HSImp.CDouble)})     p (cFloatConv width)
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 24 (val :: C2HSImp.CDouble)})    p (cFloatConv height)
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 32 (val :: C2HSImp.CDouble)}) p (cFloatConv x_advance)
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 40 (val :: C2HSImp.CDouble)}) p (cFloatConv y_advance)
    return ()

type FontExtentsPtr = C2HSImp.Ptr (FontExtents)
{-# LINE 230 "./GI/Cairo/Render/Types.chs" #-}


-- | Result of querying the font extents.
data FontExtents = FontExtents {
    fontExtentsAscent      :: Double
  , fontExtentsDescent     :: Double
  , fontExtentsHeight      :: Double
  , fontExtentsMaxXadvance :: Double
  , fontExtentsMaxYadvance :: Double
  }

instance Storable FontExtents where
  sizeOf _ = 40
{-# LINE 242 "./GI/Cairo/Render/Types.chs" #-}

  alignment _ = alignment (undefined :: CDouble)
  peek p = do
    ascent        <- (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CDouble})        p
    descent       <- (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO C2HSImp.CDouble})       p
    height        <- (\ptr -> do {C2HSImp.peekByteOff ptr 16 :: IO C2HSImp.CDouble})        p
    max_x_advance <- (\ptr -> do {C2HSImp.peekByteOff ptr 24 :: IO C2HSImp.CDouble}) p
    max_y_advance <- (\ptr -> do {C2HSImp.peekByteOff ptr 32 :: IO C2HSImp.CDouble}) p
    return $ FontExtents (cFloatConv ascent) (cFloatConv descent) (cFloatConv height)
                         (cFloatConv max_x_advance) (cFloatConv max_y_advance)
  poke p (FontExtents ascent descent height max_x_advance max_y_advance) = do
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: C2HSImp.CDouble)})        p (cFloatConv ascent)
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: C2HSImp.CDouble)})       p (cFloatConv descent)
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 16 (val :: C2HSImp.CDouble)})        p (cFloatConv height)
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 24 (val :: C2HSImp.CDouble)}) p (cFloatConv max_x_advance)
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 32 (val :: C2HSImp.CDouble)}) p (cFloatConv max_y_advance)
    return ()

-- | Specify font slant.
data FontSlant = FontSlantNormal
               | FontSlantItalic
               | FontSlantOblique
  deriving (Enum,Eq,Show)

{-# LINE 261 "./GI/Cairo/Render/Types.chs" #-}


-- | Specify font weight.
data FontWeight = FontWeightNormal
                | FontWeightBold
  deriving (Enum,Eq,Show)

{-# LINE 264 "./GI/Cairo/Render/Types.chs" #-}


-- | The subpixel order specifies the order of color elements within each pixel
-- on the display device when rendering with an antialiasing mode of
-- 'AntialiasSubpixel'.
--
-- ['SubpixelOrderDefault'] Use the default subpixel order for for the
--                          target device
--
-- ['SubpixelOrderRgb']     Subpixel elements are arranged horizontally
--                          with red at the left
--
-- ['SubpixelOrderBgr']     Subpixel elements are arranged horizontally
--                          with blue at the left
--
-- ['SubpixelOrderVrgb']    Subpixel elements are arranged vertically
--                          with red at the top
--
-- ['SubpixelOrderVbgr']    Subpixel elements are arranged vertically
--                          with blue at the top
--
data SubpixelOrder = SubpixelOrderDefault
                   | SubpixelOrderRgb
                   | SubpixelOrderBgr
                   | SubpixelOrderVrgb
                   | SubpixelOrderVbgr
  deriving (Enum,Eq,Show)

{-# LINE 285 "./GI/Cairo/Render/Types.chs" #-}


-- | Specifies the type of hinting to do on font outlines.
--
-- Hinting is the process of fitting outlines to the pixel grid in order to
-- improve the appearance of the result. Since hinting outlines involves
-- distorting them, it also reduces the faithfulness to the original outline
-- shapes. Not all of the outline hinting styles are supported by all font
-- backends.
--
-- ['HintStyleDefault']  Use the default hint style for for font backend and
--                       target device
--
-- ['HintStyleNone']     Do not hint outlines
--
-- ['HintStyleSlight']   Hint outlines slightly to improve contrast while
--                       retaining good fidelity to the original shapes.
--
-- ['HintStyleMedium']   Hint outlines with medium strength giving a compromise
--                       between fidelity to the original shapes and contrast
--
-- ['HintStyleFull']     Hint outlines to maximize contrast
--
data HintStyle = HintStyleDefault
               | HintStyleNone
               | HintStyleSlight
               | HintStyleMedium
               | HintStyleFull
  deriving (Enum)

{-# LINE 308 "./GI/Cairo/Render/Types.chs" #-}


-- | Specifies whether to hint font metrics.
--
-- Hinting font metrics means quantizing them so that they are integer values
-- in device space. Doing this improves the consistency of letter and line
-- spacing, however it also means that text will be laid out differently at
-- different zoom factors.
--
-- ['HintMetricsDefault']  Hint metrics in the default manner for the font
--                         backend and target device
--
-- ['HintMetricsOff']      Do not hint font metrics
--
-- ['HintMetricsOn']       Hint font metrics
--
--
data HintMetrics = HintMetricsDefault
                 | HintMetricsOff
                 | HintMetricsOn
  deriving (Enum,Eq,Show)

{-# LINE 325 "./GI/Cairo/Render/Types.chs" #-}


-- | Specifies how to render text.
newtype FontOptions = FontOptions { unFontOption :: ForeignPtr FontOptions }
type FontOptionsPtr = C2HSImp.Ptr (FontOptions)
{-# LINE 329 "./GI/Cairo/Render/Types.chs" #-}


withFontOptions fptr = withForeignPtr $ unFontOption fptr

mkFontOptions :: Ptr FontOptions -> IO FontOptions
mkFontOptions fontOptionsPtr = do
  fontOptionsForeignPtr <- newForeignPtr fontOptionsDestroy fontOptionsPtr
  return (FontOptions fontOptionsForeignPtr)

foreign import ccall unsafe "&cairo_font_options_destroy"
  fontOptionsDestroy :: FinalizerPtr FontOptions

-- XXX: pathToList :: Path -> [PathData]
--
-- http://cairographics.org/manual/bindings-path.html
--
-- {#enum path_data_type_t as PathDataType {underscoreToCase}#}
--
-- type Point = (Double, Double)
-- data PathData = PathMoveTo Point
--               | PathLineTo Point
--               | PathCurveTo Point Point Point
--               | PathClose

-- | A Cairo path.
--
-- * A path is a sequence of drawing operations that are accumulated until
--   'GI.Cairo.Render.stroke' is called. Using a path is particularly
--   useful when drawing lines with special join styles and
--   'GI.Cairo.Render.closePath'.
--
newtype Path = Path (C2HSImp.Ptr (Path))
{-# LINE 360 "./GI/Cairo/Render/Types.chs" #-}

unPath (Path x) = x


type RectangleIntPtr = C2HSImp.Ptr (RectangleInt)
{-# LINE 365 "./GI/Cairo/Render/Types.chs" #-}


-- | A data structure for holding a rectangle with integer coordinates.
data RectangleInt = RectangleInt {
    x      :: Int
  , y      :: Int
  , width  :: Int
  , height :: Int
  }

instance Storable RectangleInt where
  sizeOf _ = 16
{-# LINE 376 "./GI/Cairo/Render/Types.chs" #-}

  alignment _ = alignment (undefined :: CInt)
  peek p = do
    x      <- (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CInt})      p
    y      <- (\ptr -> do {C2HSImp.peekByteOff ptr 4 :: IO C2HSImp.CInt})      p
    width  <- (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO C2HSImp.CInt})  p
    height <- (\ptr -> do {C2HSImp.peekByteOff ptr 12 :: IO C2HSImp.CInt}) p
    return $ RectangleInt (fromIntegral x) (fromIntegral y) (fromIntegral width) (fromIntegral height)
  poke p (RectangleInt {..}) = do
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: C2HSImp.CInt)})      p (fromIntegral x)
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 4 (val :: C2HSImp.CInt)})      p (fromIntegral y)
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: C2HSImp.CInt)})  p (fromIntegral width)
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 12 (val :: C2HSImp.CInt)}) p (fromIntegral height)
    return ()

-- | Used as the return value for regionContainsRectangle.
data RegionOverlap = RegionOverlapIn
                   | RegionOverlapOut
                   | RegionOverlapPart
  deriving (Int -> RegionOverlap
RegionOverlap -> Int
RegionOverlap -> [RegionOverlap]
RegionOverlap -> RegionOverlap
RegionOverlap -> RegionOverlap -> [RegionOverlap]
RegionOverlap -> RegionOverlap -> RegionOverlap -> [RegionOverlap]
(RegionOverlap -> RegionOverlap)
-> (RegionOverlap -> RegionOverlap)
-> (Int -> RegionOverlap)
-> (RegionOverlap -> Int)
-> (RegionOverlap -> [RegionOverlap])
-> (RegionOverlap -> RegionOverlap -> [RegionOverlap])
-> (RegionOverlap -> RegionOverlap -> [RegionOverlap])
-> (RegionOverlap
    -> RegionOverlap -> RegionOverlap -> [RegionOverlap])
-> Enum RegionOverlap
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: RegionOverlap -> RegionOverlap
succ :: RegionOverlap -> RegionOverlap
$cpred :: RegionOverlap -> RegionOverlap
pred :: RegionOverlap -> RegionOverlap
$ctoEnum :: Int -> RegionOverlap
toEnum :: Int -> RegionOverlap
$cfromEnum :: RegionOverlap -> Int
fromEnum :: RegionOverlap -> Int
$cenumFrom :: RegionOverlap -> [RegionOverlap]
enumFrom :: RegionOverlap -> [RegionOverlap]
$cenumFromThen :: RegionOverlap -> RegionOverlap -> [RegionOverlap]
enumFromThen :: RegionOverlap -> RegionOverlap -> [RegionOverlap]
$cenumFromTo :: RegionOverlap -> RegionOverlap -> [RegionOverlap]
enumFromTo :: RegionOverlap -> RegionOverlap -> [RegionOverlap]
$cenumFromThenTo :: RegionOverlap -> RegionOverlap -> RegionOverlap -> [RegionOverlap]
enumFromThenTo :: RegionOverlap -> RegionOverlap -> RegionOverlap -> [RegionOverlap]
Enum,RegionOverlap -> RegionOverlap -> Bool
(RegionOverlap -> RegionOverlap -> Bool)
-> (RegionOverlap -> RegionOverlap -> Bool) -> Eq RegionOverlap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegionOverlap -> RegionOverlap -> Bool
== :: RegionOverlap -> RegionOverlap -> Bool
$c/= :: RegionOverlap -> RegionOverlap -> Bool
/= :: RegionOverlap -> RegionOverlap -> Bool
Eq,Int -> RegionOverlap -> ShowS
[RegionOverlap] -> ShowS
RegionOverlap -> String
(Int -> RegionOverlap -> ShowS)
-> (RegionOverlap -> String)
-> ([RegionOverlap] -> ShowS)
-> Show RegionOverlap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegionOverlap -> ShowS
showsPrec :: Int -> RegionOverlap -> ShowS
$cshow :: RegionOverlap -> String
show :: RegionOverlap -> String
$cshowList :: [RegionOverlap] -> ShowS
showList :: [RegionOverlap] -> ShowS
Show)

{-# LINE 392 "./GI/Cairo/Render/Types.chs" #-}


-- | A Cairo region. Represents a set of integer-aligned rectangles.
--
-- It allows set-theoretical operations like regionUnion and regionIntersect to be performed on them.
newtype Region = Region { unRegion :: ForeignPtr Region }
type RegionPtr = C2HSImp.Ptr (Region)
{-# LINE 398 "./GI/Cairo/Render/Types.chs" #-}

withRegion = withForeignPtr . unRegion 

mkRegion :: Ptr Region -> IO Region
mkRegion :: Ptr Region -> IO Region
mkRegion Ptr Region
regionPtr = do
  ForeignPtr Region
regionForeignPtr <- FinalizerPtr Region -> Ptr Region -> IO (ForeignPtr Region)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Region
regionDestroy Ptr Region
regionPtr
  Region -> IO Region
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Region -> Region
Region ForeignPtr Region
regionForeignPtr)

foreign import ccall unsafe "&cairo_region_destroy"
  regionDestroy :: FinalizerPtr Region


data Content = ContentColor
             | ContentAlpha
             | ContentColorAlpha
  deriving (Content -> Content -> Bool
(Content -> Content -> Bool)
-> (Content -> Content -> Bool) -> Eq Content
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Content -> Content -> Bool
== :: Content -> Content -> Bool
$c/= :: Content -> Content -> Bool
/= :: Content -> Content -> Bool
Eq,Int -> Content -> ShowS
[Content] -> ShowS
Content -> String
(Int -> Content -> ShowS)
-> (Content -> String) -> ([Content] -> ShowS) -> Show Content
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Content -> ShowS
showsPrec :: Int -> Content -> ShowS
$cshow :: Content -> String
show :: Content -> String
$cshowList :: [Content] -> ShowS
showList :: [Content] -> ShowS
Show)
instance Enum Content where
  succ :: Content -> Content
succ Content
ContentColor = Content
ContentAlpha
  succ Content
ContentAlpha = Content
ContentColorAlpha
  succ Content
ContentColorAlpha = String -> Content
forall a. HasCallStack => String -> a
error String
"Content.succ: ContentColorAlpha has no successor"

  pred ContentAlpha = ContentColor
  pred ContentColorAlpha = ContentAlpha
  pred ContentColor = error "Content.pred: ContentColor has no predecessor"

  enumFromTo :: Content -> Content -> [Content]
enumFromTo Content
from Content
to = Content -> [Content]
go Content
from
    where
      end :: Int
end = Content -> Int
forall a. Enum a => a -> Int
fromEnum Content
to
      go :: Content -> [Content]
go Content
v = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Content -> Int
forall a. Enum a => a -> Int
fromEnum Content
v) Int
end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from ContentColorAlpha

  fromEnum ContentColor = 4096
  fromEnum ContentAlpha = 8192
  fromEnum ContentColorAlpha = 12288

  toEnum 4096 = ContentColor
  toEnum 8192 = ContentAlpha
  toEnum 12288 = ContentColorAlpha
  toEnum unmatched = error ("Content.toEnum: Cannot match " ++ show unmatched)

{-# LINE 411 "./GI/Cairo/Render/Types.chs" #-}


data Format = FormatARGB32
            | FormatRGB24
            | FormatA8
            | FormatA1
            deriving (Enum,Show,Eq)

-- | FIXME: We should find out about this.
data Extend = ExtendNone
            | ExtendRepeat
            | ExtendReflect
            | ExtendPad
  deriving (Enum,Eq,Show)

{-# LINE 420 "./GI/Cairo/Render/Types.chs" #-}


-- | Specify how filtering is done.
data Filter = FilterFast
            | FilterGood
            | FilterBest
            | FilterNearest
            | FilterBilinear
            | FilterGaussian
  deriving (Enum,Eq,Show)

{-# LINE 423 "./GI/Cairo/Render/Types.chs" #-}


-- Marshalling functions

{-# INLINE cIntConv #-}
cIntConv :: (Integral a, Integral b) => a -> b
cIntConv  = fromIntegral

{-# INLINE cFloatConv #-}
cFloatConv :: (RealFloat a, RealFloat b) => a -> b
cFloatConv  = realToFrac

{-# INLINE cFromBool #-}
cFromBool :: Num a => Bool -> a
cFromBool  = fromBool

{-# INLINE cToBool #-}
cToBool :: (Eq a, Num a) => a -> Bool
cToBool  = toBool

{-# INLINE cToEnum #-}
cToEnum :: (Integral i, Enum e) => i -> e
cToEnum :: forall i e. (Integral i, Enum e) => i -> e
cToEnum  = Int -> e
forall a. Enum a => Int -> a
toEnum (Int -> e) -> (i -> Int) -> i -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Int
forall a b. (Integral a, Integral b) => a -> b
cIntConv

{-# INLINE cFromEnum #-}
cFromEnum :: (Enum e, Integral i) => e -> i
cFromEnum :: forall e i. (Enum e, Integral i) => e -> i
cFromEnum  = Int -> i
forall a b. (Integral a, Integral b) => a -> b
cIntConv (Int -> i) -> (e -> Int) -> e -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Int
forall a. Enum a => a -> Int
fromEnum

{-# INLINE peekFloatConv #-}
peekFloatConv :: (Storable a, RealFloat a, RealFloat b) =>  Ptr a -> IO b
peekFloatConv :: forall a b. (Storable a, RealFloat a, RealFloat b) => Ptr a -> IO b
peekFloatConv  = (a -> b) -> IO a -> IO b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> b
forall a b. (RealFloat a, RealFloat b) => a -> b
cFloatConv (IO a -> IO b) -> (Ptr a -> IO a) -> Ptr a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek

{-# INLINE withFloatConv #-}
withFloatConv :: (Storable b, RealFloat a, RealFloat b) => a -> (Ptr b -> IO c) -> IO c
withFloatConv :: forall b a c.
(Storable b, RealFloat a, RealFloat b) =>
a -> (Ptr b -> IO c) -> IO c
withFloatConv  = b -> (Ptr b -> IO c) -> IO c
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (b -> (Ptr b -> IO c) -> IO c)
-> (a -> b) -> a -> (Ptr b -> IO c) -> IO c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. (RealFloat a, RealFloat b) => a -> b
cFloatConv

{-# INLINE withArrayFloatConv #-}
withArrayFloatConv :: (Storable b, RealFloat a, RealFloat b) => [a] -> (Ptr b -> IO b1) -> IO b1
withArrayFloatConv :: forall b a b1.
(Storable b, RealFloat a, RealFloat b) =>
[a] -> (Ptr b -> IO b1) -> IO b1
withArrayFloatConv = [b] -> (Ptr b -> IO b1) -> IO b1
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray ([b] -> (Ptr b -> IO b1) -> IO b1)
-> ([a] -> [b]) -> [a] -> (Ptr b -> IO b1) -> IO b1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a -> b
forall a b. (RealFloat a, RealFloat b) => a -> b
cFloatConv)