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

-- module HROOT.Class.Interface where

module HROOT.Core.TAttPad.Interface where


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

import HROOT.Core.TAttPad.RawType

import HROOT.Core.Deletable.Interface
---- ============ ----



class (IDeletable a) => ITAttPad a where

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

    setBottomMargin :: a -> CDouble -> IO () 

    setLeftMargin :: a -> CDouble -> IO () 

    setRightMargin :: a -> CDouble -> IO () 

    setTopMargin :: a -> CDouble -> IO () 

    setMargin :: a -> CDouble -> CDouble -> CDouble -> CDouble -> IO () 

    setAfile :: a -> CDouble -> IO () 

    setXfile :: a -> CDouble -> IO () 

    setYfile :: a -> CDouble -> IO () 

    setAstat :: a -> CDouble -> IO () 

    setXstat :: a -> CDouble -> IO () 

    setYstat :: a -> CDouble -> IO () 

instance Existable TAttPad where
  data Exist TAttPad = forall a. (FPtr a, ITAttPad a) => ETAttPad a

upcastTAttPad :: (FPtr a, ITAttPad a) => a -> TAttPad
upcastTAttPad h = let fh = get_fptr h
                      fh2 :: ForeignPtr RawTAttPad = castForeignPtr fh
                  in cast_fptr_to_obj fh2

downcastTAttPad :: (FPtr a, ITAttPad a) => TAttPad -> a 
downcastTAttPad h = let fh = get_fptr h
                        fh2 = castForeignPtr fh
                    in cast_fptr_to_obj fh2