{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, 
             FlexibleInstances, TypeSynonymInstances, 
             EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-}

-- module HROOT.Class.Interface where

module HROOT.Core.TObject.Interface where


import Data.Word
import Foreign.C
import Foreign.Ptr
import Foreign.ForeignPtr
import FFICXX.Runtime.Cast

import HROOT.Core.TObject.RawType
import HROOT.Core.TClass.RawType
import HROOT.Core.Deletable.Interface
---- ============ ----



class (IDeletable a) => ITObject a where
    -- | 
    --   > void TObject::Draw( char* option )
    --   

    draw :: a -> CString -> IO () 
    -- | 
    --   > TObject* TObject::FindObject( char* name )
    --   

    findObject :: a -> CString -> IO TObject 
    -- | 
    --   > char* TObject::GetName()
    --   

    getName :: a -> IO CString 

    isA :: a -> IO TClass 

    paint :: a -> CString -> IO () 

    printObj :: a -> CString -> IO () 

    saveAs :: a -> CString -> CString -> IO () 

    write :: a -> CString -> CInt -> CInt -> IO CInt 

instance Existable TObject where
  data Exist TObject = forall a. (FPtr a, ITObject a) => ETObject a

upcastTObject :: (FPtr a, ITObject a) => a -> TObject
upcastTObject h = let fh = get_fptr h
                      fh2 :: ForeignPtr RawTObject = castForeignPtr fh
                  in cast_fptr_to_obj fh2

downcastTObject :: (FPtr a, ITObject a) => TObject -> a 
downcastTObject h = let fh = get_fptr h
                        fh2 = castForeignPtr fh
                    in cast_fptr_to_obj fh2