{-# LINE 1 "Graphics/Rendering/FreeType/Internal/Matrix.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
{-# LINE 2 "Graphics/Rendering/FreeType/Internal/Matrix.hsc" #-}
module Graphics.Rendering.FreeType.Internal.Matrix
( FT_Matrix(..)
) where

import Foreign

import Graphics.Rendering.FreeType.Internal.PrimitiveTypes


{-# LINE 11 "Graphics/Rendering/FreeType/Internal/Matrix.hsc" #-}

{-# LINE 12 "Graphics/Rendering/FreeType/Internal/Matrix.hsc" #-}


{-# LINE 14 "Graphics/Rendering/FreeType/Internal/Matrix.hsc" #-}

data FT_Matrix = FT_Matrix
  { xx, xy :: FT_Fixed
  , yx, yy :: FT_Fixed
  }
  deriving (Read, Show, Eq)

instance Storable FT_Matrix where
  sizeOf _    = (16)
{-# LINE 23 "Graphics/Rendering/FreeType/Internal/Matrix.hsc" #-}
  alignment _ = alignment (undefined :: FT_Fixed)
  peek ptr = do
    xx' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 26 "Graphics/Rendering/FreeType/Internal/Matrix.hsc" #-}
    xy' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 27 "Graphics/Rendering/FreeType/Internal/Matrix.hsc" #-}
    yx' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 28 "Graphics/Rendering/FreeType/Internal/Matrix.hsc" #-}
    yy' <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 29 "Graphics/Rendering/FreeType/Internal/Matrix.hsc" #-}
    return $! FT_Matrix xx' xy' yx' yy'
  poke ptr val = do
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (xx val)
{-# LINE 32 "Graphics/Rendering/FreeType/Internal/Matrix.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr (xy val)
{-# LINE 33 "Graphics/Rendering/FreeType/Internal/Matrix.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr (yx val)
{-# LINE 34 "Graphics/Rendering/FreeType/Internal/Matrix.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr (yy val)
{-# LINE 35 "Graphics/Rendering/FreeType/Internal/Matrix.hsc" #-}