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

module HROOT.Class.TROOT.Implementation where


import HROOT.TypeCast

import HROOT.Class.TROOT.RawType
import HROOT.Class.TROOT.FFI
import HROOT.Class.TROOT.Interface
import HROOT.Class.TROOT.Cast
import HROOT.Class.TKey.RawType
import HROOT.Class.TKey.Cast
import HROOT.Class.TKey.Interface
import HROOT.Class.TClass.RawType
import HROOT.Class.TClass.Cast
import HROOT.Class.TClass.Interface
import HROOT.Class.TSeqCollection.RawType
import HROOT.Class.TSeqCollection.Cast
import HROOT.Class.TSeqCollection.Interface
import HROOT.Class.TCollection.RawType
import HROOT.Class.TCollection.Cast
import HROOT.Class.TCollection.Interface
import HROOT.Class.TDirectory.RawType
import HROOT.Class.TDirectory.Cast
import HROOT.Class.TDirectory.Interface
import HROOT.Class.TNamed.RawType
import HROOT.Class.TNamed.Cast
import HROOT.Class.TNamed.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 ITROOT TROOT where
instance ITDirectory TROOT where
  append = xform2 c_troot_append
  addD = xform2 c_troot_addd
  appendKey = xform1 c_troot_appendkey
  close = xform1 c_troot_close
  get = xform1 c_troot_get
instance ITNamed TROOT where
  setName = xform1 c_troot_setname
  setNameTitle = xform2 c_troot_setnametitle
  setTitle = xform1 c_troot_settitle
instance ITObject TROOT where
  draw = xform1 c_troot_draw
  findObject = xform1 c_troot_findobject
  getName = xform0 c_troot_getname
  isA = xform0 c_troot_isa
  isFolder = xform0 c_troot_isfolder
  isEqual = xform1 c_troot_isequal
  isSortable = xform0 c_troot_issortable
  paint = xform1 c_troot_paint
  printObj = xform1 c_troot_printobj
  recursiveRemove = xform1 c_troot_recursiveremove
  saveAs = xform2 c_troot_saveas
  useCurrentStyle = xform0 c_troot_usecurrentstyle
  write = xform3 c_troot_write
instance IDeletable TROOT where
  delete = xform0 c_troot_delete

instance ITROOT (Exist TROOT) where

instance ITDirectory (Exist TROOT) where
  append (ETROOT x) = append x
  addD (ETROOT x) = addD x
  appendKey (ETROOT x) = appendKey x
  close (ETROOT x) = close x
  get (ETROOT x) = get x
instance ITNamed (Exist TROOT) where
  setName (ETROOT x) = setName x
  setNameTitle (ETROOT x) = setNameTitle x
  setTitle (ETROOT x) = setTitle x
instance ITObject (Exist TROOT) where
  draw (ETROOT x) = draw x
  findObject (ETROOT x) = findObject x
  getName (ETROOT x) = getName x
  isA (ETROOT x) = isA x
  isFolder (ETROOT x) = isFolder x
  isEqual (ETROOT x) = isEqual x
  isSortable (ETROOT x) = isSortable x
  paint (ETROOT x) = paint x
  printObj (ETROOT x) = printObj x
  recursiveRemove (ETROOT x) = recursiveRemove x
  saveAs (ETROOT x) = saveAs x
  useCurrentStyle (ETROOT x) = useCurrentStyle x
  write (ETROOT x) = write x
instance IDeletable (Exist TROOT) where
  delete (ETROOT x) = delete x



tROOTGetListOfColors :: TROOT -> IO TSeqCollection
tROOTGetListOfColors = xform0 c_troot_trootgetlistofcolors

tROOTGetListOfTypes :: TROOT -> Int -> IO TCollection
tROOTGetListOfTypes = xform1 c_troot_trootgetlistoftypes

tROOTGetListOfGlobals :: TROOT -> Int -> IO TCollection
tROOTGetListOfGlobals = xform1 c_troot_trootgetlistofglobals

tROOTGetListOfGlobalFunctions :: TROOT -> Int -> IO TCollection
tROOTGetListOfGlobalFunctions = xform1 c_troot_trootgetlistofglobalfunctions

tROOTGetListOfClosedObjects :: TROOT -> IO TSeqCollection
tROOTGetListOfClosedObjects = xform0 c_troot_trootgetlistofclosedobjects

tROOTGetListOfFiles :: TROOT -> IO TSeqCollection
tROOTGetListOfFiles = xform0 c_troot_trootgetlistoffiles

tROOTGetListOfMappedFiles :: TROOT -> IO TSeqCollection
tROOTGetListOfMappedFiles = xform0 c_troot_trootgetlistofmappedfiles

tROOTGetListOfSockets :: TROOT -> IO TSeqCollection
tROOTGetListOfSockets = xform0 c_troot_trootgetlistofsockets

tROOTGetListOfCanvases :: TROOT -> IO TSeqCollection
tROOTGetListOfCanvases = xform0 c_troot_trootgetlistofcanvases

tROOTGetListOfStyles :: TROOT -> IO TSeqCollection
tROOTGetListOfStyles = xform0 c_troot_trootgetlistofstyles

tROOTGetListOfFunctions :: TROOT -> IO TCollection
tROOTGetListOfFunctions = xform0 c_troot_trootgetlistoffunctions

tROOTGetListOfGeometries :: TROOT -> IO TSeqCollection
tROOTGetListOfGeometries = xform0 c_troot_trootgetlistofgeometries

tROOTGetListOfBrowsers :: TROOT -> IO TSeqCollection
tROOTGetListOfBrowsers = xform0 c_troot_trootgetlistofbrowsers

tROOTGetListOfSpecials :: TROOT -> IO TSeqCollection
tROOTGetListOfSpecials = xform0 c_troot_trootgetlistofspecials

tROOTGetListOfTasks :: TROOT -> IO TSeqCollection
tROOTGetListOfTasks = xform0 c_troot_trootgetlistoftasks

tROOTGetListOfCleanups :: TROOT -> IO TSeqCollection
tROOTGetListOfCleanups = xform0 c_troot_trootgetlistofcleanups

tROOTGetListOfStreamerInfo :: TROOT -> IO TSeqCollection
tROOTGetListOfStreamerInfo = xform0 c_troot_trootgetlistofstreamerinfo

tROOTDecreaseDirLevel :: IO Int
tROOTDecreaseDirLevel = xformnull c_troot_trootdecreasedirlevel

tROOTGetDirLevel :: IO Int
tROOTGetDirLevel = xformnull c_troot_trootgetdirlevel

tROOTGetMacroPath :: IO String
tROOTGetMacroPath = xformnull c_troot_trootgetmacropath

tROOTSetMacroPath :: String -> IO ()
tROOTSetMacroPath = xform0 c_troot_trootsetmacropath

tROOTIncreaseDirLevel :: IO Int
tROOTIncreaseDirLevel = xformnull c_troot_trootincreasedirlevel

tROOTIndentLevel :: IO ()
tROOTIndentLevel = xformnull c_troot_trootindentlevel

tROOTInitialized :: IO Int
tROOTInitialized = xformnull c_troot_trootinitialized

tROOTMemCheck :: IO Int
tROOTMemCheck = xformnull c_troot_trootmemcheck

tROOTSetDirLevel :: Int -> IO ()
tROOTSetDirLevel = xform0 c_troot_trootsetdirlevel

tROOTConvertVersionCode2Int :: Int -> IO Int
tROOTConvertVersionCode2Int = xform0 c_troot_trootconvertversioncode2int

tROOTConvertVersionInt2Code :: Int -> IO Int
tROOTConvertVersionInt2Code = xform0 c_troot_trootconvertversionint2code

tROOTRootVersionCode :: IO Int
tROOTRootVersionCode = xformnull c_troot_trootrootversioncode

instance FPtr (Exist TROOT) where
  type Raw (Exist TROOT) = RawTROOT
  get_fptr (ETROOT obj) = castForeignPtr (get_fptr obj)
  cast_fptr_to_obj fptr = ETROOT (cast_fptr_to_obj (fptr :: ForeignPtr RawTROOT) :: TROOT)