{-# LINE 1 "src/SFML/System/InputStream.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface, ExistentialQuantification #-}
{-# LINE 2 "src/SFML/System/InputStream.hsc" #-}
module SFML.System.InputStream
(
    InputStreamReadFunc
,   InputStreamSeekFunc
,   InputStreamTellFunc
,   InputStreamGetSizeFunc
,   InputStream(..)
)
where


import Control.Applicative ((<$>), (<*>))
import Data.Word (Word64)
import Foreign.C.Types (CInt)
import Foreign.Ptr (Ptr)
import Foreign.Storable



{-# LINE 21 "src/SFML/System/InputStream.hsc" #-}


-- | Function to read data from the stream.
type InputStreamReadFunc a
    =  Ptr Char  -- ^ Buffer where to copy the read data
    -> Word64    -- ^ Desired number of bytes to read
    -> Ptr a     -- ^ User data
    -> IO Word64 -- ^ The number of bytes actually read

-- | Function to set the current read position.
type InputStreamSeekFunc a
    =  Word64    -- ^ The position to seek to, from the beginning
    -> Ptr a     -- ^ User data
    -> IO Word64 -- ^ The position actually sought to, or -1 on error

-- | Function to get the current read position.
type InputStreamTellFunc a
    =  Ptr a     -- ^ User data
    -> IO Word64 -- ^ The current position, or -1 on error

-- | Function to get the total number of bytes in the stream.
type InputStreamGetSizeFunc a
    =  Ptr a     -- ^ User data
    -> IO Word64 -- ^ The total number of bytes available in the stream, or -1 on error


-- | Set of callbacks that allow users to define custom file streams.
data InputStream = forall a. InputStream
    { read       :: Ptr (InputStreamReadFunc a)
    , seek       :: Ptr (InputStreamSeekFunc a)
    , tell       :: Ptr (InputStreamTellFunc a)
    , getSize    :: Ptr (InputStreamGetSizeFunc a)
    , userData   :: Ptr a
    }

instance Storable InputStream where
    sizeOf _ = size_InputStream
    alignment _ = alignment (undefined :: CInt)

    peek ptr = InputStream
            <$> (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 62 "src/SFML/System/InputStream.hsc" #-}
            <*> (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 63 "src/SFML/System/InputStream.hsc" #-}
            <*> (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 64 "src/SFML/System/InputStream.hsc" #-}
            <*> (\hsc_ptr -> peekByteOff hsc_ptr 24) ptr
{-# LINE 65 "src/SFML/System/InputStream.hsc" #-}
            <*> (\hsc_ptr -> peekByteOff hsc_ptr 32) ptr
{-# LINE 66 "src/SFML/System/InputStream.hsc" #-}

    poke ptr (InputStream read seek tell gets udata) = do
        (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr read
{-# LINE 69 "src/SFML/System/InputStream.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr seek
{-# LINE 70 "src/SFML/System/InputStream.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 16) ptr tell
{-# LINE 71 "src/SFML/System/InputStream.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 24) ptr gets
{-# LINE 72 "src/SFML/System/InputStream.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 32) ptr udata
{-# LINE 73 "src/SFML/System/InputStream.hsc" #-}


size_InputStream = (40)
{-# LINE 76 "src/SFML/System/InputStream.hsc" #-}


instance Show InputStream where

    show (InputStream read seek tell getSize userData) =
        "InputStream { read = " ++ show read ++
                    ", seek = " ++ show seek ++
                    ", tell = " ++ show tell ++
                    ", getSize = " ++ show getSize ++
                    ", userData = " ++ show userData ++
                    "}"