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

module HROOT.Class.TH2.Implementation where


import HROOT.TypeCast

import HROOT.Class.TH2.RawType
import HROOT.Class.TH2.FFI
import HROOT.Class.TH2.Interface
import HROOT.Class.TH2.Cast
import HROOT.Class.TDirectory.RawType
import HROOT.Class.TDirectory.Cast
import HROOT.Class.TDirectory.Interface
import HROOT.Class.TF1.RawType
import HROOT.Class.TF1.Cast
import HROOT.Class.TF1.Interface
import HROOT.Class.TArrayD.RawType
import HROOT.Class.TArrayD.Cast
import HROOT.Class.TArrayD.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.TH1D.RawType
import HROOT.Class.TH1D.Cast
import HROOT.Class.TH1D.Interface
import HROOT.Class.TObjArray.RawType
import HROOT.Class.TObjArray.Cast
import HROOT.Class.TObjArray.Interface
import HROOT.Class.TH1.RawType
import HROOT.Class.TH1.Cast
import HROOT.Class.TH1.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 ITH2 TH2 where
  fill2 = xform2 c_th2_fill2
  fill2w = xform3 c_th2_fill2w
  fillN2 = xform5 c_th2_filln2
  fillRandom2 = xform2 c_th2_fillrandom2
  findFirstBinAbove2 = xform2 c_th2_findfirstbinabove2
  findLastBinAbove2 = xform2 c_th2_findlastbinabove2
  fitSlicesX = xform6 c_th2_fitslicesx
  fitSlicesY = xform6 c_th2_fitslicesy
  getCorrelationFactor2 = xform2 c_th2_getcorrelationfactor2
  getCovariance2 = xform2 c_th2_getcovariance2
  integral2 = xform5 c_th2_integral2
  rebinX2 = xform2 c_th2_rebinx2
  rebinY2 = xform2 c_th2_rebiny2
  rebin2D = xform3 c_th2_rebin2d
  setShowProjectionX = xform1 c_th2_setshowprojectionx
  setShowProjectionY = xform1 c_th2_setshowprojectiony
instance ITH1 TH2 where
  add = xform2 c_th2_add
  addBinContent = xform2 c_th2_addbincontent
  chi2Test = xform3 c_th2_chi2test
  computeIntegral = xform0 c_th2_computeintegral
  directoryAutoAdd = xform1 c_th2_directoryautoadd
  divide = xform5 c_th2_divide
  drawCopyTH1 = xform1 c_th2_drawcopyth1
  drawNormalized = xform2 c_th2_drawnormalized
  drawPanelTH1 = xform0 c_th2_drawpanelth1
  bufferEmpty = xform1 c_th2_bufferempty
  evalF = xform2 c_th2_evalf
  fFT = xform2 c_th2_fft
  fill1 = xform1 c_th2_fill1
  fill1w = xform2 c_th2_fill1w
  fillN1 = xform4 c_th2_filln1
  fillRandom = xform2 c_th2_fillrandom
  findBin = xform3 c_th2_findbin
  findFixBin = xform3 c_th2_findfixbin
  findFirstBinAbove = xform2 c_th2_findfirstbinabove
  findLastBinAbove = xform2 c_th2_findlastbinabove
  fitPanelTH1 = xform0 c_th2_fitpanelth1
  getNdivisionA = xform1 c_th2_getndivisiona
  getAxisColorA = xform1 c_th2_getaxiscolora
  getLabelColorA = xform1 c_th2_getlabelcolora
  getLabelFontA = xform1 c_th2_getlabelfonta
  getLabelOffsetA = xform1 c_th2_getlabeloffseta
  getLabelSizeA = xform1 c_th2_getlabelsizea
  getTitleFontA = xform1 c_th2_gettitlefonta
  getTitleOffsetA = xform1 c_th2_gettitleoffseta
  getTitleSizeA = xform1 c_th2_gettitlesizea
  getTickLengthA = xform1 c_th2_getticklengtha
  getBarOffset = xform0 c_th2_getbaroffset
  getBarWidth = xform0 c_th2_getbarwidth
  getContour = xform1 c_th2_getcontour
  getContourLevel = xform1 c_th2_getcontourlevel
  getContourLevelPad = xform1 c_th2_getcontourlevelpad
  getBin = xform3 c_th2_getbin
  getBinCenter = xform1 c_th2_getbincenter
  getBinContent1 = xform1 c_th2_getbincontent1
  getBinContent2 = xform2 c_th2_getbincontent2
  getBinContent3 = xform3 c_th2_getbincontent3
  getBinError1 = xform1 c_th2_getbinerror1
  getBinError2 = xform2 c_th2_getbinerror2
  getBinError3 = xform3 c_th2_getbinerror3
  getBinLowEdge = xform1 c_th2_getbinlowedge
  getBinWidth = xform1 c_th2_getbinwidth
  getCellContent = xform2 c_th2_getcellcontent
  getCellError = xform2 c_th2_getcellerror
  getEntries = xform0 c_th2_getentries
  getEffectiveEntries = xform0 c_th2_geteffectiveentries
  getFunction = xform1 c_th2_getfunction
  getDimension = xform0 c_th2_getdimension
  getKurtosis = xform1 c_th2_getkurtosis
  getLowEdge = xform1 c_th2_getlowedge
  getMaximumTH1 = xform1 c_th2_getmaximumth1
  getMaximumBin = xform0 c_th2_getmaximumbin
  getMaximumStored = xform0 c_th2_getmaximumstored
  getMinimumTH1 = xform1 c_th2_getminimumth1
  getMinimumBin = xform0 c_th2_getminimumbin
  getMinimumStored = xform0 c_th2_getminimumstored
  getMean = xform1 c_th2_getmean
  getMeanError = xform1 c_th2_getmeanerror
  getNbinsX = xform0 c_th2_getnbinsx
  getNbinsY = xform0 c_th2_getnbinsy
  getNbinsZ = xform0 c_th2_getnbinsz
  getQuantilesTH1 = xform3 c_th2_getquantilesth1
  getRandom = xform0 c_th2_getrandom
  getStats = xform1 c_th2_getstats
  getSumOfWeights = xform0 c_th2_getsumofweights
  getSumw2 = xform0 c_th2_getsumw2
  getSumw2N = xform0 c_th2_getsumw2n
  getRMS = xform1 c_th2_getrms
  getRMSError = xform1 c_th2_getrmserror
  getSkewness = xform1 c_th2_getskewness
  integral1 = xform3 c_th2_integral1
  interpolate1 = xform1 c_th2_interpolate1
  interpolate2 = xform2 c_th2_interpolate2
  interpolate3 = xform3 c_th2_interpolate3
  kolmogorovTest = xform2 c_th2_kolmogorovtest
  labelsDeflate = xform1 c_th2_labelsdeflate
  labelsInflate = xform1 c_th2_labelsinflate
  labelsOption = xform2 c_th2_labelsoption
  multiflyF = xform2 c_th2_multiflyf
  multiply = xform5 c_th2_multiply
  putStats = xform1 c_th2_putstats
  rebin = xform3 c_th2_rebin
  rebinAxis = xform2 c_th2_rebinaxis
  rebuild = xform1 c_th2_rebuild
  reset = xform1 c_th2_reset
  resetStats = xform0 c_th2_resetstats
  scale = xform2 c_th2_scale
  setAxisColorA = xform2 c_th2_setaxiscolora
  setAxisRange = xform3 c_th2_setaxisrange
  setBarOffset = xform1 c_th2_setbaroffset
  setBarWidth = xform1 c_th2_setbarwidth
  setBinContent1 = xform2 c_th2_setbincontent1
  setBinContent2 = xform3 c_th2_setbincontent2
  setBinContent3 = xform4 c_th2_setbincontent3
  setBinError1 = xform2 c_th2_setbinerror1
  setBinError2 = xform3 c_th2_setbinerror2
  setBinError3 = xform4 c_th2_setbinerror3
  setBins1 = xform2 c_th2_setbins1
  setBins2 = xform4 c_th2_setbins2
  setBins3 = xform6 c_th2_setbins3
  setBinsLength = xform1 c_th2_setbinslength
  setBuffer = xform2 c_th2_setbuffer
  setCellContent = xform3 c_th2_setcellcontent
  setContent = xform1 c_th2_setcontent
  setContour = xform2 c_th2_setcontour
  setContourLevel = xform2 c_th2_setcontourlevel
  setDirectory = xform1 c_th2_setdirectory
  setEntries = xform1 c_th2_setentries
  setError = xform1 c_th2_seterror
  setLabelColorA = xform2 c_th2_setlabelcolora
  setLabelSizeA = xform2 c_th2_setlabelsizea
  setLabelFontA = xform2 c_th2_setlabelfonta
  setLabelOffsetA = xform2 c_th2_setlabeloffseta
  setMaximum = xform1 c_th2_setmaximum
  setMinimum = xform1 c_th2_setminimum
  setNormFactor = xform1 c_th2_setnormfactor
  setStats = xform1 c_th2_setstats
  setOption = xform1 c_th2_setoption
  setXTitle = xform1 c_th2_setxtitle
  setYTitle = xform1 c_th2_setytitle
  setZTitle = xform1 c_th2_setztitle
  showBackground = xform2 c_th2_showbackground
  showPeaks = xform3 c_th2_showpeaks
  smooth = xform2 c_th2_smooth
  sumw2 = xform0 c_th2_sumw2
instance ITNamed TH2 where
  setName = xform1 c_th2_setname
  setNameTitle = xform2 c_th2_setnametitle
  setTitle = xform1 c_th2_settitle
instance ITAttLine TH2 where
  getLineColor = xform0 c_th2_getlinecolor
  getLineStyle = xform0 c_th2_getlinestyle
  getLineWidth = xform0 c_th2_getlinewidth
  resetAttLine = xform1 c_th2_resetattline
  setLineAttributes = xform0 c_th2_setlineattributes
  setLineColor = xform1 c_th2_setlinecolor
  setLineStyle = xform1 c_th2_setlinestyle
  setLineWidth = xform1 c_th2_setlinewidth
instance ITAttFill TH2 where
  setFillColor = xform1 c_th2_setfillcolor
  setFillStyle = xform1 c_th2_setfillstyle
instance ITAttMarker TH2 where
  getMarkerColor = xform0 c_th2_getmarkercolor
  getMarkerStyle = xform0 c_th2_getmarkerstyle
  getMarkerSize = xform0 c_th2_getmarkersize
  resetAttMarker = xform1 c_th2_resetattmarker
  setMarkerAttributes = xform0 c_th2_setmarkerattributes
  setMarkerColor = xform1 c_th2_setmarkercolor
  setMarkerStyle = xform1 c_th2_setmarkerstyle
  setMarkerSize = xform1 c_th2_setmarkersize
instance ITObject TH2 where
  draw = xform1 c_th2_draw
  findObject = xform1 c_th2_findobject
  getName = xform0 c_th2_getname
  isA = xform0 c_th2_isa
  isFolder = xform0 c_th2_isfolder
  isEqual = xform1 c_th2_isequal
  isSortable = xform0 c_th2_issortable
  paint = xform1 c_th2_paint
  printObj = xform1 c_th2_printobj
  recursiveRemove = xform1 c_th2_recursiveremove
  saveAs = xform2 c_th2_saveas
  useCurrentStyle = xform0 c_th2_usecurrentstyle
  write = xform3 c_th2_write
instance IDeletable TH2 where
  delete = xform0 c_th2_delete

instance ITH2 (Exist TH2) where
  fill2 (ETH2 x) = fill2 x
  fill2w (ETH2 x) = fill2w x
  fillN2 (ETH2 x) = fillN2 x
  fillRandom2 (ETH2 x) = fillRandom2 x
  findFirstBinAbove2 (ETH2 x) = findFirstBinAbove2 x
  findLastBinAbove2 (ETH2 x) = findLastBinAbove2 x
  fitSlicesX (ETH2 x) = fitSlicesX x
  fitSlicesY (ETH2 x) = fitSlicesY x
  getCorrelationFactor2 (ETH2 x) = getCorrelationFactor2 x
  getCovariance2 (ETH2 x) = getCovariance2 x
  integral2 (ETH2 x) = integral2 x
  rebinX2 (ETH2 x) = rebinX2 x
  rebinY2 (ETH2 x) = rebinY2 x
  rebin2D (ETH2 x) = rebin2D x
  setShowProjectionX (ETH2 x) = setShowProjectionX x
  setShowProjectionY (ETH2 x) = setShowProjectionY x
instance ITH1 (Exist TH2) where
  add (ETH2 x) = add x
  addBinContent (ETH2 x) = addBinContent x
  chi2Test (ETH2 x) = chi2Test x
  computeIntegral (ETH2 x) = computeIntegral x
  directoryAutoAdd (ETH2 x) = directoryAutoAdd x
  divide (ETH2 x) = divide x
  drawCopyTH1 (ETH2 x) a1 = return . ETH2 =<< drawCopyTH1 x a1
  drawNormalized (ETH2 x) = drawNormalized x
  drawPanelTH1 (ETH2 x) = drawPanelTH1 x
  bufferEmpty (ETH2 x) = bufferEmpty x
  evalF (ETH2 x) = evalF x
  fFT (ETH2 x) = fFT x
  fill1 (ETH2 x) = fill1 x
  fill1w (ETH2 x) = fill1w x
  fillN1 (ETH2 x) = fillN1 x
  fillRandom (ETH2 x) = fillRandom x
  findBin (ETH2 x) = findBin x
  findFixBin (ETH2 x) = findFixBin x
  findFirstBinAbove (ETH2 x) = findFirstBinAbove x
  findLastBinAbove (ETH2 x) = findLastBinAbove x
  fitPanelTH1 (ETH2 x) = fitPanelTH1 x
  getNdivisionA (ETH2 x) = getNdivisionA x
  getAxisColorA (ETH2 x) = getAxisColorA x
  getLabelColorA (ETH2 x) = getLabelColorA x
  getLabelFontA (ETH2 x) = getLabelFontA x
  getLabelOffsetA (ETH2 x) = getLabelOffsetA x
  getLabelSizeA (ETH2 x) = getLabelSizeA x
  getTitleFontA (ETH2 x) = getTitleFontA x
  getTitleOffsetA (ETH2 x) = getTitleOffsetA x
  getTitleSizeA (ETH2 x) = getTitleSizeA x
  getTickLengthA (ETH2 x) = getTickLengthA x
  getBarOffset (ETH2 x) = getBarOffset x
  getBarWidth (ETH2 x) = getBarWidth x
  getContour (ETH2 x) = getContour x
  getContourLevel (ETH2 x) = getContourLevel x
  getContourLevelPad (ETH2 x) = getContourLevelPad x
  getBin (ETH2 x) = getBin x
  getBinCenter (ETH2 x) = getBinCenter x
  getBinContent1 (ETH2 x) = getBinContent1 x
  getBinContent2 (ETH2 x) = getBinContent2 x
  getBinContent3 (ETH2 x) = getBinContent3 x
  getBinError1 (ETH2 x) = getBinError1 x
  getBinError2 (ETH2 x) = getBinError2 x
  getBinError3 (ETH2 x) = getBinError3 x
  getBinLowEdge (ETH2 x) = getBinLowEdge x
  getBinWidth (ETH2 x) = getBinWidth x
  getCellContent (ETH2 x) = getCellContent x
  getCellError (ETH2 x) = getCellError x
  getEntries (ETH2 x) = getEntries x
  getEffectiveEntries (ETH2 x) = getEffectiveEntries x
  getFunction (ETH2 x) = getFunction x
  getDimension (ETH2 x) = getDimension x
  getKurtosis (ETH2 x) = getKurtosis x
  getLowEdge (ETH2 x) = getLowEdge x
  getMaximumTH1 (ETH2 x) = getMaximumTH1 x
  getMaximumBin (ETH2 x) = getMaximumBin x
  getMaximumStored (ETH2 x) = getMaximumStored x
  getMinimumTH1 (ETH2 x) = getMinimumTH1 x
  getMinimumBin (ETH2 x) = getMinimumBin x
  getMinimumStored (ETH2 x) = getMinimumStored x
  getMean (ETH2 x) = getMean x
  getMeanError (ETH2 x) = getMeanError x
  getNbinsX (ETH2 x) = getNbinsX x
  getNbinsY (ETH2 x) = getNbinsY x
  getNbinsZ (ETH2 x) = getNbinsZ x
  getQuantilesTH1 (ETH2 x) = getQuantilesTH1 x
  getRandom (ETH2 x) = getRandom x
  getStats (ETH2 x) = getStats x
  getSumOfWeights (ETH2 x) = getSumOfWeights x
  getSumw2 (ETH2 x) = getSumw2 x
  getSumw2N (ETH2 x) = getSumw2N x
  getRMS (ETH2 x) = getRMS x
  getRMSError (ETH2 x) = getRMSError x
  getSkewness (ETH2 x) = getSkewness x
  integral1 (ETH2 x) = integral1 x
  interpolate1 (ETH2 x) = interpolate1 x
  interpolate2 (ETH2 x) = interpolate2 x
  interpolate3 (ETH2 x) = interpolate3 x
  kolmogorovTest (ETH2 x) = kolmogorovTest x
  labelsDeflate (ETH2 x) = labelsDeflate x
  labelsInflate (ETH2 x) = labelsInflate x
  labelsOption (ETH2 x) = labelsOption x
  multiflyF (ETH2 x) = multiflyF x
  multiply (ETH2 x) = multiply x
  putStats (ETH2 x) = putStats x
  rebin (ETH2 x) = rebin x
  rebinAxis (ETH2 x) = rebinAxis x
  rebuild (ETH2 x) = rebuild x
  reset (ETH2 x) = reset x
  resetStats (ETH2 x) = resetStats x
  scale (ETH2 x) = scale x
  setAxisColorA (ETH2 x) = setAxisColorA x
  setAxisRange (ETH2 x) = setAxisRange x
  setBarOffset (ETH2 x) = setBarOffset x
  setBarWidth (ETH2 x) = setBarWidth x
  setBinContent1 (ETH2 x) = setBinContent1 x
  setBinContent2 (ETH2 x) = setBinContent2 x
  setBinContent3 (ETH2 x) = setBinContent3 x
  setBinError1 (ETH2 x) = setBinError1 x
  setBinError2 (ETH2 x) = setBinError2 x
  setBinError3 (ETH2 x) = setBinError3 x
  setBins1 (ETH2 x) = setBins1 x
  setBins2 (ETH2 x) = setBins2 x
  setBins3 (ETH2 x) = setBins3 x
  setBinsLength (ETH2 x) = setBinsLength x
  setBuffer (ETH2 x) = setBuffer x
  setCellContent (ETH2 x) = setCellContent x
  setContent (ETH2 x) = setContent x
  setContour (ETH2 x) = setContour x
  setContourLevel (ETH2 x) = setContourLevel x
  setDirectory (ETH2 x) = setDirectory x
  setEntries (ETH2 x) = setEntries x
  setError (ETH2 x) = setError x
  setLabelColorA (ETH2 x) = setLabelColorA x
  setLabelSizeA (ETH2 x) = setLabelSizeA x
  setLabelFontA (ETH2 x) = setLabelFontA x
  setLabelOffsetA (ETH2 x) = setLabelOffsetA x
  setMaximum (ETH2 x) = setMaximum x
  setMinimum (ETH2 x) = setMinimum x
  setNormFactor (ETH2 x) = setNormFactor x
  setStats (ETH2 x) = setStats x
  setOption (ETH2 x) = setOption x
  setXTitle (ETH2 x) = setXTitle x
  setYTitle (ETH2 x) = setYTitle x
  setZTitle (ETH2 x) = setZTitle x
  showBackground (ETH2 x) = showBackground x
  showPeaks (ETH2 x) = showPeaks x
  smooth (ETH2 x) = smooth x
  sumw2 (ETH2 x) = sumw2 x
instance ITNamed (Exist TH2) where
  setName (ETH2 x) = setName x
  setNameTitle (ETH2 x) = setNameTitle x
  setTitle (ETH2 x) = setTitle x
instance ITAttLine (Exist TH2) where
  getLineColor (ETH2 x) = getLineColor x
  getLineStyle (ETH2 x) = getLineStyle x
  getLineWidth (ETH2 x) = getLineWidth x
  resetAttLine (ETH2 x) = resetAttLine x
  setLineAttributes (ETH2 x) = setLineAttributes x
  setLineColor (ETH2 x) = setLineColor x
  setLineStyle (ETH2 x) = setLineStyle x
  setLineWidth (ETH2 x) = setLineWidth x
instance ITAttFill (Exist TH2) where
  setFillColor (ETH2 x) = setFillColor x
  setFillStyle (ETH2 x) = setFillStyle x
instance ITAttMarker (Exist TH2) where
  getMarkerColor (ETH2 x) = getMarkerColor x
  getMarkerStyle (ETH2 x) = getMarkerStyle x
  getMarkerSize (ETH2 x) = getMarkerSize x
  resetAttMarker (ETH2 x) = resetAttMarker x
  setMarkerAttributes (ETH2 x) = setMarkerAttributes x
  setMarkerColor (ETH2 x) = setMarkerColor x
  setMarkerStyle (ETH2 x) = setMarkerStyle x
  setMarkerSize (ETH2 x) = setMarkerSize x
instance ITObject (Exist TH2) where
  draw (ETH2 x) = draw x
  findObject (ETH2 x) = findObject x
  getName (ETH2 x) = getName x
  isA (ETH2 x) = isA x
  isFolder (ETH2 x) = isFolder x
  isEqual (ETH2 x) = isEqual x
  isSortable (ETH2 x) = isSortable x
  paint (ETH2 x) = paint x
  printObj (ETH2 x) = printObj x
  recursiveRemove (ETH2 x) = recursiveRemove x
  saveAs (ETH2 x) = saveAs x
  useCurrentStyle (ETH2 x) = useCurrentStyle x
  write (ETH2 x) = write x
instance IDeletable (Exist TH2) where
  delete (ETH2 x) = delete x



tH2ProjectionX :: TH2 -> String -> Int -> Int -> String -> IO TH1D
tH2ProjectionX = xform4 c_th2_th2projectionx

tH2ProjectionY :: TH2 -> String -> Int -> Int -> String -> IO TH1D
tH2ProjectionY = xform4 c_th2_th2projectiony



instance FPtr (Exist TH2) where
  type Raw (Exist TH2) = RawTH2
  get_fptr (ETH2 obj) = castForeignPtr (get_fptr obj)
  cast_fptr_to_obj fptr = ETH2 (cast_fptr_to_obj (fptr :: ForeignPtr RawTH2) :: TH2)