{-# LANGUAGE ForeignFunctionInterface #-} -- module HROOT.Class.FFI where module HROOT.Class.TGraph.FFI where import Foreign.C import Foreign.Ptr -- import HROOT.Class.Interface -- #include "" import HROOT.Class.TGraph.RawType import HROOT.Class.TObject.RawType import HROOT.Class.TClass.RawType import HROOT.Class.TF1.RawType import HROOT.Class.TH1F.RawType import HROOT.Class.TList.RawType import HROOT.Class.TAxis.RawType #include "HROOTTGraph.h" foreign import ccall "HROOTTGraph.h TGraph_SetName" c_tgraph_setname :: (Ptr RawTGraph) -> CString -> IO () foreign import ccall "HROOTTGraph.h TGraph_SetNameTitle" c_tgraph_setnametitle :: (Ptr RawTGraph) -> CString -> CString -> IO () foreign import ccall "HROOTTGraph.h TGraph_SetTitle" c_tgraph_settitle :: (Ptr RawTGraph) -> CString -> IO () foreign import ccall "HROOTTGraph.h TGraph_GetLineColor" c_tgraph_getlinecolor :: (Ptr RawTGraph) -> IO CInt foreign import ccall "HROOTTGraph.h TGraph_GetLineStyle" c_tgraph_getlinestyle :: (Ptr RawTGraph) -> IO CInt foreign import ccall "HROOTTGraph.h TGraph_GetLineWidth" c_tgraph_getlinewidth :: (Ptr RawTGraph) -> IO CInt foreign import ccall "HROOTTGraph.h TGraph_ResetAttLine" c_tgraph_resetattline :: (Ptr RawTGraph) -> CString -> IO () foreign import ccall "HROOTTGraph.h TGraph_SetLineAttributes" c_tgraph_setlineattributes :: (Ptr RawTGraph) -> IO () foreign import ccall "HROOTTGraph.h TGraph_SetLineColor" c_tgraph_setlinecolor :: (Ptr RawTGraph) -> CInt -> IO () foreign import ccall "HROOTTGraph.h TGraph_SetLineStyle" c_tgraph_setlinestyle :: (Ptr RawTGraph) -> CInt -> IO () foreign import ccall "HROOTTGraph.h TGraph_SetLineWidth" c_tgraph_setlinewidth :: (Ptr RawTGraph) -> CInt -> IO () foreign import ccall "HROOTTGraph.h TGraph_SetFillColor" c_tgraph_setfillcolor :: (Ptr RawTGraph) -> CInt -> IO () foreign import ccall "HROOTTGraph.h TGraph_SetFillStyle" c_tgraph_setfillstyle :: (Ptr RawTGraph) -> CInt -> IO () foreign import ccall "HROOTTGraph.h TGraph_GetMarkerColor" c_tgraph_getmarkercolor :: (Ptr RawTGraph) -> IO CInt foreign import ccall "HROOTTGraph.h TGraph_GetMarkerStyle" c_tgraph_getmarkerstyle :: (Ptr RawTGraph) -> IO CInt foreign import ccall "HROOTTGraph.h TGraph_GetMarkerSize" c_tgraph_getmarkersize :: (Ptr RawTGraph) -> IO CDouble foreign import ccall "HROOTTGraph.h TGraph_ResetAttMarker" c_tgraph_resetattmarker :: (Ptr RawTGraph) -> CString -> IO () foreign import ccall "HROOTTGraph.h TGraph_SetMarkerAttributes" c_tgraph_setmarkerattributes :: (Ptr RawTGraph) -> IO () foreign import ccall "HROOTTGraph.h TGraph_SetMarkerColor" c_tgraph_setmarkercolor :: (Ptr RawTGraph) -> CInt -> IO () foreign import ccall "HROOTTGraph.h TGraph_SetMarkerStyle" c_tgraph_setmarkerstyle :: (Ptr RawTGraph) -> CInt -> IO () foreign import ccall "HROOTTGraph.h TGraph_SetMarkerSize" c_tgraph_setmarkersize :: (Ptr RawTGraph) -> CInt -> IO () foreign import ccall "HROOTTGraph.h TGraph_Draw" c_tgraph_draw :: (Ptr RawTGraph) -> CString -> IO () foreign import ccall "HROOTTGraph.h TGraph_FindObject" c_tgraph_findobject :: (Ptr RawTGraph) -> CString -> IO (Ptr RawTObject) foreign import ccall "HROOTTGraph.h TGraph_GetName" c_tgraph_getname :: (Ptr RawTGraph) -> IO CString foreign import ccall "HROOTTGraph.h TGraph_IsA" c_tgraph_isa :: (Ptr RawTGraph) -> IO (Ptr RawTClass) foreign import ccall "HROOTTGraph.h TGraph_IsFolder" c_tgraph_isfolder :: (Ptr RawTGraph) -> IO CInt foreign import ccall "HROOTTGraph.h TGraph_IsEqual" c_tgraph_isequal :: (Ptr RawTGraph) -> (Ptr RawTObject) -> IO CInt foreign import ccall "HROOTTGraph.h TGraph_IsSortable" c_tgraph_issortable :: (Ptr RawTGraph) -> IO CInt foreign import ccall "HROOTTGraph.h TGraph_Paint" c_tgraph_paint :: (Ptr RawTGraph) -> CString -> IO () foreign import ccall "HROOTTGraph.h TGraph_printObj" c_tgraph_printobj :: (Ptr RawTGraph) -> CString -> IO () foreign import ccall "HROOTTGraph.h TGraph_RecursiveRemove" c_tgraph_recursiveremove :: (Ptr RawTGraph) -> (Ptr RawTObject) -> IO () foreign import ccall "HROOTTGraph.h TGraph_SaveAs" c_tgraph_saveas :: (Ptr RawTGraph) -> CString -> CString -> IO () foreign import ccall "HROOTTGraph.h TGraph_UseCurrentStyle" c_tgraph_usecurrentstyle :: (Ptr RawTGraph) -> IO () foreign import ccall "HROOTTGraph.h TGraph_Write" c_tgraph_write :: (Ptr RawTGraph) -> CString -> CInt -> CInt -> IO CInt foreign import ccall "HROOTTGraph.h TGraph_delete" c_tgraph_delete :: (Ptr RawTGraph) -> IO () foreign import ccall "HROOTTGraph.h TGraph_newTGraph" c_tgraph_newtgraph :: CInt -> (Ptr CDouble) -> (Ptr CDouble) -> IO (Ptr RawTGraph) foreign import ccall "HROOTTGraph.h TGraph_Apply" c_tgraph_apply :: (Ptr RawTGraph) -> (Ptr RawTF1) -> IO () foreign import ccall "HROOTTGraph.h TGraph_Chisquare" c_tgraph_chisquare :: (Ptr RawTGraph) -> (Ptr RawTF1) -> IO CDouble foreign import ccall "HROOTTGraph.h TGraph_DrawGraph" c_tgraph_drawgraph :: (Ptr RawTGraph) -> CInt -> (Ptr CDouble) -> (Ptr CDouble) -> CString -> IO () foreign import ccall "HROOTTGraph.h TGraph_drawPanelTGraph" c_tgraph_drawpaneltgraph :: (Ptr RawTGraph) -> IO () foreign import ccall "HROOTTGraph.h TGraph_Expand" c_tgraph_expand :: (Ptr RawTGraph) -> CInt -> CInt -> IO () foreign import ccall "HROOTTGraph.h TGraph_FitPanelTGraph" c_tgraph_fitpaneltgraph :: (Ptr RawTGraph) -> IO () foreign import ccall "HROOTTGraph.h TGraph_tGraphGetEditable" c_tgraph_tgraphgeteditable :: (Ptr RawTGraph) -> IO CInt foreign import ccall "HROOTTGraph.h TGraph_tGraphGetFunction" c_tgraph_tgraphgetfunction :: (Ptr RawTGraph) -> CString -> IO (Ptr RawTF1) foreign import ccall "HROOTTGraph.h TGraph_tGraphGetHistogram" c_tgraph_tgraphgethistogram :: (Ptr RawTGraph) -> IO (Ptr RawTH1F) foreign import ccall "HROOTTGraph.h TGraph_tGraphGetListOfFunctions" c_tgraph_tgraphgetlistoffunctions :: (Ptr RawTGraph) -> IO (Ptr RawTList) foreign import ccall "HROOTTGraph.h TGraph_getCorrelationFactorTGraph" c_tgraph_getcorrelationfactortgraph :: (Ptr RawTGraph) -> IO CDouble foreign import ccall "HROOTTGraph.h TGraph_getCovarianceTGraph" c_tgraph_getcovariancetgraph :: (Ptr RawTGraph) -> IO CDouble foreign import ccall "HROOTTGraph.h TGraph_getMeanTGraph" c_tgraph_getmeantgraph :: (Ptr RawTGraph) -> CInt -> IO CDouble foreign import ccall "HROOTTGraph.h TGraph_getRMSTGraph" c_tgraph_getrmstgraph :: (Ptr RawTGraph) -> CInt -> IO CDouble foreign import ccall "HROOTTGraph.h TGraph_tGraphGetMaxSize" c_tgraph_tgraphgetmaxsize :: (Ptr RawTGraph) -> IO CInt foreign import ccall "HROOTTGraph.h TGraph_tGraphGetN" c_tgraph_tgraphgetn :: (Ptr RawTGraph) -> IO CInt foreign import ccall "HROOTTGraph.h TGraph_GetErrorX" c_tgraph_geterrorx :: (Ptr RawTGraph) -> CInt -> IO CDouble foreign import ccall "HROOTTGraph.h TGraph_GetErrorY" c_tgraph_geterrory :: (Ptr RawTGraph) -> CInt -> IO CDouble foreign import ccall "HROOTTGraph.h TGraph_GetErrorXhigh" c_tgraph_geterrorxhigh :: (Ptr RawTGraph) -> CInt -> IO CDouble foreign import ccall "HROOTTGraph.h TGraph_GetErrorXlow" c_tgraph_geterrorxlow :: (Ptr RawTGraph) -> CInt -> IO CDouble foreign import ccall "HROOTTGraph.h TGraph_GetErrorYhigh" c_tgraph_geterroryhigh :: (Ptr RawTGraph) -> CInt -> IO CDouble foreign import ccall "HROOTTGraph.h TGraph_GetErrorYlow" c_tgraph_geterrorylow :: (Ptr RawTGraph) -> CInt -> IO CDouble foreign import ccall "HROOTTGraph.h TGraph_tGraphGetMaximum" c_tgraph_tgraphgetmaximum :: (Ptr RawTGraph) -> IO CDouble foreign import ccall "HROOTTGraph.h TGraph_tGraphGetMinimum" c_tgraph_tgraphgetminimum :: (Ptr RawTGraph) -> IO CDouble foreign import ccall "HROOTTGraph.h TGraph_tGraphGetXaxis" c_tgraph_tgraphgetxaxis :: (Ptr RawTGraph) -> IO (Ptr RawTAxis) foreign import ccall "HROOTTGraph.h TGraph_tGraphGetYaxis" c_tgraph_tgraphgetyaxis :: (Ptr RawTGraph) -> IO (Ptr RawTAxis) foreign import ccall "HROOTTGraph.h TGraph_InitExpo" c_tgraph_initexpo :: (Ptr RawTGraph) -> CDouble -> CDouble -> IO () foreign import ccall "HROOTTGraph.h TGraph_InitGaus" c_tgraph_initgaus :: (Ptr RawTGraph) -> CDouble -> CDouble -> IO () foreign import ccall "HROOTTGraph.h TGraph_InitPolynom" c_tgraph_initpolynom :: (Ptr RawTGraph) -> CDouble -> CDouble -> IO () foreign import ccall "HROOTTGraph.h TGraph_InsertPoint" c_tgraph_insertpoint :: (Ptr RawTGraph) -> IO CInt foreign import ccall "HROOTTGraph.h TGraph_integralTGraph" c_tgraph_integraltgraph :: (Ptr RawTGraph) -> CInt -> CInt -> IO CDouble foreign import ccall "HROOTTGraph.h TGraph_IsEditable" c_tgraph_iseditable :: (Ptr RawTGraph) -> IO CInt foreign import ccall "HROOTTGraph.h TGraph_isInsideTGraph" c_tgraph_isinsidetgraph :: (Ptr RawTGraph) -> CDouble -> CDouble -> IO CInt foreign import ccall "HROOTTGraph.h TGraph_LeastSquareFit" c_tgraph_leastsquarefit :: (Ptr RawTGraph) -> CInt -> (Ptr CDouble) -> CDouble -> CDouble -> IO () foreign import ccall "HROOTTGraph.h TGraph_tGraphPaintGraph" c_tgraph_tgraphpaintgraph :: (Ptr RawTGraph) -> CInt -> (Ptr CDouble) -> (Ptr CDouble) -> CString -> IO () foreign import ccall "HROOTTGraph.h TGraph_tGraphPaintGrapHist" c_tgraph_tgraphpaintgraphist :: (Ptr RawTGraph) -> CInt -> (Ptr CDouble) -> (Ptr CDouble) -> CString -> IO () foreign import ccall "HROOTTGraph.h TGraph_PaintStats" c_tgraph_paintstats :: (Ptr RawTGraph) -> (Ptr RawTF1) -> IO () foreign import ccall "HROOTTGraph.h TGraph_RemovePoint" c_tgraph_removepoint :: (Ptr RawTGraph) -> CInt -> IO CInt foreign import ccall "HROOTTGraph.h TGraph_SetEditable" c_tgraph_seteditable :: (Ptr RawTGraph) -> CInt -> IO () foreign import ccall "HROOTTGraph.h TGraph_SetHistogram" c_tgraph_sethistogram :: (Ptr RawTGraph) -> (Ptr RawTH1F) -> IO () foreign import ccall "HROOTTGraph.h TGraph_setMaximumTGraph" c_tgraph_setmaximumtgraph :: (Ptr RawTGraph) -> CDouble -> IO () foreign import ccall "HROOTTGraph.h TGraph_setMinimumTGraph" c_tgraph_setminimumtgraph :: (Ptr RawTGraph) -> CDouble -> IO () foreign import ccall "HROOTTGraph.h TGraph_Set" c_tgraph_set :: (Ptr RawTGraph) -> CInt -> IO () foreign import ccall "HROOTTGraph.h TGraph_SetPoint" c_tgraph_setpoint :: (Ptr RawTGraph) -> CInt -> CDouble -> CDouble -> IO ()