{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}

module Graphics.Image.PFS.Internal where

import Foreign
import Foreign.C
import Control.Monad

data TagIterator
data TagContainer
data Channel
data Array
data ChannelIterator
data Frame
data DOMIO
data FrameFile
data FrameFileIterator
data FILE

type TagIteratorH = Ptr TagIterator
type TagContainerH = Ptr TagContainer
type ChannelH = Ptr Channel
type ArrayH = Ptr Array
type ChannelIteratorH = Ptr ChannelIterator
type FrameH = Ptr Frame
type DOMIOH = Ptr DOMIO
type FrameFileH = Ptr FrameFile
type FrameFileIteratorH = Ptr FrameFileIterator
type FILEH = Ptr FILE

foreign import ccall "pfs_TagIteratorGetNext" pfs_TagIteratorGetNext:: TagIteratorH -> IO CString
foreign import ccall "pfs_TagIteratorHasNext" pfs_TagIteratorHasNext:: TagIteratorH -> CInt
foreign import ccall "pfs_TagContainerGetString" pfs_TagContainerGetString :: TagContainerH -> CString -> IO CString 
foreign import ccall "pfs_TagContainerSetString" pfs_TagContainerSetString :: TagContainerH -> CString -> CString -> IO ()
foreign import ccall "pfs_TagContainerRemoveTag" pfs_TagContainerRemoveTag :: TagContainerH -> CString -> IO ()
foreign import ccall "pfs_TagContainerGetIterator" pfs_TagContainerGetIterator :: TagContainerH -> IO TagIteratorH 
foreign import ccall "pfs_Array2DGetCols" pfs_Array2DGetCols :: ArrayH -> CInt
foreign import ccall "pfs_Array2DGetRows" pfs_Array2DGetRows :: ArrayH -> CInt
foreign import ccall "pfs_Array2DGet" pfs_Array2DGet :: ArrayH -> CInt -> CInt -> CFloat
foreign import ccall "pfs_Array2DSet" pfs_Array2DSet :: ArrayH -> CInt -> CInt -> CFloat -> IO CFloat
foreign import ccall "pfs_Array1DGet" pfs_Array1DGet :: ArrayH -> CInt -> CFloat
foreign import ccall "pfs_Array1DSet" pfs_Array1DSet :: ArrayH -> CInt -> CFloat -> IO CFloat
foreign import ccall "pfs_ChannelGetWidth" pfs_ChannelGetWidth :: ChannelH -> CInt
foreign import ccall "pfs_ChannelGetHeight" pfs_ChannelGetHeight :: ChannelH -> CInt
foreign import ccall "pfs_ChannelGetName" pfs_ChannelGetName :: ChannelH -> CString
foreign import ccall "pfs_ChannelGetTags" pfs_ChannelGetTags :: ChannelH -> IO TagContainerH
foreign import ccall "pfs_ChannelGetRawData" pfs_ChannelGetRawData :: ChannelH -> IO (Ptr CFloat)
foreign import ccall "pfs_ChannelIteratorGetNext" pfs_ChannelIteratorGetNext :: ChannelIteratorH -> IO ChannelH
foreign import ccall "pfs_ChannelIteratorHasNext" pfs_ChannelIteratorHasNext :: ChannelIteratorH -> IO CInt
foreign import ccall "pfs_FrameGetWidth" pfs_FrameGetWidth :: FrameH -> CInt
foreign import ccall "pfs_FrameGetHeight" pfs_FrameGetHeight :: FrameH -> CInt
foreign import ccall "pfs_FrameGetXYZChannels" pfs_FrameGetXYZChannels :: FrameH -> Ptr ChannelH -> Ptr ChannelH -> Ptr ChannelH -> IO ()
foreign import ccall "pfs_FrameCreateXYZChannels" pfs_FrameCreateXYZChannels :: FrameH -> Ptr ChannelH -> Ptr ChannelH -> Ptr ChannelH -> IO ()
foreign import ccall "pfs_FrameGetChannel" pfs_FrameGetChannel :: FrameH -> CString -> IO ChannelH
foreign import ccall "pfs_FrameCreateChannel"pfs_FrameCreateChannel  :: FrameH -> CString -> IO ChannelH
foreign import ccall "pfs_FrameRemoveChannel" pfs_FrameRemoveChannel :: FrameH -> ChannelH -> IO ()
foreign import ccall "pfs_FrameGetChannelIterator" pfs_FrameGetChannelIterator :: FrameH -> IO ChannelIteratorH
foreign import ccall "pfs_FrameGetTags" pfs_FrameGetTags ::FrameH -> IO TagContainerH
foreign import ccall "pfs_newDOMIO" pfs_newDOMIO :: IO DOMIOH
foreign import ccall "pfs_deleteDOMIO" pfs_deleteDOMIO :: DOMIOH -> IO ()
foreign import ccall "pfs_DOMIOCreateFrame" pfs_DOMIOCreateFrame :: DOMIOH -> CInt -> CInt -> IO FrameH
foreign import ccall "pfs_DOMIOWriteFrame" pfs_DOMIOWriteFrame :: DOMIOH -> FrameH -> FILEH -> IO ()
foreign import ccall "pfs_DOMIOReadFrame" pfs_DOMIOReadFrame :: DOMIOH -> FILEH -> IO FrameH
foreign import ccall "pfs_DOMIOFreeFrame" pfs_DOMIOFreeFrame :: DOMIOH -> FrameH -> IO ()
foreign import ccall "pfs_newFrameFile" pfs_newFrameFile :: FILEH -> CString -> IO FrameFileH
foreign import ccall "pfs_FrameFileGetFileHandle" pfs_FrameFileGetFileHandle :: FrameFileH -> FILEH
foreign import ccall "pfsFrameFileGetFileName" pfsFrameFileGetFileName :: FrameFileH -> CString
foreign import ccall "pfs_newFrameFileIterator" pfs_newFrameFileIterator :: Ptr CInt -> Ptr CString -> CString -> CString -> FILEH -> CString -> Ptr () -> IO FrameFileIteratorH
foreign import ccall "pfs_FrameFileIteratorGetNextFrameFile" pfs_FrameFileIteratorGetNextFrameFile :: FrameFileIteratorH -> IO FrameFileH
foreign import ccall "pfs_FrameFileIteratorCloseFrameFile" pfs_FrameFileIteratorCloseFrameFile :: FrameFileH -> IO ()
foreign import ccall "pfs_freeChannelIterator" pfs_freeChannelIterator :: ChannelIteratorH -> IO ()
foreign import ccall "pfs_freeTagIterator" pfs_freeTagIterator :: TagIteratorH -> IO ()

foreign import ccall "fopen" fopen :: CString -> CString -> IO FILEH
foreign import ccall "fclose" fclose :: FILEH -> IO ()
foreign import ccall "fdopen" fdopen :: CInt -> CString -> IO FILEH