{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, 
             FlexibleInstances, TypeSynonymInstances, 
             EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-}

-- module HROOT.Class.Interface where

module HROOT.Hist.TF1.Interface where


import Data.Word
import Foreign.C
import Foreign.Ptr
import Foreign.ForeignPtr
import FFICXX.Runtime.Cast

import HROOT.Hist.TF1.RawType
import HROOT.Core.TObject.RawType
import HROOT.Hist.TH1.RawType
import HROOT.Hist.TAxis.RawType
import HROOT.Hist.TFormula.Interface
import HROOT.Core.TAttLine.Interface
import HROOT.Core.TAttFill.Interface
import HROOT.Core.TAttMarker.Interface
import HROOT.Core.TObject.Interface
---- ============ ----



class (ITFormula a,ITAttLine a,ITAttFill a,ITAttMarker a) => ITF1 a where

    derivative :: a -> CDouble -> (Ptr CDouble) -> CDouble -> IO CDouble 

    derivative2 :: a -> CDouble -> (Ptr CDouble) -> CDouble -> IO CDouble 

    derivative3 :: a -> CDouble -> (Ptr CDouble) -> CDouble -> IO CDouble 

    drawCopyTF1 :: a -> CString -> IO a 

    drawDerivative :: a -> CString -> IO TObject 

    drawIntegral :: a -> CString -> IO TObject 

    drawF1 :: a -> CString -> CDouble -> CDouble -> CString -> IO () 

    fixParameter :: a -> CInt -> CDouble -> IO () 

    getMaximumTF1 :: a -> CDouble -> CDouble -> CDouble -> CDouble -> CInt -> IO CDouble 

    getMinimumTF1 :: a -> CDouble -> CDouble -> CDouble -> CDouble -> CInt -> IO CDouble 

    getMaximumX :: a -> CDouble -> CDouble -> CDouble -> CDouble -> CInt -> IO CDouble 

    getMinimumX :: a -> CDouble -> CDouble -> CDouble -> CDouble -> CInt -> IO CDouble 

    getNDF :: a -> IO CInt 

    getNpx :: a -> IO CInt 

    getNumberFreeParameters :: a -> IO CInt 

    getNumberFitPoints :: a -> IO CInt 

    getParError :: a -> CInt -> IO CDouble 

    getProb :: a -> IO CDouble 

    getQuantilesTF1 :: a -> CInt -> (Ptr CDouble) -> (Ptr CDouble) -> IO CInt 

    getRandomTF1 :: a -> CDouble -> CDouble -> IO CDouble 

    getSave :: a -> (Ptr CDouble) -> IO CDouble 

    getX :: a -> CDouble -> CDouble -> CDouble -> CDouble -> CInt -> IO CDouble 

    getXmin :: a -> IO CDouble 

    getXmax :: a -> IO CDouble 

    gradientPar :: a -> CInt -> (Ptr CDouble) -> CDouble -> IO CDouble 

    initArgs :: a -> (Ptr CDouble) -> (Ptr CDouble) -> IO () 

    integralTF1 :: a -> CDouble -> CDouble -> (Ptr CDouble) -> CDouble -> IO CDouble 

    integralError :: a -> CDouble -> CDouble -> (Ptr CDouble) -> (Ptr CDouble) -> CDouble -> IO CDouble 

    integralFast :: a -> CInt -> (Ptr CDouble) -> (Ptr CDouble) -> CDouble -> CDouble -> (Ptr CDouble) -> CDouble -> IO CDouble 

    isInside :: a -> (Ptr CDouble) -> IO CInt 

    releaseParameter :: a -> CInt -> IO () 

    setChisquare :: a -> CDouble -> IO () 

    setMaximumTF1 :: a -> CDouble -> IO () 

    setMinimumTF1 :: a -> CDouble -> IO () 

    setNDF :: a -> CInt -> IO () 

    setNumberFitPoints :: a -> CInt -> IO () 

    setNpx :: a -> CInt -> IO () 

    setParError :: a -> CInt -> CDouble -> IO () 

    setParErrors :: a -> (Ptr CDouble) -> IO () 

    setParLimits :: a -> CInt -> CDouble -> CDouble -> IO () 

    setParent :: (ITObject c0, FPtr c0) => a -> c0 -> IO () 

    setRange1 :: a -> CDouble -> CDouble -> IO () 

    setRange2 :: a -> CDouble -> CDouble -> CDouble -> CDouble -> IO () 

    setRange3 :: a -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> IO () 

    setSavedPoint :: a -> CInt -> CDouble -> IO () 

    moment :: a -> CDouble -> CDouble -> CDouble -> (Ptr CDouble) -> CDouble -> IO CDouble 

    centralMoment :: a -> CDouble -> CDouble -> CDouble -> (Ptr CDouble) -> CDouble -> IO CDouble 

    mean :: a -> CDouble -> CDouble -> (Ptr CDouble) -> CDouble -> IO CDouble 

    variance :: a -> CDouble -> CDouble -> (Ptr CDouble) -> CDouble -> IO CDouble 

instance Existable TF1 where
  data Exist TF1 = forall a. (FPtr a, ITF1 a) => ETF1 a

upcastTF1 :: (FPtr a, ITF1 a) => a -> TF1
upcastTF1 h = let fh = get_fptr h
                  fh2 :: ForeignPtr RawTF1 = castForeignPtr fh
              in cast_fptr_to_obj fh2

downcastTF1 :: (FPtr a, ITF1 a) => TF1 -> a 
downcastTF1 h = let fh = get_fptr h
                    fh2 = castForeignPtr fh
                in cast_fptr_to_obj fh2