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

-- module HROOT.Class.Interface where

module HROOT.Class.TText.Interface where


import Data.Word
import Foreign.ForeignPtr
import HROOT.TypeCast

import HROOT.Class.TText.RawType

import HROOT.Class.TNamed.Interface
import HROOT.Class.TAttText.Interface


class (ITNamed a,ITAttText a) => ITText a where

    drawText :: a -> Double -> Double -> String -> IO TText 

    drawTextNDC :: a -> Double -> Double -> String -> IO TText 

    getControlBox :: a -> Int -> Int -> Int -> [Int] -> [Int] -> IO () 

    setText :: a -> Double -> Double -> String -> IO () 

instance Existable TText where
  data Exist TText = forall a. (FPtr a, ITText a) => ETText a

upcastTText :: (FPtr a, ITText a) => a -> TText
upcastTText h = let fh = get_fptr h
                    fh2 :: ForeignPtr RawTText = castForeignPtr fh
                in cast_fptr_to_obj fh2