{-# LANGUAGE ForeignFunctionInterface #-} -- module HROOT.Class.FFI where module HROOT.Class.TSeqCollection.FFI where import Foreign.C import Foreign.Ptr -- import HROOT.Class.Interface -- #include "" import HROOT.Class.TSeqCollection.RawType import HROOT.Class.TObject.RawType import HROOT.Class.TClass.RawType #include "HROOTTSeqCollection.h" foreign import ccall "HROOTTSeqCollection.h TSeqCollection_Draw" c_tseqcollection_draw :: (Ptr RawTSeqCollection) -> CString -> IO () foreign import ccall "HROOTTSeqCollection.h TSeqCollection_FindObject" c_tseqcollection_findobject :: (Ptr RawTSeqCollection) -> CString -> IO (Ptr RawTObject) foreign import ccall "HROOTTSeqCollection.h TSeqCollection_GetName" c_tseqcollection_getname :: (Ptr RawTSeqCollection) -> IO CString foreign import ccall "HROOTTSeqCollection.h TSeqCollection_IsA" c_tseqcollection_isa :: (Ptr RawTSeqCollection) -> IO (Ptr RawTClass) foreign import ccall "HROOTTSeqCollection.h TSeqCollection_IsFolder" c_tseqcollection_isfolder :: (Ptr RawTSeqCollection) -> IO CInt foreign import ccall "HROOTTSeqCollection.h TSeqCollection_IsEqual" c_tseqcollection_isequal :: (Ptr RawTSeqCollection) -> (Ptr RawTObject) -> IO CInt foreign import ccall "HROOTTSeqCollection.h TSeqCollection_IsSortable" c_tseqcollection_issortable :: (Ptr RawTSeqCollection) -> IO CInt foreign import ccall "HROOTTSeqCollection.h TSeqCollection_Paint" c_tseqcollection_paint :: (Ptr RawTSeqCollection) -> CString -> IO () foreign import ccall "HROOTTSeqCollection.h TSeqCollection_printObj" c_tseqcollection_printobj :: (Ptr RawTSeqCollection) -> CString -> IO () foreign import ccall "HROOTTSeqCollection.h TSeqCollection_RecursiveRemove" c_tseqcollection_recursiveremove :: (Ptr RawTSeqCollection) -> (Ptr RawTObject) -> IO () foreign import ccall "HROOTTSeqCollection.h TSeqCollection_SaveAs" c_tseqcollection_saveas :: (Ptr RawTSeqCollection) -> CString -> CString -> IO () foreign import ccall "HROOTTSeqCollection.h TSeqCollection_UseCurrentStyle" c_tseqcollection_usecurrentstyle :: (Ptr RawTSeqCollection) -> IO () foreign import ccall "HROOTTSeqCollection.h TSeqCollection_Write" c_tseqcollection_write :: (Ptr RawTSeqCollection) -> CString -> CInt -> CInt -> IO CInt foreign import ccall "HROOTTSeqCollection.h TSeqCollection_delete" c_tseqcollection_delete :: (Ptr RawTSeqCollection) -> IO ()