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

module HROOT.Class.TH3.Implementation where


import HROOT.TypeCast

import HROOT.Class.TH3.RawType
import HROOT.Class.TH3.FFI
import HROOT.Class.TH3.Interface
import HROOT.Class.TH3.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.TH1.RawType
import HROOT.Class.TH1.Cast
import HROOT.Class.TH1.Interface
import HROOT.Class.TAtt3D.RawType
import HROOT.Class.TAtt3D.Cast
import HROOT.Class.TAtt3D.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 ITH3 TH3 where
  fill3 = xform3 c_th3_fill3
  fill3w = xform4 c_th3_fill3w
  fitSlicesZ = xform7 c_th3_fitslicesz
  getCorrelationFactor3 = xform2 c_th3_getcorrelationfactor3
  getCovariance3 = xform2 c_th3_getcovariance3
  rebinX3 = xform2 c_th3_rebinx3
  rebinY3 = xform2 c_th3_rebiny3
  rebinZ3 = xform2 c_th3_rebinz3
  rebin3D = xform4 c_th3_rebin3d
instance ITH1 TH3 where
  add = xform2 c_th3_add
  addBinContent = xform2 c_th3_addbincontent
  chi2Test = xform3 c_th3_chi2test
  computeIntegral = xform0 c_th3_computeintegral
  directoryAutoAdd = xform1 c_th3_directoryautoadd
  divide = xform5 c_th3_divide
  drawCopyTH1 = xform1 c_th3_drawcopyth1
  drawNormalized = xform2 c_th3_drawnormalized
  drawPanelTH1 = xform0 c_th3_drawpanelth1
  bufferEmpty = xform1 c_th3_bufferempty
  evalF = xform2 c_th3_evalf
  fFT = xform2 c_th3_fft
  fill1 = xform1 c_th3_fill1
  fill1w = xform2 c_th3_fill1w
  fillN1 = xform4 c_th3_filln1
  fillRandom = xform2 c_th3_fillrandom
  findBin = xform3 c_th3_findbin
  findFixBin = xform3 c_th3_findfixbin
  findFirstBinAbove = xform2 c_th3_findfirstbinabove
  findLastBinAbove = xform2 c_th3_findlastbinabove
  fitPanelTH1 = xform0 c_th3_fitpanelth1
  getNdivisionA = xform1 c_th3_getndivisiona
  getAxisColorA = xform1 c_th3_getaxiscolora
  getLabelColorA = xform1 c_th3_getlabelcolora
  getLabelFontA = xform1 c_th3_getlabelfonta
  getLabelOffsetA = xform1 c_th3_getlabeloffseta
  getLabelSizeA = xform1 c_th3_getlabelsizea
  getTitleFontA = xform1 c_th3_gettitlefonta
  getTitleOffsetA = xform1 c_th3_gettitleoffseta
  getTitleSizeA = xform1 c_th3_gettitlesizea
  getTickLengthA = xform1 c_th3_getticklengtha
  getBarOffset = xform0 c_th3_getbaroffset
  getBarWidth = xform0 c_th3_getbarwidth
  getContour = xform1 c_th3_getcontour
  getContourLevel = xform1 c_th3_getcontourlevel
  getContourLevelPad = xform1 c_th3_getcontourlevelpad
  getBin = xform3 c_th3_getbin
  getBinCenter = xform1 c_th3_getbincenter
  getBinContent1 = xform1 c_th3_getbincontent1
  getBinContent2 = xform2 c_th3_getbincontent2
  getBinContent3 = xform3 c_th3_getbincontent3
  getBinError1 = xform1 c_th3_getbinerror1
  getBinError2 = xform2 c_th3_getbinerror2
  getBinError3 = xform3 c_th3_getbinerror3
  getBinLowEdge = xform1 c_th3_getbinlowedge
  getBinWidth = xform1 c_th3_getbinwidth
  getCellContent = xform2 c_th3_getcellcontent
  getCellError = xform2 c_th3_getcellerror
  getEntries = xform0 c_th3_getentries
  getEffectiveEntries = xform0 c_th3_geteffectiveentries
  getFunction = xform1 c_th3_getfunction
  getDimension = xform0 c_th3_getdimension
  getKurtosis = xform1 c_th3_getkurtosis
  getLowEdge = xform1 c_th3_getlowedge
  getMaximumTH1 = xform1 c_th3_getmaximumth1
  getMaximumBin = xform0 c_th3_getmaximumbin
  getMaximumStored = xform0 c_th3_getmaximumstored
  getMinimumTH1 = xform1 c_th3_getminimumth1
  getMinimumBin = xform0 c_th3_getminimumbin
  getMinimumStored = xform0 c_th3_getminimumstored
  getMean = xform1 c_th3_getmean
  getMeanError = xform1 c_th3_getmeanerror
  getNbinsX = xform0 c_th3_getnbinsx
  getNbinsY = xform0 c_th3_getnbinsy
  getNbinsZ = xform0 c_th3_getnbinsz
  getQuantilesTH1 = xform3 c_th3_getquantilesth1
  getRandom = xform0 c_th3_getrandom
  getStats = xform1 c_th3_getstats
  getSumOfWeights = xform0 c_th3_getsumofweights
  getSumw2 = xform0 c_th3_getsumw2
  getSumw2N = xform0 c_th3_getsumw2n
  getRMS = xform1 c_th3_getrms
  getRMSError = xform1 c_th3_getrmserror
  getSkewness = xform1 c_th3_getskewness
  integral1 = xform3 c_th3_integral1
  interpolate1 = xform1 c_th3_interpolate1
  interpolate2 = xform2 c_th3_interpolate2
  interpolate3 = xform3 c_th3_interpolate3
  kolmogorovTest = xform2 c_th3_kolmogorovtest
  labelsDeflate = xform1 c_th3_labelsdeflate
  labelsInflate = xform1 c_th3_labelsinflate
  labelsOption = xform2 c_th3_labelsoption
  multiflyF = xform2 c_th3_multiflyf
  multiply = xform5 c_th3_multiply
  putStats = xform1 c_th3_putstats
  rebin = xform3 c_th3_rebin
  rebinAxis = xform2 c_th3_rebinaxis
  rebuild = xform1 c_th3_rebuild
  reset = xform1 c_th3_reset
  resetStats = xform0 c_th3_resetstats
  scale = xform2 c_th3_scale
  setAxisColorA = xform2 c_th3_setaxiscolora
  setAxisRange = xform3 c_th3_setaxisrange
  setBarOffset = xform1 c_th3_setbaroffset
  setBarWidth = xform1 c_th3_setbarwidth
  setBinContent1 = xform2 c_th3_setbincontent1
  setBinContent2 = xform3 c_th3_setbincontent2
  setBinContent3 = xform4 c_th3_setbincontent3
  setBinError1 = xform2 c_th3_setbinerror1
  setBinError2 = xform3 c_th3_setbinerror2
  setBinError3 = xform4 c_th3_setbinerror3
  setBins1 = xform2 c_th3_setbins1
  setBins2 = xform4 c_th3_setbins2
  setBins3 = xform6 c_th3_setbins3
  setBinsLength = xform1 c_th3_setbinslength
  setBuffer = xform2 c_th3_setbuffer
  setCellContent = xform3 c_th3_setcellcontent
  setContent = xform1 c_th3_setcontent
  setContour = xform2 c_th3_setcontour
  setContourLevel = xform2 c_th3_setcontourlevel
  setDirectory = xform1 c_th3_setdirectory
  setEntries = xform1 c_th3_setentries
  setError = xform1 c_th3_seterror
  setLabelColorA = xform2 c_th3_setlabelcolora
  setLabelSizeA = xform2 c_th3_setlabelsizea
  setLabelFontA = xform2 c_th3_setlabelfonta
  setLabelOffsetA = xform2 c_th3_setlabeloffseta
  setMaximum = xform1 c_th3_setmaximum
  setMinimum = xform1 c_th3_setminimum
  setNormFactor = xform1 c_th3_setnormfactor
  setStats = xform1 c_th3_setstats
  setOption = xform1 c_th3_setoption
  setXTitle = xform1 c_th3_setxtitle
  setYTitle = xform1 c_th3_setytitle
  setZTitle = xform1 c_th3_setztitle
  showBackground = xform2 c_th3_showbackground
  showPeaks = xform3 c_th3_showpeaks
  smooth = xform2 c_th3_smooth
  sumw2 = xform0 c_th3_sumw2
instance ITAtt3D TH3 where
instance ITNamed TH3 where
  setName = xform1 c_th3_setname
  setNameTitle = xform2 c_th3_setnametitle
  setTitle = xform1 c_th3_settitle
instance ITAttLine TH3 where
  getLineColor = xform0 c_th3_getlinecolor
  getLineStyle = xform0 c_th3_getlinestyle
  getLineWidth = xform0 c_th3_getlinewidth
  resetAttLine = xform1 c_th3_resetattline
  setLineAttributes = xform0 c_th3_setlineattributes
  setLineColor = xform1 c_th3_setlinecolor
  setLineStyle = xform1 c_th3_setlinestyle
  setLineWidth = xform1 c_th3_setlinewidth
instance ITAttFill TH3 where
  setFillColor = xform1 c_th3_setfillcolor
  setFillStyle = xform1 c_th3_setfillstyle
instance ITAttMarker TH3 where
  getMarkerColor = xform0 c_th3_getmarkercolor
  getMarkerStyle = xform0 c_th3_getmarkerstyle
  getMarkerSize = xform0 c_th3_getmarkersize
  resetAttMarker = xform1 c_th3_resetattmarker
  setMarkerAttributes = xform0 c_th3_setmarkerattributes
  setMarkerColor = xform1 c_th3_setmarkercolor
  setMarkerStyle = xform1 c_th3_setmarkerstyle
  setMarkerSize = xform1 c_th3_setmarkersize
instance ITObject TH3 where
  draw = xform1 c_th3_draw
  findObject = xform1 c_th3_findobject
  getName = xform0 c_th3_getname
  isA = xform0 c_th3_isa
  isFolder = xform0 c_th3_isfolder
  isEqual = xform1 c_th3_isequal
  isSortable = xform0 c_th3_issortable
  paint = xform1 c_th3_paint
  printObj = xform1 c_th3_printobj
  recursiveRemove = xform1 c_th3_recursiveremove
  saveAs = xform2 c_th3_saveas
  useCurrentStyle = xform0 c_th3_usecurrentstyle
  write = xform3 c_th3_write
instance IDeletable TH3 where
  delete = xform0 c_th3_delete

instance ITH3 (Exist TH3) where
  fill3 (ETH3 x) = fill3 x
  fill3w (ETH3 x) = fill3w x
  fitSlicesZ (ETH3 x) = fitSlicesZ x
  getCorrelationFactor3 (ETH3 x) = getCorrelationFactor3 x
  getCovariance3 (ETH3 x) = getCovariance3 x
  rebinX3 (ETH3 x) = rebinX3 x
  rebinY3 (ETH3 x) = rebinY3 x
  rebinZ3 (ETH3 x) = rebinZ3 x
  rebin3D (ETH3 x) = rebin3D x
instance ITH1 (Exist TH3) where
  add (ETH3 x) = add x
  addBinContent (ETH3 x) = addBinContent x
  chi2Test (ETH3 x) = chi2Test x
  computeIntegral (ETH3 x) = computeIntegral x
  directoryAutoAdd (ETH3 x) = directoryAutoAdd x
  divide (ETH3 x) = divide x
  drawCopyTH1 (ETH3 x) a1 = return . ETH3 =<< drawCopyTH1 x a1
  drawNormalized (ETH3 x) = drawNormalized x
  drawPanelTH1 (ETH3 x) = drawPanelTH1 x
  bufferEmpty (ETH3 x) = bufferEmpty x
  evalF (ETH3 x) = evalF x
  fFT (ETH3 x) = fFT x
  fill1 (ETH3 x) = fill1 x
  fill1w (ETH3 x) = fill1w x
  fillN1 (ETH3 x) = fillN1 x
  fillRandom (ETH3 x) = fillRandom x
  findBin (ETH3 x) = findBin x
  findFixBin (ETH3 x) = findFixBin x
  findFirstBinAbove (ETH3 x) = findFirstBinAbove x
  findLastBinAbove (ETH3 x) = findLastBinAbove x
  fitPanelTH1 (ETH3 x) = fitPanelTH1 x
  getNdivisionA (ETH3 x) = getNdivisionA x
  getAxisColorA (ETH3 x) = getAxisColorA x
  getLabelColorA (ETH3 x) = getLabelColorA x
  getLabelFontA (ETH3 x) = getLabelFontA x
  getLabelOffsetA (ETH3 x) = getLabelOffsetA x
  getLabelSizeA (ETH3 x) = getLabelSizeA x
  getTitleFontA (ETH3 x) = getTitleFontA x
  getTitleOffsetA (ETH3 x) = getTitleOffsetA x
  getTitleSizeA (ETH3 x) = getTitleSizeA x
  getTickLengthA (ETH3 x) = getTickLengthA x
  getBarOffset (ETH3 x) = getBarOffset x
  getBarWidth (ETH3 x) = getBarWidth x
  getContour (ETH3 x) = getContour x
  getContourLevel (ETH3 x) = getContourLevel x
  getContourLevelPad (ETH3 x) = getContourLevelPad x
  getBin (ETH3 x) = getBin x
  getBinCenter (ETH3 x) = getBinCenter x
  getBinContent1 (ETH3 x) = getBinContent1 x
  getBinContent2 (ETH3 x) = getBinContent2 x
  getBinContent3 (ETH3 x) = getBinContent3 x
  getBinError1 (ETH3 x) = getBinError1 x
  getBinError2 (ETH3 x) = getBinError2 x
  getBinError3 (ETH3 x) = getBinError3 x
  getBinLowEdge (ETH3 x) = getBinLowEdge x
  getBinWidth (ETH3 x) = getBinWidth x
  getCellContent (ETH3 x) = getCellContent x
  getCellError (ETH3 x) = getCellError x
  getEntries (ETH3 x) = getEntries x
  getEffectiveEntries (ETH3 x) = getEffectiveEntries x
  getFunction (ETH3 x) = getFunction x
  getDimension (ETH3 x) = getDimension x
  getKurtosis (ETH3 x) = getKurtosis x
  getLowEdge (ETH3 x) = getLowEdge x
  getMaximumTH1 (ETH3 x) = getMaximumTH1 x
  getMaximumBin (ETH3 x) = getMaximumBin x
  getMaximumStored (ETH3 x) = getMaximumStored x
  getMinimumTH1 (ETH3 x) = getMinimumTH1 x
  getMinimumBin (ETH3 x) = getMinimumBin x
  getMinimumStored (ETH3 x) = getMinimumStored x
  getMean (ETH3 x) = getMean x
  getMeanError (ETH3 x) = getMeanError x
  getNbinsX (ETH3 x) = getNbinsX x
  getNbinsY (ETH3 x) = getNbinsY x
  getNbinsZ (ETH3 x) = getNbinsZ x
  getQuantilesTH1 (ETH3 x) = getQuantilesTH1 x
  getRandom (ETH3 x) = getRandom x
  getStats (ETH3 x) = getStats x
  getSumOfWeights (ETH3 x) = getSumOfWeights x
  getSumw2 (ETH3 x) = getSumw2 x
  getSumw2N (ETH3 x) = getSumw2N x
  getRMS (ETH3 x) = getRMS x
  getRMSError (ETH3 x) = getRMSError x
  getSkewness (ETH3 x) = getSkewness x
  integral1 (ETH3 x) = integral1 x
  interpolate1 (ETH3 x) = interpolate1 x
  interpolate2 (ETH3 x) = interpolate2 x
  interpolate3 (ETH3 x) = interpolate3 x
  kolmogorovTest (ETH3 x) = kolmogorovTest x
  labelsDeflate (ETH3 x) = labelsDeflate x
  labelsInflate (ETH3 x) = labelsInflate x
  labelsOption (ETH3 x) = labelsOption x
  multiflyF (ETH3 x) = multiflyF x
  multiply (ETH3 x) = multiply x
  putStats (ETH3 x) = putStats x
  rebin (ETH3 x) = rebin x
  rebinAxis (ETH3 x) = rebinAxis x
  rebuild (ETH3 x) = rebuild x
  reset (ETH3 x) = reset x
  resetStats (ETH3 x) = resetStats x
  scale (ETH3 x) = scale x
  setAxisColorA (ETH3 x) = setAxisColorA x
  setAxisRange (ETH3 x) = setAxisRange x
  setBarOffset (ETH3 x) = setBarOffset x
  setBarWidth (ETH3 x) = setBarWidth x
  setBinContent1 (ETH3 x) = setBinContent1 x
  setBinContent2 (ETH3 x) = setBinContent2 x
  setBinContent3 (ETH3 x) = setBinContent3 x
  setBinError1 (ETH3 x) = setBinError1 x
  setBinError2 (ETH3 x) = setBinError2 x
  setBinError3 (ETH3 x) = setBinError3 x
  setBins1 (ETH3 x) = setBins1 x
  setBins2 (ETH3 x) = setBins2 x
  setBins3 (ETH3 x) = setBins3 x
  setBinsLength (ETH3 x) = setBinsLength x
  setBuffer (ETH3 x) = setBuffer x
  setCellContent (ETH3 x) = setCellContent x
  setContent (ETH3 x) = setContent x
  setContour (ETH3 x) = setContour x
  setContourLevel (ETH3 x) = setContourLevel x
  setDirectory (ETH3 x) = setDirectory x
  setEntries (ETH3 x) = setEntries x
  setError (ETH3 x) = setError x
  setLabelColorA (ETH3 x) = setLabelColorA x
  setLabelSizeA (ETH3 x) = setLabelSizeA x
  setLabelFontA (ETH3 x) = setLabelFontA x
  setLabelOffsetA (ETH3 x) = setLabelOffsetA x
  setMaximum (ETH3 x) = setMaximum x
  setMinimum (ETH3 x) = setMinimum x
  setNormFactor (ETH3 x) = setNormFactor x
  setStats (ETH3 x) = setStats x
  setOption (ETH3 x) = setOption x
  setXTitle (ETH3 x) = setXTitle x
  setYTitle (ETH3 x) = setYTitle x
  setZTitle (ETH3 x) = setZTitle x
  showBackground (ETH3 x) = showBackground x
  showPeaks (ETH3 x) = showPeaks x
  smooth (ETH3 x) = smooth x
  sumw2 (ETH3 x) = sumw2 x
instance ITAtt3D (Exist TH3) where

instance ITNamed (Exist TH3) where
  setName (ETH3 x) = setName x
  setNameTitle (ETH3 x) = setNameTitle x
  setTitle (ETH3 x) = setTitle x
instance ITAttLine (Exist TH3) where
  getLineColor (ETH3 x) = getLineColor x
  getLineStyle (ETH3 x) = getLineStyle x
  getLineWidth (ETH3 x) = getLineWidth x
  resetAttLine (ETH3 x) = resetAttLine x
  setLineAttributes (ETH3 x) = setLineAttributes x
  setLineColor (ETH3 x) = setLineColor x
  setLineStyle (ETH3 x) = setLineStyle x
  setLineWidth (ETH3 x) = setLineWidth x
instance ITAttFill (Exist TH3) where
  setFillColor (ETH3 x) = setFillColor x
  setFillStyle (ETH3 x) = setFillStyle x
instance ITAttMarker (Exist TH3) where
  getMarkerColor (ETH3 x) = getMarkerColor x
  getMarkerStyle (ETH3 x) = getMarkerStyle x
  getMarkerSize (ETH3 x) = getMarkerSize x
  resetAttMarker (ETH3 x) = resetAttMarker x
  setMarkerAttributes (ETH3 x) = setMarkerAttributes x
  setMarkerColor (ETH3 x) = setMarkerColor x
  setMarkerStyle (ETH3 x) = setMarkerStyle x
  setMarkerSize (ETH3 x) = setMarkerSize x
instance ITObject (Exist TH3) where
  draw (ETH3 x) = draw x
  findObject (ETH3 x) = findObject x
  getName (ETH3 x) = getName x
  isA (ETH3 x) = isA x
  isFolder (ETH3 x) = isFolder x
  isEqual (ETH3 x) = isEqual x
  isSortable (ETH3 x) = isSortable x
  paint (ETH3 x) = paint x
  printObj (ETH3 x) = printObj x
  recursiveRemove (ETH3 x) = recursiveRemove x
  saveAs (ETH3 x) = saveAs x
  useCurrentStyle (ETH3 x) = useCurrentStyle x
  write (ETH3 x) = write x
instance IDeletable (Exist TH3) where
  delete (ETH3 x) = delete x



tH3ProjectionX :: TH3 -> String -> Int -> Int -> Int -> Int -> String -> IO TH1D
tH3ProjectionX = xform6 c_th3_th3projectionx

tH3ProjectionY :: TH3 -> String -> Int -> Int -> Int -> Int -> String -> IO TH1D
tH3ProjectionY = xform6 c_th3_th3projectiony

tH3ProjectionZ :: TH3 -> String -> Int -> Int -> Int -> Int -> String -> IO TH1D
tH3ProjectionZ = xform6 c_th3_th3projectionz

tH3Project3D :: TH3 -> String -> IO TH1
tH3Project3D = xform1 c_th3_th3project3d

instance FPtr (Exist TH3) where
  type Raw (Exist TH3) = RawTH3
  get_fptr (ETH3 obj) = castForeignPtr (get_fptr obj)
  cast_fptr_to_obj fptr = ETH3 (cast_fptr_to_obj (fptr :: ForeignPtr RawTH3) :: TH3)