{-# LINE 1 "Graphics/Rendering/FreeType/Internal/GlyphSlot.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
{-# LINE 2 "Graphics/Rendering/FreeType/Internal/GlyphSlot.hsc" #-}
module Graphics.Rendering.FreeType.Internal.GlyphSlot
( FT_GlyphSlotRec_
, FT_GlyphSlot
, library
, advance
, bitmap
, bitmap_top
, bitmap_left
) where

import Foreign
import Foreign.Storable

import Graphics.Rendering.FreeType.Internal.PrimitiveTypes
import qualified Graphics.Rendering.FreeType.Internal.Library as Lib
import qualified Graphics.Rendering.FreeType.Internal.Vector  as V
import qualified Graphics.Rendering.FreeType.Internal.Bitmap as B


{-# LINE 21 "Graphics/Rendering/FreeType/Internal/GlyphSlot.hsc" #-}

{-# LINE 22 "Graphics/Rendering/FreeType/Internal/GlyphSlot.hsc" #-}


{-# LINE 24 "Graphics/Rendering/FreeType/Internal/GlyphSlot.hsc" #-}

{-# LINE 25 "Graphics/Rendering/FreeType/Internal/GlyphSlot.hsc" #-}


{-# LINE 27 "Graphics/Rendering/FreeType/Internal/GlyphSlot.hsc" #-}

data FT_GlyphSlotRec_
type FT_GlyphSlot = Ptr FT_GlyphSlotRec_

instance Storable FT_GlyphSlotRec_ where
  sizeOf _    = (160)
{-# LINE 33 "Graphics/Rendering/FreeType/Internal/GlyphSlot.hsc" #-}
  alignment _ = 4
{-# LINE 34 "Graphics/Rendering/FreeType/Internal/GlyphSlot.hsc" #-}
  peek = error "peek not implemented for FT_GlyphSlotRec_"
  poke = error "poke not implemented for FT_GlyphSlotRec_"

library :: FT_GlyphSlot -> Lib.FT_Library
library = ((\hsc_ptr -> hsc_ptr `plusPtr` 0))
{-# LINE 39 "Graphics/Rendering/FreeType/Internal/GlyphSlot.hsc" #-}

advance :: FT_GlyphSlot -> Ptr V.FT_Vector
advance = ((\hsc_ptr -> hsc_ptr `plusPtr` 64))
{-# LINE 42 "Graphics/Rendering/FreeType/Internal/GlyphSlot.hsc" #-}

bitmap :: FT_GlyphSlot -> Ptr B.FT_Bitmap
bitmap = ((\hsc_ptr -> hsc_ptr `plusPtr` 76))
{-# LINE 45 "Graphics/Rendering/FreeType/Internal/GlyphSlot.hsc" #-}

bitmap_left :: FT_GlyphSlot -> Ptr FT_Int
bitmap_left = ((\hsc_ptr -> hsc_ptr `plusPtr` 100))
{-# LINE 48 "Graphics/Rendering/FreeType/Internal/GlyphSlot.hsc" #-}

bitmap_top :: FT_GlyphSlot -> Ptr FT_Int
bitmap_top = ((\hsc_ptr -> hsc_ptr `plusPtr` 104))
{-# LINE 51 "Graphics/Rendering/FreeType/Internal/GlyphSlot.hsc" #-}