{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, 
             FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, 
             OverlappingInstances, IncoherentInstances #-}

module HROOT.Class.TGraphQQ.Implementation where


import HROOT.TypeCast

import HROOT.Class.TGraphQQ.RawType
import HROOT.Class.TGraphQQ.FFI
import HROOT.Class.TGraphQQ.Interface
import HROOT.Class.TGraphQQ.Cast
import HROOT.Class.TF1.RawType
import HROOT.Class.TF1.Cast
import HROOT.Class.TF1.Interface
import HROOT.Class.TH1F.RawType
import HROOT.Class.TH1F.Cast
import HROOT.Class.TH1F.Interface
import HROOT.Class.TList.RawType
import HROOT.Class.TList.Cast
import HROOT.Class.TList.Interface
import HROOT.Class.TAxis.RawType
import HROOT.Class.TAxis.Cast
import HROOT.Class.TAxis.Interface
import HROOT.Class.TClass.RawType
import HROOT.Class.TClass.Cast
import HROOT.Class.TClass.Interface
import HROOT.Class.TGraph.RawType
import HROOT.Class.TGraph.Cast
import HROOT.Class.TGraph.Interface
import HROOT.Class.TNamed.RawType
import HROOT.Class.TNamed.Cast
import HROOT.Class.TNamed.Interface
import HROOT.Class.TAttLine.RawType
import HROOT.Class.TAttLine.Cast
import HROOT.Class.TAttLine.Interface
import HROOT.Class.TAttFill.RawType
import HROOT.Class.TAttFill.Cast
import HROOT.Class.TAttFill.Interface
import HROOT.Class.TAttMarker.RawType
import HROOT.Class.TAttMarker.Cast
import HROOT.Class.TAttMarker.Interface
import HROOT.Class.TObject.RawType
import HROOT.Class.TObject.Cast
import HROOT.Class.TObject.Interface
import HROOT.Class.Deletable.RawType
import HROOT.Class.Deletable.Cast
import HROOT.Class.Deletable.Interface

import Data.Word
-- import Foreign.C            
-- import Foreign.Ptr
import Foreign.ForeignPtr

import System.IO.Unsafe


instance ITGraphQQ TGraphQQ where
instance ITGraph TGraphQQ where
  apply = xform1 c_tgraphqq_apply
  chisquare = xform1 c_tgraphqq_chisquare
  drawGraph = xform4 c_tgraphqq_drawgraph
  drawPanelTGraph = xform0 c_tgraphqq_drawpaneltgraph
  expand = xform2 c_tgraphqq_expand
  fitPanelTGraph = xform0 c_tgraphqq_fitpaneltgraph
  getCorrelationFactorTGraph = xform0 c_tgraphqq_getcorrelationfactortgraph
  getCovarianceTGraph = xform0 c_tgraphqq_getcovariancetgraph
  getMeanTGraph = xform1 c_tgraphqq_getmeantgraph
  getRMSTGraph = xform1 c_tgraphqq_getrmstgraph
  getErrorX = xform1 c_tgraphqq_geterrorx
  getErrorY = xform1 c_tgraphqq_geterrory
  getErrorXhigh = xform1 c_tgraphqq_geterrorxhigh
  getErrorXlow = xform1 c_tgraphqq_geterrorxlow
  getErrorYhigh = xform1 c_tgraphqq_geterroryhigh
  getErrorYlow = xform1 c_tgraphqq_geterrorylow
  initExpo = xform2 c_tgraphqq_initexpo
  initGaus = xform2 c_tgraphqq_initgaus
  initPolynom = xform2 c_tgraphqq_initpolynom
  insertPoint = xform0 c_tgraphqq_insertpoint
  integralTGraph = xform2 c_tgraphqq_integraltgraph
  isEditable = xform0 c_tgraphqq_iseditable
  isInsideTGraph = xform2 c_tgraphqq_isinsidetgraph
  leastSquareFit = xform4 c_tgraphqq_leastsquarefit
  paintStats = xform1 c_tgraphqq_paintstats
  removePoint = xform1 c_tgraphqq_removepoint
  setEditable = xform1 c_tgraphqq_seteditable
  setHistogram = xform1 c_tgraphqq_sethistogram
  setMaximumTGraph = xform1 c_tgraphqq_setmaximumtgraph
  setMinimumTGraph = xform1 c_tgraphqq_setminimumtgraph
  set = xform1 c_tgraphqq_set
  setPoint = xform3 c_tgraphqq_setpoint
instance ITNamed TGraphQQ where
  setName = xform1 c_tgraphqq_setname
  setNameTitle = xform2 c_tgraphqq_setnametitle
  setTitle = xform1 c_tgraphqq_settitle
instance ITAttLine TGraphQQ where
  getLineColor = xform0 c_tgraphqq_getlinecolor
  getLineStyle = xform0 c_tgraphqq_getlinestyle
  getLineWidth = xform0 c_tgraphqq_getlinewidth
  resetAttLine = xform1 c_tgraphqq_resetattline
  setLineAttributes = xform0 c_tgraphqq_setlineattributes
  setLineColor = xform1 c_tgraphqq_setlinecolor
  setLineStyle = xform1 c_tgraphqq_setlinestyle
  setLineWidth = xform1 c_tgraphqq_setlinewidth
instance ITAttFill TGraphQQ where
  setFillColor = xform1 c_tgraphqq_setfillcolor
  setFillStyle = xform1 c_tgraphqq_setfillstyle
instance ITAttMarker TGraphQQ where
  getMarkerColor = xform0 c_tgraphqq_getmarkercolor
  getMarkerStyle = xform0 c_tgraphqq_getmarkerstyle
  getMarkerSize = xform0 c_tgraphqq_getmarkersize
  resetAttMarker = xform1 c_tgraphqq_resetattmarker
  setMarkerAttributes = xform0 c_tgraphqq_setmarkerattributes
  setMarkerColor = xform1 c_tgraphqq_setmarkercolor
  setMarkerStyle = xform1 c_tgraphqq_setmarkerstyle
  setMarkerSize = xform1 c_tgraphqq_setmarkersize
instance ITObject TGraphQQ where
  draw = xform1 c_tgraphqq_draw
  findObject = xform1 c_tgraphqq_findobject
  getName = xform0 c_tgraphqq_getname
  isA = xform0 c_tgraphqq_isa
  isFolder = xform0 c_tgraphqq_isfolder
  isEqual = xform1 c_tgraphqq_isequal
  isSortable = xform0 c_tgraphqq_issortable
  paint = xform1 c_tgraphqq_paint
  printObj = xform1 c_tgraphqq_printobj
  recursiveRemove = xform1 c_tgraphqq_recursiveremove
  saveAs = xform2 c_tgraphqq_saveas
  useCurrentStyle = xform0 c_tgraphqq_usecurrentstyle
  write = xform3 c_tgraphqq_write
instance IDeletable TGraphQQ where
  delete = xform0 c_tgraphqq_delete

instance ITGraphQQ (Exist TGraphQQ) where

instance ITGraph (Exist TGraphQQ) where
  apply (ETGraphQQ x) = apply x
  chisquare (ETGraphQQ x) = chisquare x
  drawGraph (ETGraphQQ x) = drawGraph x
  drawPanelTGraph (ETGraphQQ x) = drawPanelTGraph x
  expand (ETGraphQQ x) = expand x
  fitPanelTGraph (ETGraphQQ x) = fitPanelTGraph x
  getCorrelationFactorTGraph (ETGraphQQ x) = getCorrelationFactorTGraph x
  getCovarianceTGraph (ETGraphQQ x) = getCovarianceTGraph x
  getMeanTGraph (ETGraphQQ x) = getMeanTGraph x
  getRMSTGraph (ETGraphQQ x) = getRMSTGraph x
  getErrorX (ETGraphQQ x) = getErrorX x
  getErrorY (ETGraphQQ x) = getErrorY x
  getErrorXhigh (ETGraphQQ x) = getErrorXhigh x
  getErrorXlow (ETGraphQQ x) = getErrorXlow x
  getErrorYhigh (ETGraphQQ x) = getErrorYhigh x
  getErrorYlow (ETGraphQQ x) = getErrorYlow x
  initExpo (ETGraphQQ x) = initExpo x
  initGaus (ETGraphQQ x) = initGaus x
  initPolynom (ETGraphQQ x) = initPolynom x
  insertPoint (ETGraphQQ x) = insertPoint x
  integralTGraph (ETGraphQQ x) = integralTGraph x
  isEditable (ETGraphQQ x) = isEditable x
  isInsideTGraph (ETGraphQQ x) = isInsideTGraph x
  leastSquareFit (ETGraphQQ x) = leastSquareFit x
  paintStats (ETGraphQQ x) = paintStats x
  removePoint (ETGraphQQ x) = removePoint x
  setEditable (ETGraphQQ x) = setEditable x
  setHistogram (ETGraphQQ x) = setHistogram x
  setMaximumTGraph (ETGraphQQ x) = setMaximumTGraph x
  setMinimumTGraph (ETGraphQQ x) = setMinimumTGraph x
  set (ETGraphQQ x) = set x
  setPoint (ETGraphQQ x) = setPoint x
instance ITNamed (Exist TGraphQQ) where
  setName (ETGraphQQ x) = setName x
  setNameTitle (ETGraphQQ x) = setNameTitle x
  setTitle (ETGraphQQ x) = setTitle x
instance ITAttLine (Exist TGraphQQ) where
  getLineColor (ETGraphQQ x) = getLineColor x
  getLineStyle (ETGraphQQ x) = getLineStyle x
  getLineWidth (ETGraphQQ x) = getLineWidth x
  resetAttLine (ETGraphQQ x) = resetAttLine x
  setLineAttributes (ETGraphQQ x) = setLineAttributes x
  setLineColor (ETGraphQQ x) = setLineColor x
  setLineStyle (ETGraphQQ x) = setLineStyle x
  setLineWidth (ETGraphQQ x) = setLineWidth x
instance ITAttFill (Exist TGraphQQ) where
  setFillColor (ETGraphQQ x) = setFillColor x
  setFillStyle (ETGraphQQ x) = setFillStyle x
instance ITAttMarker (Exist TGraphQQ) where
  getMarkerColor (ETGraphQQ x) = getMarkerColor x
  getMarkerStyle (ETGraphQQ x) = getMarkerStyle x
  getMarkerSize (ETGraphQQ x) = getMarkerSize x
  resetAttMarker (ETGraphQQ x) = resetAttMarker x
  setMarkerAttributes (ETGraphQQ x) = setMarkerAttributes x
  setMarkerColor (ETGraphQQ x) = setMarkerColor x
  setMarkerStyle (ETGraphQQ x) = setMarkerStyle x
  setMarkerSize (ETGraphQQ x) = setMarkerSize x
instance ITObject (Exist TGraphQQ) where
  draw (ETGraphQQ x) = draw x
  findObject (ETGraphQQ x) = findObject x
  getName (ETGraphQQ x) = getName x
  isA (ETGraphQQ x) = isA x
  isFolder (ETGraphQQ x) = isFolder x
  isEqual (ETGraphQQ x) = isEqual x
  isSortable (ETGraphQQ x) = isSortable x
  paint (ETGraphQQ x) = paint x
  printObj (ETGraphQQ x) = printObj x
  recursiveRemove (ETGraphQQ x) = recursiveRemove x
  saveAs (ETGraphQQ x) = saveAs x
  useCurrentStyle (ETGraphQQ x) = useCurrentStyle x
  write (ETGraphQQ x) = write x
instance IDeletable (Exist TGraphQQ) where
  delete (ETGraphQQ x) = delete x


newTGraphQQ :: Int -> [Double] -> Int -> [Double] -> IO TGraphQQ
newTGraphQQ = xform3 c_tgraphqq_newtgraphqq





instance FPtr (Exist TGraphQQ) where
  type Raw (Exist TGraphQQ) = RawTGraphQQ
  get_fptr (ETGraphQQ obj) = castForeignPtr (get_fptr obj)
  cast_fptr_to_obj fptr = ETGraphQQ (cast_fptr_to_obj (fptr :: ForeignPtr RawTGraphQQ) :: TGraphQQ)