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

module HROOT.Class.TRandom.Implementation where


import HROOT.TypeCast

import HROOT.Class.TRandom.RawType
import HROOT.Class.TRandom.FFI
import HROOT.Class.TRandom.Interface
import HROOT.Class.TRandom.Cast
import HROOT.Class.TClass.RawType
import HROOT.Class.TClass.Cast
import HROOT.Class.TClass.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 ITRandom TRandom where
  gaus = xform2 c_trandom_gaus
  uniform = xform2 c_trandom_uniform
instance ITNamed TRandom where
  setName = xform1 c_trandom_setname
  setNameTitle = xform2 c_trandom_setnametitle
  setTitle = xform1 c_trandom_settitle
instance ITObject TRandom where
  draw = xform1 c_trandom_draw
  findObject = xform1 c_trandom_findobject
  getName = xform0 c_trandom_getname
  isA = xform0 c_trandom_isa
  isFolder = xform0 c_trandom_isfolder
  isEqual = xform1 c_trandom_isequal
  isSortable = xform0 c_trandom_issortable
  paint = xform1 c_trandom_paint
  printObj = xform1 c_trandom_printobj
  recursiveRemove = xform1 c_trandom_recursiveremove
  saveAs = xform2 c_trandom_saveas
  useCurrentStyle = xform0 c_trandom_usecurrentstyle
  write = xform3 c_trandom_write
instance IDeletable TRandom where
  delete = xform0 c_trandom_delete

instance ITRandom (Exist TRandom) where
  gaus (ETRandom x) = gaus x
  uniform (ETRandom x) = uniform x
instance ITNamed (Exist TRandom) where
  setName (ETRandom x) = setName x
  setNameTitle (ETRandom x) = setNameTitle x
  setTitle (ETRandom x) = setTitle x
instance ITObject (Exist TRandom) where
  draw (ETRandom x) = draw x
  findObject (ETRandom x) = findObject x
  getName (ETRandom x) = getName x
  isA (ETRandom x) = isA x
  isFolder (ETRandom x) = isFolder x
  isEqual (ETRandom x) = isEqual x
  isSortable (ETRandom x) = isSortable x
  paint (ETRandom x) = paint x
  printObj (ETRandom x) = printObj x
  recursiveRemove (ETRandom x) = recursiveRemove x
  saveAs (ETRandom x) = saveAs x
  useCurrentStyle (ETRandom x) = useCurrentStyle x
  write (ETRandom x) = write x
instance IDeletable (Exist TRandom) where
  delete (ETRandom x) = delete x


newTRandom :: Int -> IO TRandom
newTRandom = xform0 c_trandom_newtrandom



instance FPtr (Exist TRandom) where
  type Raw (Exist TRandom) = RawTRandom
  get_fptr (ETRandom obj) = castForeignPtr (get_fptr obj)
  cast_fptr_to_obj fptr = ETRandom (cast_fptr_to_obj (fptr :: ForeignPtr RawTRandom) :: TRandom)