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


import SFML.Graphics.Color
import SFML.System.Vector2

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


{-# LINE 17 "src/SFML/Graphics/Vertex.hsc" #-}


-- | Define a point with color and texture coordinates.
data Vertex = Vertex
    { position  :: Vec2f
    , color     :: Color
    , texCoords :: Vec2f
    }
    deriving (Show)


instance Storable Vertex where
    sizeOf _ = size_sfVertex
    alignment _ = alignment (undefined :: CFloat)

    peek ptr = Vertex
            <$> (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 34 "src/SFML/Graphics/Vertex.hsc" #-}
            <*> (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 35 "src/SFML/Graphics/Vertex.hsc" #-}
            <*> (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr
{-# LINE 36 "src/SFML/Graphics/Vertex.hsc" #-}

    poke ptr (Vertex pos col tex) = do
        (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr pos
{-# LINE 39 "src/SFML/Graphics/Vertex.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr col
{-# LINE 40 "src/SFML/Graphics/Vertex.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 12) ptr tex
{-# LINE 41 "src/SFML/Graphics/Vertex.hsc" #-}


size_sfVertex = (20)
{-# LINE 44 "src/SFML/Graphics/Vertex.hsc" #-}

{-typedef struct
{
    sfVector2f position;  ///< Position of the vertex
    sfColor    color;     ///< Color of the vertex
    sfVector2f texCoords; ///< Coordinates of the texture's pixel to map to the vertex
} sfVertex;-}