{-# LINE 1 "src/Graphics/Cairo/Types.hsc" #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Graphics.Cairo.Types where

import Foreign.Storable
import Data.Int



data CairoTextExtentsT = CairoTextExtentsT {
	CairoTextExtentsT -> Double
cairoTextExtentsTXBearing :: Double,
{-# LINE 12 "src/Graphics/Cairo/Types.hsc" #-}
	CairoTextExtentsT -> Double
cairoTextExtentsTYBearing :: Double,
{-# LINE 13 "src/Graphics/Cairo/Types.hsc" #-}
	CairoTextExtentsT -> Double
cairoTextExtentsTWidth :: Double,
{-# LINE 14 "src/Graphics/Cairo/Types.hsc" #-}
	CairoTextExtentsT -> Double
cairoTextExtentsTHeight :: Double,
{-# LINE 15 "src/Graphics/Cairo/Types.hsc" #-}
	CairoTextExtentsT -> Double
cairoTextExtentsTXAdvance :: Double,
{-# LINE 16 "src/Graphics/Cairo/Types.hsc" #-}
	CairoTextExtentsT -> Double
cairoTextExtentsTYAdvance :: Double } deriving Int -> CairoTextExtentsT -> ShowS
[CairoTextExtentsT] -> ShowS
CairoTextExtentsT -> String
(Int -> CairoTextExtentsT -> ShowS)
-> (CairoTextExtentsT -> String)
-> ([CairoTextExtentsT] -> ShowS)
-> Show CairoTextExtentsT
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CairoTextExtentsT -> ShowS
showsPrec :: Int -> CairoTextExtentsT -> ShowS
$cshow :: CairoTextExtentsT -> String
show :: CairoTextExtentsT -> String
$cshowList :: [CairoTextExtentsT] -> ShowS
showList :: [CairoTextExtentsT] -> ShowS
Show
{-# LINE 17 "src/Graphics/Cairo/Types.hsc" #-}

instance Storable CairoTextExtentsT where
	sizeOf :: CairoTextExtentsT -> Int
sizeOf CairoTextExtentsT
_ = (Int
48)
{-# LINE 20 "src/Graphics/Cairo/Types.hsc" #-}
	alignment :: CairoTextExtentsT -> Int
alignment CairoTextExtentsT
_ = Int
8
{-# LINE 21 "src/Graphics/Cairo/Types.hsc" #-}
	peek :: Ptr CairoTextExtentsT -> IO CairoTextExtentsT
peek Ptr CairoTextExtentsT
p = Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> CairoTextExtentsT
CairoTextExtentsT
		(Double
 -> Double
 -> Double
 -> Double
 -> Double
 -> Double
 -> CairoTextExtentsT)
-> IO Double
-> IO
     (Double
      -> Double -> Double -> Double -> Double -> CairoTextExtentsT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (\Ptr CairoTextExtentsT
hsc_ptr -> Ptr CairoTextExtentsT -> Int -> IO Double
forall b. Ptr b -> Int -> IO Double
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CairoTextExtentsT
hsc_ptr Int
0) Ptr CairoTextExtentsT
p
{-# LINE 23 "src/Graphics/Cairo/Types.hsc" #-}
		IO
  (Double
   -> Double -> Double -> Double -> Double -> CairoTextExtentsT)
-> IO Double
-> IO (Double -> Double -> Double -> Double -> CairoTextExtentsT)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (\Ptr CairoTextExtentsT
hsc_ptr -> Ptr CairoTextExtentsT -> Int -> IO Double
forall b. Ptr b -> Int -> IO Double
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CairoTextExtentsT
hsc_ptr Int
8) Ptr CairoTextExtentsT
p
{-# LINE 24 "src/Graphics/Cairo/Types.hsc" #-}
		IO (Double -> Double -> Double -> Double -> CairoTextExtentsT)
-> IO Double
-> IO (Double -> Double -> Double -> CairoTextExtentsT)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (\Ptr CairoTextExtentsT
hsc_ptr -> Ptr CairoTextExtentsT -> Int -> IO Double
forall b. Ptr b -> Int -> IO Double
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CairoTextExtentsT
hsc_ptr Int
16) Ptr CairoTextExtentsT
p
{-# LINE 25 "src/Graphics/Cairo/Types.hsc" #-}
		IO (Double -> Double -> Double -> CairoTextExtentsT)
-> IO Double -> IO (Double -> Double -> CairoTextExtentsT)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (\Ptr CairoTextExtentsT
hsc_ptr -> Ptr CairoTextExtentsT -> Int -> IO Double
forall b. Ptr b -> Int -> IO Double
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CairoTextExtentsT
hsc_ptr Int
24) Ptr CairoTextExtentsT
p
{-# LINE 26 "src/Graphics/Cairo/Types.hsc" #-}
		IO (Double -> Double -> CairoTextExtentsT)
-> IO Double -> IO (Double -> CairoTextExtentsT)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (\Ptr CairoTextExtentsT
hsc_ptr -> Ptr CairoTextExtentsT -> Int -> IO Double
forall b. Ptr b -> Int -> IO Double
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CairoTextExtentsT
hsc_ptr Int
32) Ptr CairoTextExtentsT
p
{-# LINE 27 "src/Graphics/Cairo/Types.hsc" #-}
		IO (Double -> CairoTextExtentsT)
-> IO Double -> IO CairoTextExtentsT
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (\Ptr CairoTextExtentsT
hsc_ptr -> Ptr CairoTextExtentsT -> Int -> IO Double
forall b. Ptr b -> Int -> IO Double
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CairoTextExtentsT
hsc_ptr Int
40) Ptr CairoTextExtentsT
p
{-# LINE 28 "src/Graphics/Cairo/Types.hsc" #-}
	poke :: Ptr CairoTextExtentsT -> CairoTextExtentsT -> IO ()
poke Ptr CairoTextExtentsT
p (CairoTextExtentsT Double
xb Double
yb Double
w Double
h Double
xa Double
ya) = do
		(\Ptr CairoTextExtentsT
hsc_ptr -> Ptr CairoTextExtentsT -> Int -> Double -> IO ()
forall b. Ptr b -> Int -> Double -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CairoTextExtentsT
hsc_ptr Int
0) Ptr CairoTextExtentsT
p Double
xb
{-# LINE 30 "src/Graphics/Cairo/Types.hsc" #-}
		(\Ptr CairoTextExtentsT
hsc_ptr -> Ptr CairoTextExtentsT -> Int -> Double -> IO ()
forall b. Ptr b -> Int -> Double -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CairoTextExtentsT
hsc_ptr Int
8) Ptr CairoTextExtentsT
p Double
yb
{-# LINE 31 "src/Graphics/Cairo/Types.hsc" #-}
		(\Ptr CairoTextExtentsT
hsc_ptr -> Ptr CairoTextExtentsT -> Int -> Double -> IO ()
forall b. Ptr b -> Int -> Double -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CairoTextExtentsT
hsc_ptr Int
16) Ptr CairoTextExtentsT
p Double
w
{-# LINE 32 "src/Graphics/Cairo/Types.hsc" #-}
		(\Ptr CairoTextExtentsT
hsc_ptr -> Ptr CairoTextExtentsT -> Int -> Double -> IO ()
forall b. Ptr b -> Int -> Double -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CairoTextExtentsT
hsc_ptr Int
24) Ptr CairoTextExtentsT
p Double
h
{-# LINE 33 "src/Graphics/Cairo/Types.hsc" #-}
		(\Ptr CairoTextExtentsT
hsc_ptr -> Ptr CairoTextExtentsT -> Int -> Double -> IO ()
forall b. Ptr b -> Int -> Double -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CairoTextExtentsT
hsc_ptr Int
32) Ptr CairoTextExtentsT
p Double
xa
{-# LINE 34 "src/Graphics/Cairo/Types.hsc" #-}
		(\Ptr CairoTextExtentsT
hsc_ptr -> Ptr CairoTextExtentsT -> Int -> Double -> IO ()
forall b. Ptr b -> Int -> Double -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CairoTextExtentsT
hsc_ptr Int
40) Ptr CairoTextExtentsT
p Double
ya
{-# LINE 35 "src/Graphics/Cairo/Types.hsc" #-}