{-# LINE 1 "src/SFML/Graphics/Glyph.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
{-# LINE 2 "src/SFML/Graphics/Glyph.hsc" #-}
module SFML.Graphics.Glyph
(
    Glyph(..)
)
where


import SFML.Graphics.Rect

import Control.Applicative ((<$>), (<*>))
import Foreign.C.Types
import Foreign.Storable


{-# LINE 16 "src/SFML/Graphics/Glyph.hsc" #-}


sizeInt = (4)
{-# LINE 19 "src/SFML/Graphics/Glyph.hsc" #-}
sizeIntRect = (16)
{-# LINE 20 "src/SFML/Graphics/Glyph.hsc" #-}


-- | Describes a glyph (a visual character).
data Glyph = Glyph
    { advance     :: Int     -- ^ Offset to move horizontically to the next character
    , bounds      :: IntRect -- ^ Bounding rectangle of the glyph, in coordinates relative to the baseline
    , textureRect :: IntRect -- ^ Texture coordinates of the glyph inside the font's image
    }


instance Storable Glyph where
    sizeOf _ = sizeInt + 2*sizeIntRect
    alignment _ = alignment (undefined :: IntRect)

    peek ptr = Glyph
            <$> fmap fromIntegral ((\hsc_ptr -> peekByteOff hsc_ptr 0) ptr :: IO CInt)
{-# LINE 36 "src/SFML/Graphics/Glyph.hsc" #-}
            <*> (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 37 "src/SFML/Graphics/Glyph.hsc" #-}
            <*> (\hsc_ptr -> peekByteOff hsc_ptr 20) ptr
{-# LINE 38 "src/SFML/Graphics/Glyph.hsc" #-}

    poke ptr (Glyph advance bounds rect) = do
        (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr (fromIntegral advance :: CInt)
{-# LINE 41 "src/SFML/Graphics/Glyph.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr bounds
{-# LINE 42 "src/SFML/Graphics/Glyph.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 20) ptr rect
{-# LINE 43 "src/SFML/Graphics/Glyph.hsc" #-}