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

-- module HROOT.Class.Interface where

module HROOT.Class.Interface  where

import Foreign.C            
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Marshal.Array


import System.IO.Unsafe

class Castable a b where
  cast :: a -> b 
  uncast :: b -> a 

class FPtr a where
  type Raw a :: *
  get_fptr :: a -> ForeignPtr (Raw a) 
  cast_fptr_to_obj :: ForeignPtr (Raw a) -> a

class Existable a where
  data Exist a :: *  

instance Castable a a where
  cast = id
  uncast = id

instance Castable Int CInt where
  cast = fromIntegral 
  uncast = fromIntegral
  
instance Castable Double CDouble where
  cast = realToFrac
  uncast = realToFrac 

instance Castable [Double] (Ptr CDouble) where
  cast xs = unsafePerformIO (newArray (map realToFrac xs))
  uncast _c_xs = undefined 

instance Castable [Int] (Ptr CInt) where
  cast xs = unsafePerformIO (newArray (map fromIntegral xs))
  uncast _c_xs = undefined 

instance Castable String CString where
  cast x = unsafePerformIO (newCString x)
  uncast x = unsafePerformIO (peekCString x) 

instance Castable [String] (Ptr CString) where
  cast xs = unsafePerformIO (mapM  newCString xs >>= newArray)
  uncast _c_xs = undefined

instance (Castable a a', Castable b b') => Castable (a->b) (a'->b') where
  cast f = cast . f . uncast
  uncast f = uncast . f . cast 


xformnull :: (Castable a ca) => (IO ca) -> IO a
xformnull f = f >>= return . uncast

xform0 :: (Castable a ca, Castable y cy) 
       => (ca -> IO cy) -> a -> IO y
xform0 f a = f (cast a) >>= return . uncast 

xform1 :: (Castable a ca, Castable x1 cx1, Castable y cy) 
       => (ca -> cx1 -> IO cy) -> a -> x1 -> IO y
xform1 f a x1 = f (cast a) (cast x1) >>= return . uncast 

xform2 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable y cy) 
       => (ca -> cx1 -> cx2 -> IO cy) -> a -> x1 -> x2-> IO y
xform2 f a x1 x2 = f (cast a) (cast x1) (cast x2) >>= return . uncast 

xform3 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable y cy) 
       => (ca -> cx1 -> cx2 -> cx3 -> IO cy) -> a -> x1 -> x2 -> x3 -> IO y
xform3 f a x1 x2 x3 = f (cast a) (cast x1) (cast x2) (cast x3) >>= return . uncast 

xform4 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4, Castable y cy) 
       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> IO cy) -> a -> x1 -> x2 -> x3 -> x4 -> IO y
xform4 f a x1 x2 x3 x4 = f (cast a) (cast x1) (cast x2) (cast x3) (cast x4) >>= return . uncast 

xform5 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4,
           Castable x5 cx5, Castable y cy) 
       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> IO cy) -> a -> x1 -> x2 -> x3 -> x4 -> x5 -> IO y
xform5 f a x1 x2 x3 x4 x5 = f (cast a) (cast x1) (cast x2) (cast x3) (cast x4) (cast x5) >>= return . uncast 

xform6 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4,
           Castable x5 cx5, Castable x6 cx6, Castable y cy) 
       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> IO cy) 
          -> a -> x1 -> x2 -> x3 -> x4 -> x5 -> x6 -> IO y
xform6 f a x1 x2 x3 x4 x5 x6 = 
  f (cast a) (cast x1) (cast x2) (cast x3) (cast x4) (cast x5) (cast x6) 
  >>= return . uncast 

xform7 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4,
           Castable x5 cx5, Castable x6 cx6, Castable x7 cx7, Castable y cy) 
       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> cx7 -> IO cy) 
          -> a -> x1 -> x2 -> x3 -> x4 -> x5 -> x6 -> x7 -> IO y
xform7 f a x1 x2 x3 x4 x5 x6 x7 = 
  f (cast a) (cast x1) (cast x2) (cast x3) (cast x4) (cast x5) (cast x6) (cast x7)
  >>= return . uncast 

xform8 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4,
           Castable x5 cx5, Castable x6 cx6, Castable x7 cx7, Castable x8 cx8, Castable y cy) 
       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> cx7 -> cx8 -> IO cy) 
          -> a -> x1 -> x2 -> x3 -> x4 -> x5 -> x6 -> x7 -> x8 -> IO y
xform8 f a x1 x2 x3 x4 x5 x6 x7 x8 = 
  f (cast a) (cast x1) (cast x2) (cast x3) (cast x4) (cast x5) (cast x6) (cast x7) (cast x8)
  >>= return . uncast 

xform9 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4,
           Castable x5 cx5, Castable x6 cx6, Castable x7 cx7, Castable x8 cx8, Castable x9 cx9, 
           Castable y cy) 
       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> cx7 -> cx8 -> cx9 -> IO cy) 
          -> a -> x1 -> x2 -> x3 -> x4 -> x5 -> x6 -> x7 -> x8 -> x9 -> IO y
xform9 f a x1 x2 x3 x4 x5 x6 x7 x8 x9 = 
  f (cast a) (cast x1) (cast x2) (cast x3) (cast x4) (cast x5) (cast x6) (cast x7) (cast x8) (cast x9)
  >>= return . uncast 

xform10 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4,
            Castable x5 cx5, Castable x6 cx6, Castable x7 cx7, Castable x8 cx8, Castable x9 cx9,  
            Castable x10 cx10, Castable y cy) 
       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> cx7 -> cx8 -> cx9 -> cx10 -> IO cy) 
          -> a -> x1 -> x2 -> x3 -> x4 -> x5 -> x6 -> x7 -> x8 -> x9 -> x10 -> IO y
xform10 f a x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 = 
  f (cast a) (cast x1) (cast x2) (cast x3) (cast x4) (cast x5) (cast x6) (cast x7) (cast x8) (cast x9) (cast x10) >>= return . uncast 



data RawTObject
newtype TObject = TObject (ForeignPtr RawTObject) deriving (Eq, Ord, Show)
instance FPtr TObject where
   type Raw TObject = RawTObject
   get_fptr (TObject fptr) = fptr
   cast_fptr_to_obj = TObject
instance Existable TObject where
  data Exist TObject = forall a. (FPtr a, ITObject a) => ETObject a

data RawTNamed
newtype TNamed = TNamed (ForeignPtr RawTNamed) deriving (Eq, Ord, Show)
instance FPtr TNamed where
   type Raw TNamed = RawTNamed
   get_fptr (TNamed fptr) = fptr
   cast_fptr_to_obj = TNamed
instance Existable TNamed where
  data Exist TNamed = forall a. (FPtr a, ITNamed a) => ETNamed a

data RawTClass
newtype TClass = TClass (ForeignPtr RawTClass) deriving (Eq, Ord, Show)
instance FPtr TClass where
   type Raw TClass = RawTClass
   get_fptr (TClass fptr) = fptr
   cast_fptr_to_obj = TClass
instance Existable TClass where
  data Exist TClass = forall a. (FPtr a, ITClass a) => ETClass a

data RawTFormula
newtype TFormula = TFormula (ForeignPtr RawTFormula) deriving (Eq, Ord, Show)
instance FPtr TFormula where
   type Raw TFormula = RawTFormula
   get_fptr (TFormula fptr) = fptr
   cast_fptr_to_obj = TFormula
instance Existable TFormula where
  data Exist TFormula = forall a. (FPtr a, ITFormula a) => ETFormula a

data RawTAtt3D
newtype TAtt3D = TAtt3D (ForeignPtr RawTAtt3D) deriving (Eq, Ord, Show)
instance FPtr TAtt3D where
   type Raw TAtt3D = RawTAtt3D
   get_fptr (TAtt3D fptr) = fptr
   cast_fptr_to_obj = TAtt3D
instance Existable TAtt3D where
  data Exist TAtt3D = forall a. (FPtr a, ITAtt3D a) => ETAtt3D a

data RawTAttAxis
newtype TAttAxis = TAttAxis (ForeignPtr RawTAttAxis) deriving (Eq, Ord, Show)
instance FPtr TAttAxis where
   type Raw TAttAxis = RawTAttAxis
   get_fptr (TAttAxis fptr) = fptr
   cast_fptr_to_obj = TAttAxis
instance Existable TAttAxis where
  data Exist TAttAxis = forall a. (FPtr a, ITAttAxis a) => ETAttAxis a

data RawTAttBBox
newtype TAttBBox = TAttBBox (ForeignPtr RawTAttBBox) deriving (Eq, Ord, Show)
instance FPtr TAttBBox where
   type Raw TAttBBox = RawTAttBBox
   get_fptr (TAttBBox fptr) = fptr
   cast_fptr_to_obj = TAttBBox
instance Existable TAttBBox where
  data Exist TAttBBox = forall a. (FPtr a, ITAttBBox a) => ETAttBBox a

data RawTAttCanvas
newtype TAttCanvas = TAttCanvas (ForeignPtr RawTAttCanvas) deriving (Eq, Ord, Show)
instance FPtr TAttCanvas where
   type Raw TAttCanvas = RawTAttCanvas
   get_fptr (TAttCanvas fptr) = fptr
   cast_fptr_to_obj = TAttCanvas
instance Existable TAttCanvas where
  data Exist TAttCanvas = forall a. (FPtr a, ITAttCanvas a) => ETAttCanvas a

data RawTAttFill
newtype TAttFill = TAttFill (ForeignPtr RawTAttFill) deriving (Eq, Ord, Show)
instance FPtr TAttFill where
   type Raw TAttFill = RawTAttFill
   get_fptr (TAttFill fptr) = fptr
   cast_fptr_to_obj = TAttFill
instance Existable TAttFill where
  data Exist TAttFill = forall a. (FPtr a, ITAttFill a) => ETAttFill a

data RawTAttImage
newtype TAttImage = TAttImage (ForeignPtr RawTAttImage) deriving (Eq, Ord, Show)
instance FPtr TAttImage where
   type Raw TAttImage = RawTAttImage
   get_fptr (TAttImage fptr) = fptr
   cast_fptr_to_obj = TAttImage
instance Existable TAttImage where
  data Exist TAttImage = forall a. (FPtr a, ITAttImage a) => ETAttImage a

data RawTAttLine
newtype TAttLine = TAttLine (ForeignPtr RawTAttLine) deriving (Eq, Ord, Show)
instance FPtr TAttLine where
   type Raw TAttLine = RawTAttLine
   get_fptr (TAttLine fptr) = fptr
   cast_fptr_to_obj = TAttLine
instance Existable TAttLine where
  data Exist TAttLine = forall a. (FPtr a, ITAttLine a) => ETAttLine a

data RawTAttMarker
newtype TAttMarker = TAttMarker (ForeignPtr RawTAttMarker) deriving (Eq, Ord, Show)
instance FPtr TAttMarker where
   type Raw TAttMarker = RawTAttMarker
   get_fptr (TAttMarker fptr) = fptr
   cast_fptr_to_obj = TAttMarker
instance Existable TAttMarker where
  data Exist TAttMarker = forall a. (FPtr a, ITAttMarker a) => ETAttMarker a

data RawTAttPad
newtype TAttPad = TAttPad (ForeignPtr RawTAttPad) deriving (Eq, Ord, Show)
instance FPtr TAttPad where
   type Raw TAttPad = RawTAttPad
   get_fptr (TAttPad fptr) = fptr
   cast_fptr_to_obj = TAttPad
instance Existable TAttPad where
  data Exist TAttPad = forall a. (FPtr a, ITAttPad a) => ETAttPad a

data RawTAttParticle
newtype TAttParticle = TAttParticle (ForeignPtr RawTAttParticle) deriving (Eq, Ord, Show)
instance FPtr TAttParticle where
   type Raw TAttParticle = RawTAttParticle
   get_fptr (TAttParticle fptr) = fptr
   cast_fptr_to_obj = TAttParticle
instance Existable TAttParticle where
  data Exist TAttParticle = forall a. (FPtr a, ITAttParticle a) => ETAttParticle a

data RawTAttText
newtype TAttText = TAttText (ForeignPtr RawTAttText) deriving (Eq, Ord, Show)
instance FPtr TAttText where
   type Raw TAttText = RawTAttText
   get_fptr (TAttText fptr) = fptr
   cast_fptr_to_obj = TAttText
instance Existable TAttText where
  data Exist TAttText = forall a. (FPtr a, ITAttText a) => ETAttText a

data RawTHStack
newtype THStack = THStack (ForeignPtr RawTHStack) deriving (Eq, Ord, Show)
instance FPtr THStack where
   type Raw THStack = RawTHStack
   get_fptr (THStack fptr) = fptr
   cast_fptr_to_obj = THStack
instance Existable THStack where
  data Exist THStack = forall a. (FPtr a, ITHStack a) => ETHStack a

data RawTF1
newtype TF1 = TF1 (ForeignPtr RawTF1) deriving (Eq, Ord, Show)
instance FPtr TF1 where
   type Raw TF1 = RawTF1
   get_fptr (TF1 fptr) = fptr
   cast_fptr_to_obj = TF1
instance Existable TF1 where
  data Exist TF1 = forall a. (FPtr a, ITF1 a) => ETF1 a

data RawTGraph
newtype TGraph = TGraph (ForeignPtr RawTGraph) deriving (Eq, Ord, Show)
instance FPtr TGraph where
   type Raw TGraph = RawTGraph
   get_fptr (TGraph fptr) = fptr
   cast_fptr_to_obj = TGraph
instance Existable TGraph where
  data Exist TGraph = forall a. (FPtr a, ITGraph a) => ETGraph a

data RawTGraphAsymmErrors
newtype TGraphAsymmErrors = TGraphAsymmErrors (ForeignPtr RawTGraphAsymmErrors) deriving (Eq, Ord, Show)
instance FPtr TGraphAsymmErrors where
   type Raw TGraphAsymmErrors = RawTGraphAsymmErrors
   get_fptr (TGraphAsymmErrors fptr) = fptr
   cast_fptr_to_obj = TGraphAsymmErrors
instance Existable TGraphAsymmErrors where
  data Exist TGraphAsymmErrors = forall a. (FPtr a, ITGraphAsymmErrors a) => ETGraphAsymmErrors a

data RawTCutG
newtype TCutG = TCutG (ForeignPtr RawTCutG) deriving (Eq, Ord, Show)
instance FPtr TCutG where
   type Raw TCutG = RawTCutG
   get_fptr (TCutG fptr) = fptr
   cast_fptr_to_obj = TCutG
instance Existable TCutG where
  data Exist TCutG = forall a. (FPtr a, ITCutG a) => ETCutG a

data RawTGraphBentErrors
newtype TGraphBentErrors = TGraphBentErrors (ForeignPtr RawTGraphBentErrors) deriving (Eq, Ord, Show)
instance FPtr TGraphBentErrors where
   type Raw TGraphBentErrors = RawTGraphBentErrors
   get_fptr (TGraphBentErrors fptr) = fptr
   cast_fptr_to_obj = TGraphBentErrors
instance Existable TGraphBentErrors where
  data Exist TGraphBentErrors = forall a. (FPtr a, ITGraphBentErrors a) => ETGraphBentErrors a

data RawTGraphErrors
newtype TGraphErrors = TGraphErrors (ForeignPtr RawTGraphErrors) deriving (Eq, Ord, Show)
instance FPtr TGraphErrors where
   type Raw TGraphErrors = RawTGraphErrors
   get_fptr (TGraphErrors fptr) = fptr
   cast_fptr_to_obj = TGraphErrors
instance Existable TGraphErrors where
  data Exist TGraphErrors = forall a. (FPtr a, ITGraphErrors a) => ETGraphErrors a

data RawTGraphPolar
newtype TGraphPolar = TGraphPolar (ForeignPtr RawTGraphPolar) deriving (Eq, Ord, Show)
instance FPtr TGraphPolar where
   type Raw TGraphPolar = RawTGraphPolar
   get_fptr (TGraphPolar fptr) = fptr
   cast_fptr_to_obj = TGraphPolar
instance Existable TGraphPolar where
  data Exist TGraphPolar = forall a. (FPtr a, ITGraphPolar a) => ETGraphPolar a

data RawTGraphQQ
newtype TGraphQQ = TGraphQQ (ForeignPtr RawTGraphQQ) deriving (Eq, Ord, Show)
instance FPtr TGraphQQ where
   type Raw TGraphQQ = RawTGraphQQ
   get_fptr (TGraphQQ fptr) = fptr
   cast_fptr_to_obj = TGraphQQ
instance Existable TGraphQQ where
  data Exist TGraphQQ = forall a. (FPtr a, ITGraphQQ a) => ETGraphQQ a

data RawTEllipse
newtype TEllipse = TEllipse (ForeignPtr RawTEllipse) deriving (Eq, Ord, Show)
instance FPtr TEllipse where
   type Raw TEllipse = RawTEllipse
   get_fptr (TEllipse fptr) = fptr
   cast_fptr_to_obj = TEllipse
instance Existable TEllipse where
  data Exist TEllipse = forall a. (FPtr a, ITEllipse a) => ETEllipse a

data RawTArc
newtype TArc = TArc (ForeignPtr RawTArc) deriving (Eq, Ord, Show)
instance FPtr TArc where
   type Raw TArc = RawTArc
   get_fptr (TArc fptr) = fptr
   cast_fptr_to_obj = TArc
instance Existable TArc where
  data Exist TArc = forall a. (FPtr a, ITArc a) => ETArc a

data RawTCrown
newtype TCrown = TCrown (ForeignPtr RawTCrown) deriving (Eq, Ord, Show)
instance FPtr TCrown where
   type Raw TCrown = RawTCrown
   get_fptr (TCrown fptr) = fptr
   cast_fptr_to_obj = TCrown
instance Existable TCrown where
  data Exist TCrown = forall a. (FPtr a, ITCrown a) => ETCrown a

data RawTLine
newtype TLine = TLine (ForeignPtr RawTLine) deriving (Eq, Ord, Show)
instance FPtr TLine where
   type Raw TLine = RawTLine
   get_fptr (TLine fptr) = fptr
   cast_fptr_to_obj = TLine
instance Existable TLine where
  data Exist TLine = forall a. (FPtr a, ITLine a) => ETLine a

data RawTArrow
newtype TArrow = TArrow (ForeignPtr RawTArrow) deriving (Eq, Ord, Show)
instance FPtr TArrow where
   type Raw TArrow = RawTArrow
   get_fptr (TArrow fptr) = fptr
   cast_fptr_to_obj = TArrow
instance Existable TArrow where
  data Exist TArrow = forall a. (FPtr a, ITArrow a) => ETArrow a

data RawTGaxis
newtype TGaxis = TGaxis (ForeignPtr RawTGaxis) deriving (Eq, Ord, Show)
instance FPtr TGaxis where
   type Raw TGaxis = RawTGaxis
   get_fptr (TGaxis fptr) = fptr
   cast_fptr_to_obj = TGaxis
instance Existable TGaxis where
  data Exist TGaxis = forall a. (FPtr a, ITGaxis a) => ETGaxis a

data RawTShape
newtype TShape = TShape (ForeignPtr RawTShape) deriving (Eq, Ord, Show)
instance FPtr TShape where
   type Raw TShape = RawTShape
   get_fptr (TShape fptr) = fptr
   cast_fptr_to_obj = TShape
instance Existable TShape where
  data Exist TShape = forall a. (FPtr a, ITShape a) => ETShape a

data RawTBRIK
newtype TBRIK = TBRIK (ForeignPtr RawTBRIK) deriving (Eq, Ord, Show)
instance FPtr TBRIK where
   type Raw TBRIK = RawTBRIK
   get_fptr (TBRIK fptr) = fptr
   cast_fptr_to_obj = TBRIK
instance Existable TBRIK where
  data Exist TBRIK = forall a. (FPtr a, ITBRIK a) => ETBRIK a

data RawTTUBE
newtype TTUBE = TTUBE (ForeignPtr RawTTUBE) deriving (Eq, Ord, Show)
instance FPtr TTUBE where
   type Raw TTUBE = RawTTUBE
   get_fptr (TTUBE fptr) = fptr
   cast_fptr_to_obj = TTUBE
instance Existable TTUBE where
  data Exist TTUBE = forall a. (FPtr a, ITTUBE a) => ETTUBE a

data RawTPCON
newtype TPCON = TPCON (ForeignPtr RawTPCON) deriving (Eq, Ord, Show)
instance FPtr TPCON where
   type Raw TPCON = RawTPCON
   get_fptr (TPCON fptr) = fptr
   cast_fptr_to_obj = TPCON
instance Existable TPCON where
  data Exist TPCON = forall a. (FPtr a, ITPCON a) => ETPCON a

data RawTSPHE
newtype TSPHE = TSPHE (ForeignPtr RawTSPHE) deriving (Eq, Ord, Show)
instance FPtr TSPHE where
   type Raw TSPHE = RawTSPHE
   get_fptr (TSPHE fptr) = fptr
   cast_fptr_to_obj = TSPHE
instance Existable TSPHE where
  data Exist TSPHE = forall a. (FPtr a, ITSPHE a) => ETSPHE a

data RawTXTRU
newtype TXTRU = TXTRU (ForeignPtr RawTXTRU) deriving (Eq, Ord, Show)
instance FPtr TXTRU where
   type Raw TXTRU = RawTXTRU
   get_fptr (TXTRU fptr) = fptr
   cast_fptr_to_obj = TXTRU
instance Existable TXTRU where
  data Exist TXTRU = forall a. (FPtr a, ITXTRU a) => ETXTRU a

data RawTBox
newtype TBox = TBox (ForeignPtr RawTBox) deriving (Eq, Ord, Show)
instance FPtr TBox where
   type Raw TBox = RawTBox
   get_fptr (TBox fptr) = fptr
   cast_fptr_to_obj = TBox
instance Existable TBox where
  data Exist TBox = forall a. (FPtr a, ITBox a) => ETBox a

data RawTPave
newtype TPave = TPave (ForeignPtr RawTPave) deriving (Eq, Ord, Show)
instance FPtr TPave where
   type Raw TPave = RawTPave
   get_fptr (TPave fptr) = fptr
   cast_fptr_to_obj = TPave
instance Existable TPave where
  data Exist TPave = forall a. (FPtr a, ITPave a) => ETPave a

data RawTPaveText
newtype TPaveText = TPaveText (ForeignPtr RawTPaveText) deriving (Eq, Ord, Show)
instance FPtr TPaveText where
   type Raw TPaveText = RawTPaveText
   get_fptr (TPaveText fptr) = fptr
   cast_fptr_to_obj = TPaveText
instance Existable TPaveText where
  data Exist TPaveText = forall a. (FPtr a, ITPaveText a) => ETPaveText a

data RawTDiamond
newtype TDiamond = TDiamond (ForeignPtr RawTDiamond) deriving (Eq, Ord, Show)
instance FPtr TDiamond where
   type Raw TDiamond = RawTDiamond
   get_fptr (TDiamond fptr) = fptr
   cast_fptr_to_obj = TDiamond
instance Existable TDiamond where
  data Exist TDiamond = forall a. (FPtr a, ITDiamond a) => ETDiamond a

data RawTPaveStats
newtype TPaveStats = TPaveStats (ForeignPtr RawTPaveStats) deriving (Eq, Ord, Show)
instance FPtr TPaveStats where
   type Raw TPaveStats = RawTPaveStats
   get_fptr (TPaveStats fptr) = fptr
   cast_fptr_to_obj = TPaveStats
instance Existable TPaveStats where
  data Exist TPaveStats = forall a. (FPtr a, ITPaveStats a) => ETPaveStats a

data RawTPavesText
newtype TPavesText = TPavesText (ForeignPtr RawTPavesText) deriving (Eq, Ord, Show)
instance FPtr TPavesText where
   type Raw TPavesText = RawTPavesText
   get_fptr (TPavesText fptr) = fptr
   cast_fptr_to_obj = TPavesText
instance Existable TPavesText where
  data Exist TPavesText = forall a. (FPtr a, ITPavesText a) => ETPavesText a

data RawTLegend
newtype TLegend = TLegend (ForeignPtr RawTLegend) deriving (Eq, Ord, Show)
instance FPtr TLegend where
   type Raw TLegend = RawTLegend
   get_fptr (TLegend fptr) = fptr
   cast_fptr_to_obj = TLegend
instance Existable TLegend where
  data Exist TLegend = forall a. (FPtr a, ITLegend a) => ETLegend a

data RawTPaveLabel
newtype TPaveLabel = TPaveLabel (ForeignPtr RawTPaveLabel) deriving (Eq, Ord, Show)
instance FPtr TPaveLabel where
   type Raw TPaveLabel = RawTPaveLabel
   get_fptr (TPaveLabel fptr) = fptr
   cast_fptr_to_obj = TPaveLabel
instance Existable TPaveLabel where
  data Exist TPaveLabel = forall a. (FPtr a, ITPaveLabel a) => ETPaveLabel a

data RawTPaveClass
newtype TPaveClass = TPaveClass (ForeignPtr RawTPaveClass) deriving (Eq, Ord, Show)
instance FPtr TPaveClass where
   type Raw TPaveClass = RawTPaveClass
   get_fptr (TPaveClass fptr) = fptr
   cast_fptr_to_obj = TPaveClass
instance Existable TPaveClass where
  data Exist TPaveClass = forall a. (FPtr a, ITPaveClass a) => ETPaveClass a

data RawTWbox
newtype TWbox = TWbox (ForeignPtr RawTWbox) deriving (Eq, Ord, Show)
instance FPtr TWbox where
   type Raw TWbox = RawTWbox
   get_fptr (TWbox fptr) = fptr
   cast_fptr_to_obj = TWbox
instance Existable TWbox where
  data Exist TWbox = forall a. (FPtr a, ITWbox a) => ETWbox a

data RawTFrame
newtype TFrame = TFrame (ForeignPtr RawTFrame) deriving (Eq, Ord, Show)
instance FPtr TFrame where
   type Raw TFrame = RawTFrame
   get_fptr (TFrame fptr) = fptr
   cast_fptr_to_obj = TFrame
instance Existable TFrame where
  data Exist TFrame = forall a. (FPtr a, ITFrame a) => ETFrame a

data RawTSliderBox
newtype TSliderBox = TSliderBox (ForeignPtr RawTSliderBox) deriving (Eq, Ord, Show)
instance FPtr TSliderBox where
   type Raw TSliderBox = RawTSliderBox
   get_fptr (TSliderBox fptr) = fptr
   cast_fptr_to_obj = TSliderBox
instance Existable TSliderBox where
  data Exist TSliderBox = forall a. (FPtr a, ITSliderBox a) => ETSliderBox a

data RawTTree
newtype TTree = TTree (ForeignPtr RawTTree) deriving (Eq, Ord, Show)
instance FPtr TTree where
   type Raw TTree = RawTTree
   get_fptr (TTree fptr) = fptr
   cast_fptr_to_obj = TTree
instance Existable TTree where
  data Exist TTree = forall a. (FPtr a, ITTree a) => ETTree a

data RawTChain
newtype TChain = TChain (ForeignPtr RawTChain) deriving (Eq, Ord, Show)
instance FPtr TChain where
   type Raw TChain = RawTChain
   get_fptr (TChain fptr) = fptr
   cast_fptr_to_obj = TChain
instance Existable TChain where
  data Exist TChain = forall a. (FPtr a, ITChain a) => ETChain a

data RawTNtuple
newtype TNtuple = TNtuple (ForeignPtr RawTNtuple) deriving (Eq, Ord, Show)
instance FPtr TNtuple where
   type Raw TNtuple = RawTNtuple
   get_fptr (TNtuple fptr) = fptr
   cast_fptr_to_obj = TNtuple
instance Existable TNtuple where
  data Exist TNtuple = forall a. (FPtr a, ITNtuple a) => ETNtuple a

data RawTNtupleD
newtype TNtupleD = TNtupleD (ForeignPtr RawTNtupleD) deriving (Eq, Ord, Show)
instance FPtr TNtupleD where
   type Raw TNtupleD = RawTNtupleD
   get_fptr (TNtupleD fptr) = fptr
   cast_fptr_to_obj = TNtupleD
instance Existable TNtupleD where
  data Exist TNtupleD = forall a. (FPtr a, ITNtupleD a) => ETNtupleD a

data RawTTreeSQL
newtype TTreeSQL = TTreeSQL (ForeignPtr RawTTreeSQL) deriving (Eq, Ord, Show)
instance FPtr TTreeSQL where
   type Raw TTreeSQL = RawTTreeSQL
   get_fptr (TTreeSQL fptr) = fptr
   cast_fptr_to_obj = TTreeSQL
instance Existable TTreeSQL where
  data Exist TTreeSQL = forall a. (FPtr a, ITTreeSQL a) => ETTreeSQL a

data RawTPolyLine
newtype TPolyLine = TPolyLine (ForeignPtr RawTPolyLine) deriving (Eq, Ord, Show)
instance FPtr TPolyLine where
   type Raw TPolyLine = RawTPolyLine
   get_fptr (TPolyLine fptr) = fptr
   cast_fptr_to_obj = TPolyLine
instance Existable TPolyLine where
  data Exist TPolyLine = forall a. (FPtr a, ITPolyLine a) => ETPolyLine a

data RawTCurlyLine
newtype TCurlyLine = TCurlyLine (ForeignPtr RawTCurlyLine) deriving (Eq, Ord, Show)
instance FPtr TCurlyLine where
   type Raw TCurlyLine = RawTCurlyLine
   get_fptr (TCurlyLine fptr) = fptr
   cast_fptr_to_obj = TCurlyLine
instance Existable TCurlyLine where
  data Exist TCurlyLine = forall a. (FPtr a, ITCurlyLine a) => ETCurlyLine a

data RawTCurlyArc
newtype TCurlyArc = TCurlyArc (ForeignPtr RawTCurlyArc) deriving (Eq, Ord, Show)
instance FPtr TCurlyArc where
   type Raw TCurlyArc = RawTCurlyArc
   get_fptr (TCurlyArc fptr) = fptr
   cast_fptr_to_obj = TCurlyArc
instance Existable TCurlyArc where
  data Exist TCurlyArc = forall a. (FPtr a, ITCurlyArc a) => ETCurlyArc a

data RawTEfficiency
newtype TEfficiency = TEfficiency (ForeignPtr RawTEfficiency) deriving (Eq, Ord, Show)
instance FPtr TEfficiency where
   type Raw TEfficiency = RawTEfficiency
   get_fptr (TEfficiency fptr) = fptr
   cast_fptr_to_obj = TEfficiency
instance Existable TEfficiency where
  data Exist TEfficiency = forall a. (FPtr a, ITEfficiency a) => ETEfficiency a

data RawTAxis
newtype TAxis = TAxis (ForeignPtr RawTAxis) deriving (Eq, Ord, Show)
instance FPtr TAxis where
   type Raw TAxis = RawTAxis
   get_fptr (TAxis fptr) = fptr
   cast_fptr_to_obj = TAxis
instance Existable TAxis where
  data Exist TAxis = forall a. (FPtr a, ITAxis a) => ETAxis a

data RawTLatex
newtype TLatex = TLatex (ForeignPtr RawTLatex) deriving (Eq, Ord, Show)
instance FPtr TLatex where
   type Raw TLatex = RawTLatex
   get_fptr (TLatex fptr) = fptr
   cast_fptr_to_obj = TLatex
instance Existable TLatex where
  data Exist TLatex = forall a. (FPtr a, ITLatex a) => ETLatex a

data RawTText
newtype TText = TText (ForeignPtr RawTText) deriving (Eq, Ord, Show)
instance FPtr TText where
   type Raw TText = RawTText
   get_fptr (TText fptr) = fptr
   cast_fptr_to_obj = TText
instance Existable TText where
  data Exist TText = forall a. (FPtr a, ITText a) => ETText a

data RawTDirectory
newtype TDirectory = TDirectory (ForeignPtr RawTDirectory) deriving (Eq, Ord, Show)
instance FPtr TDirectory where
   type Raw TDirectory = RawTDirectory
   get_fptr (TDirectory fptr) = fptr
   cast_fptr_to_obj = TDirectory
instance Existable TDirectory where
  data Exist TDirectory = forall a. (FPtr a, ITDirectory a) => ETDirectory a

data RawTDirectoryFile
newtype TDirectoryFile = TDirectoryFile (ForeignPtr RawTDirectoryFile) deriving (Eq, Ord, Show)
instance FPtr TDirectoryFile where
   type Raw TDirectoryFile = RawTDirectoryFile
   get_fptr (TDirectoryFile fptr) = fptr
   cast_fptr_to_obj = TDirectoryFile
instance Existable TDirectoryFile where
  data Exist TDirectoryFile = forall a. (FPtr a, ITDirectoryFile a) => ETDirectoryFile a

data RawTFile
newtype TFile = TFile (ForeignPtr RawTFile) deriving (Eq, Ord, Show)
instance FPtr TFile where
   type Raw TFile = RawTFile
   get_fptr (TFile fptr) = fptr
   cast_fptr_to_obj = TFile
instance Existable TFile where
  data Exist TFile = forall a. (FPtr a, ITFile a) => ETFile a

data RawTBranch
newtype TBranch = TBranch (ForeignPtr RawTBranch) deriving (Eq, Ord, Show)
instance FPtr TBranch where
   type Raw TBranch = RawTBranch
   get_fptr (TBranch fptr) = fptr
   cast_fptr_to_obj = TBranch
instance Existable TBranch where
  data Exist TBranch = forall a. (FPtr a, ITBranch a) => ETBranch a

data RawTVirtualTreePlayer
newtype TVirtualTreePlayer = TVirtualTreePlayer (ForeignPtr RawTVirtualTreePlayer) deriving (Eq, Ord, Show)
instance FPtr TVirtualTreePlayer where
   type Raw TVirtualTreePlayer = RawTVirtualTreePlayer
   get_fptr (TVirtualTreePlayer fptr) = fptr
   cast_fptr_to_obj = TVirtualTreePlayer
instance Existable TVirtualTreePlayer where
  data Exist TVirtualTreePlayer = forall a. (FPtr a, ITVirtualTreePlayer a) => ETVirtualTreePlayer a

data RawTTreePlayer
newtype TTreePlayer = TTreePlayer (ForeignPtr RawTTreePlayer) deriving (Eq, Ord, Show)
instance FPtr TTreePlayer where
   type Raw TTreePlayer = RawTTreePlayer
   get_fptr (TTreePlayer fptr) = fptr
   cast_fptr_to_obj = TTreePlayer
instance Existable TTreePlayer where
  data Exist TTreePlayer = forall a. (FPtr a, ITTreePlayer a) => ETTreePlayer a

data RawTArray
newtype TArray = TArray (ForeignPtr RawTArray) deriving (Eq, Ord, Show)
instance FPtr TArray where
   type Raw TArray = RawTArray
   get_fptr (TArray fptr) = fptr
   cast_fptr_to_obj = TArray
instance Existable TArray where
  data Exist TArray = forall a. (FPtr a, ITArray a) => ETArray a

data RawTArrayC
newtype TArrayC = TArrayC (ForeignPtr RawTArrayC) deriving (Eq, Ord, Show)
instance FPtr TArrayC where
   type Raw TArrayC = RawTArrayC
   get_fptr (TArrayC fptr) = fptr
   cast_fptr_to_obj = TArrayC
instance Existable TArrayC where
  data Exist TArrayC = forall a. (FPtr a, ITArrayC a) => ETArrayC a

data RawTArrayD
newtype TArrayD = TArrayD (ForeignPtr RawTArrayD) deriving (Eq, Ord, Show)
instance FPtr TArrayD where
   type Raw TArrayD = RawTArrayD
   get_fptr (TArrayD fptr) = fptr
   cast_fptr_to_obj = TArrayD
instance Existable TArrayD where
  data Exist TArrayD = forall a. (FPtr a, ITArrayD a) => ETArrayD a

data RawTArrayF
newtype TArrayF = TArrayF (ForeignPtr RawTArrayF) deriving (Eq, Ord, Show)
instance FPtr TArrayF where
   type Raw TArrayF = RawTArrayF
   get_fptr (TArrayF fptr) = fptr
   cast_fptr_to_obj = TArrayF
instance Existable TArrayF where
  data Exist TArrayF = forall a. (FPtr a, ITArrayF a) => ETArrayF a

data RawTArrayI
newtype TArrayI = TArrayI (ForeignPtr RawTArrayI) deriving (Eq, Ord, Show)
instance FPtr TArrayI where
   type Raw TArrayI = RawTArrayI
   get_fptr (TArrayI fptr) = fptr
   cast_fptr_to_obj = TArrayI
instance Existable TArrayI where
  data Exist TArrayI = forall a. (FPtr a, ITArrayI a) => ETArrayI a

data RawTArrayL
newtype TArrayL = TArrayL (ForeignPtr RawTArrayL) deriving (Eq, Ord, Show)
instance FPtr TArrayL where
   type Raw TArrayL = RawTArrayL
   get_fptr (TArrayL fptr) = fptr
   cast_fptr_to_obj = TArrayL
instance Existable TArrayL where
  data Exist TArrayL = forall a. (FPtr a, ITArrayL a) => ETArrayL a

data RawTArrayL64
newtype TArrayL64 = TArrayL64 (ForeignPtr RawTArrayL64) deriving (Eq, Ord, Show)
instance FPtr TArrayL64 where
   type Raw TArrayL64 = RawTArrayL64
   get_fptr (TArrayL64 fptr) = fptr
   cast_fptr_to_obj = TArrayL64
instance Existable TArrayL64 where
  data Exist TArrayL64 = forall a. (FPtr a, ITArrayL64 a) => ETArrayL64 a

data RawTArrayS
newtype TArrayS = TArrayS (ForeignPtr RawTArrayS) deriving (Eq, Ord, Show)
instance FPtr TArrayS where
   type Raw TArrayS = RawTArrayS
   get_fptr (TArrayS fptr) = fptr
   cast_fptr_to_obj = TArrayS
instance Existable TArrayS where
  data Exist TArrayS = forall a. (FPtr a, ITArrayS a) => ETArrayS a

data RawTH1
newtype TH1 = TH1 (ForeignPtr RawTH1) deriving (Eq, Ord, Show)
instance FPtr TH1 where
   type Raw TH1 = RawTH1
   get_fptr (TH1 fptr) = fptr
   cast_fptr_to_obj = TH1
instance Existable TH1 where
  data Exist TH1 = forall a. (FPtr a, ITH1 a) => ETH1 a

data RawTH2
newtype TH2 = TH2 (ForeignPtr RawTH2) deriving (Eq, Ord, Show)
instance FPtr TH2 where
   type Raw TH2 = RawTH2
   get_fptr (TH2 fptr) = fptr
   cast_fptr_to_obj = TH2
instance Existable TH2 where
  data Exist TH2 = forall a. (FPtr a, ITH2 a) => ETH2 a

data RawTH3
newtype TH3 = TH3 (ForeignPtr RawTH3) deriving (Eq, Ord, Show)
instance FPtr TH3 where
   type Raw TH3 = RawTH3
   get_fptr (TH3 fptr) = fptr
   cast_fptr_to_obj = TH3
instance Existable TH3 where
  data Exist TH3 = forall a. (FPtr a, ITH3 a) => ETH3 a

data RawTH1C
newtype TH1C = TH1C (ForeignPtr RawTH1C) deriving (Eq, Ord, Show)
instance FPtr TH1C where
   type Raw TH1C = RawTH1C
   get_fptr (TH1C fptr) = fptr
   cast_fptr_to_obj = TH1C
instance Existable TH1C where
  data Exist TH1C = forall a. (FPtr a, ITH1C a) => ETH1C a

data RawTH1D
newtype TH1D = TH1D (ForeignPtr RawTH1D) deriving (Eq, Ord, Show)
instance FPtr TH1D where
   type Raw TH1D = RawTH1D
   get_fptr (TH1D fptr) = fptr
   cast_fptr_to_obj = TH1D
instance Existable TH1D where
  data Exist TH1D = forall a. (FPtr a, ITH1D a) => ETH1D a

data RawTH1F
newtype TH1F = TH1F (ForeignPtr RawTH1F) deriving (Eq, Ord, Show)
instance FPtr TH1F where
   type Raw TH1F = RawTH1F
   get_fptr (TH1F fptr) = fptr
   cast_fptr_to_obj = TH1F
instance Existable TH1F where
  data Exist TH1F = forall a. (FPtr a, ITH1F a) => ETH1F a

data RawTH1I
newtype TH1I = TH1I (ForeignPtr RawTH1I) deriving (Eq, Ord, Show)
instance FPtr TH1I where
   type Raw TH1I = RawTH1I
   get_fptr (TH1I fptr) = fptr
   cast_fptr_to_obj = TH1I
instance Existable TH1I where
  data Exist TH1I = forall a. (FPtr a, ITH1I a) => ETH1I a

data RawTH1S
newtype TH1S = TH1S (ForeignPtr RawTH1S) deriving (Eq, Ord, Show)
instance FPtr TH1S where
   type Raw TH1S = RawTH1S
   get_fptr (TH1S fptr) = fptr
   cast_fptr_to_obj = TH1S
instance Existable TH1S where
  data Exist TH1S = forall a. (FPtr a, ITH1S a) => ETH1S a

data RawTH2C
newtype TH2C = TH2C (ForeignPtr RawTH2C) deriving (Eq, Ord, Show)
instance FPtr TH2C where
   type Raw TH2C = RawTH2C
   get_fptr (TH2C fptr) = fptr
   cast_fptr_to_obj = TH2C
instance Existable TH2C where
  data Exist TH2C = forall a. (FPtr a, ITH2C a) => ETH2C a

data RawTH2D
newtype TH2D = TH2D (ForeignPtr RawTH2D) deriving (Eq, Ord, Show)
instance FPtr TH2D where
   type Raw TH2D = RawTH2D
   get_fptr (TH2D fptr) = fptr
   cast_fptr_to_obj = TH2D
instance Existable TH2D where
  data Exist TH2D = forall a. (FPtr a, ITH2D a) => ETH2D a

data RawTH2F
newtype TH2F = TH2F (ForeignPtr RawTH2F) deriving (Eq, Ord, Show)
instance FPtr TH2F where
   type Raw TH2F = RawTH2F
   get_fptr (TH2F fptr) = fptr
   cast_fptr_to_obj = TH2F
instance Existable TH2F where
  data Exist TH2F = forall a. (FPtr a, ITH2F a) => ETH2F a

data RawTH2I
newtype TH2I = TH2I (ForeignPtr RawTH2I) deriving (Eq, Ord, Show)
instance FPtr TH2I where
   type Raw TH2I = RawTH2I
   get_fptr (TH2I fptr) = fptr
   cast_fptr_to_obj = TH2I
instance Existable TH2I where
  data Exist TH2I = forall a. (FPtr a, ITH2I a) => ETH2I a

data RawTH2Poly
newtype TH2Poly = TH2Poly (ForeignPtr RawTH2Poly) deriving (Eq, Ord, Show)
instance FPtr TH2Poly where
   type Raw TH2Poly = RawTH2Poly
   get_fptr (TH2Poly fptr) = fptr
   cast_fptr_to_obj = TH2Poly
instance Existable TH2Poly where
  data Exist TH2Poly = forall a. (FPtr a, ITH2Poly a) => ETH2Poly a

data RawTH2S
newtype TH2S = TH2S (ForeignPtr RawTH2S) deriving (Eq, Ord, Show)
instance FPtr TH2S where
   type Raw TH2S = RawTH2S
   get_fptr (TH2S fptr) = fptr
   cast_fptr_to_obj = TH2S
instance Existable TH2S where
  data Exist TH2S = forall a. (FPtr a, ITH2S a) => ETH2S a

data RawTH3C
newtype TH3C = TH3C (ForeignPtr RawTH3C) deriving (Eq, Ord, Show)
instance FPtr TH3C where
   type Raw TH3C = RawTH3C
   get_fptr (TH3C fptr) = fptr
   cast_fptr_to_obj = TH3C
instance Existable TH3C where
  data Exist TH3C = forall a. (FPtr a, ITH3C a) => ETH3C a

data RawTH3D
newtype TH3D = TH3D (ForeignPtr RawTH3D) deriving (Eq, Ord, Show)
instance FPtr TH3D where
   type Raw TH3D = RawTH3D
   get_fptr (TH3D fptr) = fptr
   cast_fptr_to_obj = TH3D
instance Existable TH3D where
  data Exist TH3D = forall a. (FPtr a, ITH3D a) => ETH3D a

data RawTH3F
newtype TH3F = TH3F (ForeignPtr RawTH3F) deriving (Eq, Ord, Show)
instance FPtr TH3F where
   type Raw TH3F = RawTH3F
   get_fptr (TH3F fptr) = fptr
   cast_fptr_to_obj = TH3F
instance Existable TH3F where
  data Exist TH3F = forall a. (FPtr a, ITH3F a) => ETH3F a

data RawTH3I
newtype TH3I = TH3I (ForeignPtr RawTH3I) deriving (Eq, Ord, Show)
instance FPtr TH3I where
   type Raw TH3I = RawTH3I
   get_fptr (TH3I fptr) = fptr
   cast_fptr_to_obj = TH3I
instance Existable TH3I where
  data Exist TH3I = forall a. (FPtr a, ITH3I a) => ETH3I a

data RawTH3S
newtype TH3S = TH3S (ForeignPtr RawTH3S) deriving (Eq, Ord, Show)
instance FPtr TH3S where
   type Raw TH3S = RawTH3S
   get_fptr (TH3S fptr) = fptr
   cast_fptr_to_obj = TH3S
instance Existable TH3S where
  data Exist TH3S = forall a. (FPtr a, ITH3S a) => ETH3S a

data RawTQObject
newtype TQObject = TQObject (ForeignPtr RawTQObject) deriving (Eq, Ord, Show)
instance FPtr TQObject where
   type Raw TQObject = RawTQObject
   get_fptr (TQObject fptr) = fptr
   cast_fptr_to_obj = TQObject
instance Existable TQObject where
  data Exist TQObject = forall a. (FPtr a, ITQObject a) => ETQObject a

data RawTVirtualPad
newtype TVirtualPad = TVirtualPad (ForeignPtr RawTVirtualPad) deriving (Eq, Ord, Show)
instance FPtr TVirtualPad where
   type Raw TVirtualPad = RawTVirtualPad
   get_fptr (TVirtualPad fptr) = fptr
   cast_fptr_to_obj = TVirtualPad
instance Existable TVirtualPad where
  data Exist TVirtualPad = forall a. (FPtr a, ITVirtualPad a) => ETVirtualPad a

data RawTPad
newtype TPad = TPad (ForeignPtr RawTPad) deriving (Eq, Ord, Show)
instance FPtr TPad where
   type Raw TPad = RawTPad
   get_fptr (TPad fptr) = fptr
   cast_fptr_to_obj = TPad
instance Existable TPad where
  data Exist TPad = forall a. (FPtr a, ITPad a) => ETPad a

data RawTButton
newtype TButton = TButton (ForeignPtr RawTButton) deriving (Eq, Ord, Show)
instance FPtr TButton where
   type Raw TButton = RawTButton
   get_fptr (TButton fptr) = fptr
   cast_fptr_to_obj = TButton
instance Existable TButton where
  data Exist TButton = forall a. (FPtr a, ITButton a) => ETButton a

data RawTGroupButton
newtype TGroupButton = TGroupButton (ForeignPtr RawTGroupButton) deriving (Eq, Ord, Show)
instance FPtr TGroupButton where
   type Raw TGroupButton = RawTGroupButton
   get_fptr (TGroupButton fptr) = fptr
   cast_fptr_to_obj = TGroupButton
instance Existable TGroupButton where
  data Exist TGroupButton = forall a. (FPtr a, ITGroupButton a) => ETGroupButton a

data RawTCanvas
newtype TCanvas = TCanvas (ForeignPtr RawTCanvas) deriving (Eq, Ord, Show)
instance FPtr TCanvas where
   type Raw TCanvas = RawTCanvas
   get_fptr (TCanvas fptr) = fptr
   cast_fptr_to_obj = TCanvas
instance Existable TCanvas where
  data Exist TCanvas = forall a. (FPtr a, ITCanvas a) => ETCanvas a

data RawTDialogCanvas
newtype TDialogCanvas = TDialogCanvas (ForeignPtr RawTDialogCanvas) deriving (Eq, Ord, Show)
instance FPtr TDialogCanvas where
   type Raw TDialogCanvas = RawTDialogCanvas
   get_fptr (TDialogCanvas fptr) = fptr
   cast_fptr_to_obj = TDialogCanvas
instance Existable TDialogCanvas where
  data Exist TDialogCanvas = forall a. (FPtr a, ITDialogCanvas a) => ETDialogCanvas a

data RawTInspectCanvas
newtype TInspectCanvas = TInspectCanvas (ForeignPtr RawTInspectCanvas) deriving (Eq, Ord, Show)
instance FPtr TInspectCanvas where
   type Raw TInspectCanvas = RawTInspectCanvas
   get_fptr (TInspectCanvas fptr) = fptr
   cast_fptr_to_obj = TInspectCanvas
instance Existable TInspectCanvas where
  data Exist TInspectCanvas = forall a. (FPtr a, ITInspectCanvas a) => ETInspectCanvas a

data RawTEvePad
newtype TEvePad = TEvePad (ForeignPtr RawTEvePad) deriving (Eq, Ord, Show)
instance FPtr TEvePad where
   type Raw TEvePad = RawTEvePad
   get_fptr (TEvePad fptr) = fptr
   cast_fptr_to_obj = TEvePad
instance Existable TEvePad where
  data Exist TEvePad = forall a. (FPtr a, ITEvePad a) => ETEvePad a

data RawTSlider
newtype TSlider = TSlider (ForeignPtr RawTSlider) deriving (Eq, Ord, Show)
instance FPtr TSlider where
   type Raw TSlider = RawTSlider
   get_fptr (TSlider fptr) = fptr
   cast_fptr_to_obj = TSlider
instance Existable TSlider where
  data Exist TSlider = forall a. (FPtr a, ITSlider a) => ETSlider a

data RawTApplication
newtype TApplication = TApplication (ForeignPtr RawTApplication) deriving (Eq, Ord, Show)
instance FPtr TApplication where
   type Raw TApplication = RawTApplication
   get_fptr (TApplication fptr) = fptr
   cast_fptr_to_obj = TApplication
instance Existable TApplication where
  data Exist TApplication = forall a. (FPtr a, ITApplication a) => ETApplication a

data RawTRint
newtype TRint = TRint (ForeignPtr RawTRint) deriving (Eq, Ord, Show)
instance FPtr TRint where
   type Raw TRint = RawTRint
   get_fptr (TRint fptr) = fptr
   cast_fptr_to_obj = TRint
instance Existable TRint where
  data Exist TRint = forall a. (FPtr a, ITRint a) => ETRint a

data RawTRandom
newtype TRandom = TRandom (ForeignPtr RawTRandom) deriving (Eq, Ord, Show)
instance FPtr TRandom where
   type Raw TRandom = RawTRandom
   get_fptr (TRandom fptr) = fptr
   cast_fptr_to_obj = TRandom
instance Existable TRandom where
  data Exist TRandom = forall a. (FPtr a, ITRandom a) => ETRandom a

data RawTCollection
newtype TCollection = TCollection (ForeignPtr RawTCollection) deriving (Eq, Ord, Show)
instance FPtr TCollection where
   type Raw TCollection = RawTCollection
   get_fptr (TCollection fptr) = fptr
   cast_fptr_to_obj = TCollection
instance Existable TCollection where
  data Exist TCollection = forall a. (FPtr a, ITCollection a) => ETCollection a

data RawTSeqCollection
newtype TSeqCollection = TSeqCollection (ForeignPtr RawTSeqCollection) deriving (Eq, Ord, Show)
instance FPtr TSeqCollection where
   type Raw TSeqCollection = RawTSeqCollection
   get_fptr (TSeqCollection fptr) = fptr
   cast_fptr_to_obj = TSeqCollection
instance Existable TSeqCollection where
  data Exist TSeqCollection = forall a. (FPtr a, ITSeqCollection a) => ETSeqCollection a

data RawTObjArray
newtype TObjArray = TObjArray (ForeignPtr RawTObjArray) deriving (Eq, Ord, Show)
instance FPtr TObjArray where
   type Raw TObjArray = RawTObjArray
   get_fptr (TObjArray fptr) = fptr
   cast_fptr_to_obj = TObjArray
instance Existable TObjArray where
  data Exist TObjArray = forall a. (FPtr a, ITObjArray a) => ETObjArray a


class IDeletable a where

    delete :: a -> IO () 


class (IDeletable a) => ITObject a where
    -- | 
    --   > char* TObject::GetName()
    --   

    getName :: a -> IO String 
    -- | 
    --   > void TObject::Draw( char* option )
    --   

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

    findObject :: a -> String -> IO (Exist TObject) 

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

    write :: a -> String -> Int -> Int -> IO Int 

    isA :: a -> IO (Exist TClass) 

-- | 
--   Class TNamed
--   reference : http://root.cern.ch

class (ITObject a) => ITNamed a where
    -- | SetTitle method
    --   
    --   > SetTitle( char* name, char* title ) 
    --   

    setTitle :: a -> String -> IO () 


class (ITNamed a) => ITDictionary a where


class (ITDictionary a) => ITClass a where


class (ITNamed a) => ITFormula a where

    getParameter :: a -> Int -> IO Double 

    setParameter :: a -> Int -> Double -> IO () 


class (IDeletable a) => ITAtt3D a where


class (IDeletable a) => ITAttAxis a where

    setLabelColor :: a -> Int -> IO () 

    setLabelSize :: a -> Double -> IO () 

    setTickLength :: a -> Double -> IO () 

    setTitleOffset :: a -> Double -> IO () 

    setNdivisions :: a -> Int -> Int -> IO () 


class (IDeletable a) => ITAttBBox a where


class (IDeletable a) => ITAttCanvas a where


class (IDeletable a) => ITAttFill a where

    setFillColor :: a -> Int -> IO () 

    setFillStyle :: a -> Int -> IO () 


class (IDeletable a) => ITAttImage a where


class (IDeletable a) => ITAttLine a where

    setLineColor :: a -> Int -> IO () 


class (IDeletable a) => ITAttMarker a where


class (IDeletable a) => ITAttPad a where


class (ITNamed a) => ITAttParticle a where


class (IDeletable a) => ITAttText a where

    setTextColor :: a -> Int -> IO () 

    setTextAlign :: a -> Int -> IO () 

    setTextSize :: a -> Double -> IO () 


class (ITNamed a) => ITHStack a where


class (ITFormula a,ITAttLine a,ITAttFill a) => ITF1 a where


class (ITNamed a,ITAttLine a,ITAttFill a,ITAttMarker a) => ITGraph a where


class (ITGraph a) => ITGraphAsymmErrors a where


class (ITGraph a) => ITCutG a where


class (ITGraph a) => ITGraphBentErrors a where


class (ITGraph a) => ITGraphErrors a where


class (ITGraphErrors a) => ITGraphPolar a where


class (ITGraph a) => ITGraphQQ a where


class (ITObject a,ITAttLine a,ITAttFill a) => ITEllipse a where


class (ITEllipse a) => ITArc a where


class (ITEllipse a) => ITCrown a where


class (ITObject a,ITAttLine a) => ITLine a where


class (ITLine a,ITAttFill a) => ITArrow a where


class (ITLine a,ITAttText a) => ITGaxis a where


class (ITNamed a,ITAttLine a,ITAttFill a,ITAtt3D a) => ITShape a where


class (ITShape a) => ITBRIK a where


class (ITShape a) => ITTUBE a where


class (ITShape a) => ITPCON a where


class (ITShape a) => ITSPHE a where


class (ITShape a) => ITXTRU a where


class (ITObject a,ITAttLine a,ITAttFill a) => ITBox a where


class (ITBox a) => ITPave a where


class (ITPave a,ITAttText a) => ITPaveText a where


class (ITPaveText a) => ITDiamond a where


class (ITPaveText a) => ITPaveStats a where


class (ITPaveText a) => ITPavesText a where


class (ITPave a,ITAttText a) => ITLegend a where


class (ITPave a,ITAttText a) => ITPaveLabel a where


class (ITPaveLabel a) => ITPaveClass a where


class (ITBox a) => ITWbox a where

    setBorderMode :: a -> Int -> IO () 


class (ITWbox a) => ITFrame a where


class (ITWbox a) => ITSliderBox a where


class (ITNamed a,ITAttLine a,ITAttFill a,ITAttMarker a) => ITTree a where


class (ITTree a) => ITChain a where


class (ITTree a) => ITNtuple a where


class (ITTree a) => ITNtupleD a where


class (ITTree a) => ITTreeSQL a where


class (ITObject a,ITAttLine a,ITAttFill a) => ITPolyLine a where


class (ITPolyLine a) => ITCurlyLine a where


class (ITCurlyLine a) => ITCurlyArc a where


class (ITNamed a,ITAttLine a,ITAttFill a,ITAttMarker a) => ITEfficiency a where


class (ITNamed a,ITAttAxis a) => ITAxis a where


class (ITText a,ITAttLine a) => ITLatex a where


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


class (ITNamed a) => ITDirectory a where

    close :: a -> String -> IO () 

    get :: a -> String -> IO (Exist TObject) 


class (ITDirectory a) => ITDirectoryFile a where


class (ITDirectoryFile a) => ITFile a where


class (ITNamed a,ITAttFill a) => ITBranch a where


class (ITObject a) => ITVirtualTreePlayer a where


class (ITVirtualTreePlayer a) => ITTreePlayer a where


class (IDeletable a) => ITArray a where


class (ITArray a) => ITArrayC a where


class (ITArray a) => ITArrayD a where


class (ITArray a) => ITArrayF a where


class (ITArray a) => ITArrayI a where


class (ITArray a) => ITArrayL a where


class (ITArray a) => ITArrayL64 a where


class (ITArray a) => ITArrayS a where

-- |  the TH1 class : the mother class of all histogram classes 
--   
--   > class TH1 : TNamed, TAttLine, TAttFill, TAttMarker
--   

class (ITNamed a,ITAttLine a,ITAttFill a,ITAttMarker a) => ITH1 a where
    -- |  
    --   > void TH1::Add( TH1* h1, Double_t c1 ) 
    --   

    add :: (ITH1 c0, FPtr c0) => a -> c0 -> Double -> IO () 
    -- | 
    --   > void TH1::AddBinContent( Int_t bin, Double_t w )
    --   

    addBinContent :: a -> Int -> Double -> IO () 
    -- | 
    --   > Double_t TH1::Chi2Test( const TH1* h2, Option_t* option="UU", Double_t* res=0 ) const
    --   

    chi2Test :: (ITH1 c0, FPtr c0) => a -> c0 -> String -> [Double] -> IO Double 
    -- | 
    --   > Double_t TH1::ComputeIntegral ()
    --   

    computeIntegral :: a -> IO Double 
    -- | 
    --   > void TH1::DirectoryAutoAdd(TDirectory* )
    --   

    directoryAutoAdd :: (ITDirectory c0, FPtr c0) => a -> c0 -> IO () 
    -- | 
    --   > Int_t TH1::DistancetoPrimitive(Int_t px, Int_t py)
    --   

    distancetoPrimitive :: a -> Int -> Int -> IO Int 
    -- | 
    --   > void TH1::Divide(const TH1* h1, const TH1* h2, Double_t c1=1, Double_t c2=1, Option_t* option="")
    --   

    divide :: (ITH2 c1, FPtr c1, ITH1 c0, FPtr c0) => a -> c0 -> c1 -> Double -> Double -> String -> IO () 
    -- | 
    --   > TH1* TH1::DrawCopy (Option_t* option="") const 
    --   

    drawCopy :: a -> String -> IO a 
    -- | 
    --   > TH1* TH1::DrawNormalized (Option_t* option="", Double_t norm=1) const
    --   

    drawNormalized :: a -> String -> Double -> IO (Exist TH1) 
    -- | 
    --   > void TH1::DrawPanel()
    --   

    drawPanel :: a -> IO () 

    bufferEmpty :: a -> Int -> IO Int 

    eval :: (ITF1 c0, FPtr c0) => a -> c0 -> String -> IO () 

    executeEvent :: a -> Int -> Int -> Int -> IO () 

    fFT :: (ITH1 c0, FPtr c0) => a -> c0 -> String -> IO (Exist TH1) 

    fill1 :: a -> Double -> IO Int 

    fillN :: a -> Int -> [Double] -> [Double] -> Int -> IO () 

    fillRandom :: (ITH1 c0, FPtr c0) => a -> c0 -> Int -> IO () 

    findBin :: a -> Double -> Double -> Double -> IO Int 

    findFixBin :: a -> Double -> Double -> Double -> IO Int 

    findFirstBinAbove :: a -> Double -> Int -> IO Int 

    findLastBinAbove :: a -> Double -> Int -> IO Int 

    fitPanel :: a -> IO () 

    getNdivisions :: a -> String -> IO Int 

    getAxisColor :: a -> String -> IO Int 

    getLabelColor :: a -> String -> IO Int 

    getLabelFont :: a -> String -> IO Int 

    getLabelOffset :: a -> String -> IO Double 

    getLabelSize :: a -> String -> IO Double 

    getTitleFont :: a -> String -> IO Int 

    getTitleOffset :: a -> String -> IO Double 

    getTitleSize :: a -> String -> IO Double 

    getTickLength :: a -> String -> IO Double 

    getBarOffset :: a -> IO Double 

    getBarWidth :: a -> IO Double 

    getContour :: a -> [Double] -> IO Int 

    getContourLevel :: a -> Int -> IO Double 

    getContourLevelPad :: a -> Int -> IO Double 

    getBin :: a -> Int -> Int -> Int -> IO Int 

    getBinCenter :: a -> Int -> IO Double 

    getBinContent1 :: a -> Int -> IO Double 

    getBinContent2 :: a -> Int -> Int -> IO Double 

    getBinContent3 :: a -> Int -> Int -> Int -> IO Double 

    getBinError1 :: a -> Int -> IO Double 

    getBinError2 :: a -> Int -> Int -> IO Double 

    getBinError3 :: a -> Int -> Int -> Int -> IO Double 

    getBinLowEdge :: a -> Int -> IO Double 

    getBinWidth :: a -> Int -> IO Double 

    getCellContent :: a -> Int -> Int -> IO Double 

    getCellError :: a -> Int -> Int -> IO Double 


class (ITH1 a) => ITH2 a where
    -- | 
    --   > Int_t    Fill(Double_t x, Double_t y);

    fill2 :: a -> Double -> Double -> IO Int 
    -- | 
    --   > void     FillRandom(TH1 *h, Int_t ntimes=5000);
    --   

    fillRandom2 :: (ITH1 c0, FPtr c0) => a -> c0 -> Int -> IO () 
    -- | 
    --   > Int_t    FindFirstBinAbove(Double_t threshold=0, Int_t axis=1) const;
    --   

    findFirstBinAbove2 :: a -> Double -> Int -> IO Int 
    -- | 
    --   > Int_t    FindLastBinAbove (Double_t threshold=0, Int_t axis=1) const;
    --   

    findLastBinAbove2 :: a -> Double -> Int -> IO Int 
    -- | 
    --   > void     FitSlicesX(TF1 *f1=0,Int_t firstybin=0, Int_t lastybin=-1, Int_t cut=0, Option_t *option="QNR", TObjArray* arr = 0); // *MENU*
    --   

    fitSlicesX :: (ITObjArray c1, FPtr c1, ITF1 c0, FPtr c0) => a -> c0 -> Int -> Int -> Int -> String -> c1 -> IO () 
    -- | 
    --   > void     FitSlicesY(TF1 *f1=0,Int_t firstxbin=0, Int_t lastxbin=-1, Int_t cut=0, Option_t *option="QNR", TObjArray* arr = 0); // *MENU*
    --   

    fitSlicesY :: (ITObjArray c1, FPtr c1, ITF1 c0, FPtr c0) => a -> c0 -> Int -> Int -> Int -> String -> c1 -> IO () 
    -- | 
    --   > Double_t GetCorrelationFactor(Int_t axis1=1,Int_t axis2=2) const;
    --   

    getCorrelationFactor :: a -> Int -> Int -> IO Double 
    -- | 
    --   > Double_t GetCovariance(Int_t axis1=1,Int_t axis2=2) const;
    --   

    getCovariance :: a -> Int -> Int -> IO Double 
    -- | 
    --   > void     GetStats(Double_t *stats) const;
    --   

    getStats :: a -> [Double] -> IO () 
    -- | 
    --   > Double_t Integral(Int_t binx1, Int_t binx2, Int_t biny1, Int_t biny2, Option_t *option="") const;
    --   

    integral :: a -> Int -> Int -> Int -> Int -> String -> IO Double 
    -- | 
    --   > Double_t Interpolate(Double_t x, Double_t y, Double_t z);
    --   

    interpolate :: a -> Double -> Double -> Double -> IO Double 
    -- | 
    --   > Double_t KolmogorovTest(const TH1 *h2, Option_t *option="") const;
    --   

    kolmogorovTest :: (ITH1 c0, FPtr c0) => a -> c0 -> String -> IO Double 
    -- | 
    --   > TH2     *RebinX(Int_t ngroup=2, const char *newname="");
    --   

    rebinX :: a -> Int -> String -> IO (Exist TH2) 
    -- | 
    --   > TH2     *RebinY(Int_t ngroup=2, const char *newname="");  
    --   

    rebinY :: a -> Int -> String -> IO (Exist TH2) 
    -- | 
    --   > TH2     *Rebin2D(Int_t nxgroup=2, Int_t nygroup=2, const char *newname="");     
    --   

    rebin2D :: a -> Int -> Int -> String -> IO (Exist TH2) 
    -- | 
    --   > void     PutStats(Double_t *stats);
    --   

    putStats :: a -> [Double] -> IO () 
    -- | 
    --   > void     Reset(Option_t *option="");
    --   

    reset :: a -> String -> IO () 
    -- | 
    --   > void     SetShowProjectionX(Int_t nbins);  // *MENU*
    --   

    setShowProjectionX :: a -> Int -> IO () 
    -- | 
    --   > void     SetShowProjectionY(Int_t nbins);  // *MENU*
    --   

    setShowProjectionY :: a -> Int -> IO () 
    -- | 
    --   > TH1     *ShowBackground(Int_t niter=20, Option_t *option="same");
    --   

    showBackground :: a -> Int -> String -> IO (Exist TH1) 
    -- | 
    --   > Int_t    ShowPeaks(Double_t sigma=2, Option_t *option="", Double_t threshold=0.05); // *MENU*
    --   

    showPeaks :: a -> Double -> String -> Double -> IO Int 
    -- | 
    --   > void     Smooth(Int_t ntimes=1, Option_t *option=""); // *MENU*
    --   

    smooth :: a -> Int -> String -> IO () 


class (ITH1 a,ITAtt3D a) => ITH3 a where


class (ITH1 a,ITArrayC a) => ITH1C a where


class (ITH1 a,ITArrayD a) => ITH1D a where


class (ITH1 a,ITArrayF a) => ITH1F a where


class (ITH1 a,ITArrayI a) => ITH1I a where


class (ITH1 a,ITArrayS a) => ITH1S a where


class (ITH2 a,ITArrayC a) => ITH2C a where


class (ITH2 a,ITArrayD a) => ITH2D a where


class (ITH2 a,ITArrayF a) => ITH2F a where


class (ITH2 a,ITArrayI a) => ITH2I a where


class (ITH2 a) => ITH2Poly a where


class (ITH2 a,ITArrayS a) => ITH2S a where


class (ITH3 a,ITArrayC a) => ITH3C a where


class (ITH3 a,ITArrayD a) => ITH3D a where


class (ITH3 a,ITArrayF a) => ITH3F a where


class (ITH3 a,ITArrayI a) => ITH3I a where


class (ITH3 a,ITArrayS a) => ITH3S a where


class (IDeletable a) => ITQObject a where


class (ITObject a,ITAttLine a,ITAttFill a,ITAttPad a,ITQObject a) => ITVirtualPad a where

    getFrame :: a -> IO (Exist TFrame) 

    range :: a -> Double -> Double -> Double -> Double -> IO () 


class (ITVirtualPad a) => ITPad a where


class (ITPad a,ITAttText a) => ITButton a where


class (ITButton a) => ITGroupButton a where


class (ITPad a) => ITCanvas a where


class (ITCanvas a,ITAttText a) => ITDialogCanvas a where


class (ITCanvas a,ITAttText a) => ITInspectCanvas a where


class (ITPad a) => ITEvePad a where


class (ITPad a) => ITSlider a where


class (ITObject a,ITQObject a) => ITApplication a where

    run :: a -> Int -> IO () 


class (ITApplication a) => ITRint a where


class (ITNamed a) => ITRandom a where

    gaus :: a -> Double -> Double -> IO Double 

    uniform :: a -> Double -> Double -> IO Double 


class (ITObject a) => ITCollection a where


class (ITCollection a) => ITSeqCollection a where


class (ITSeqCollection a) => ITObjArray a where

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

upcastTNamed :: (FPtr a, ITNamed a) => a -> TNamed
upcastTNamed h = let fh = get_fptr h
                     fh2 :: ForeignPtr RawTNamed = castForeignPtr fh
                 in cast_fptr_to_obj fh2

upcastTClass :: (FPtr a, ITClass a) => a -> TClass
upcastTClass h = let fh = get_fptr h
                     fh2 :: ForeignPtr RawTClass = castForeignPtr fh
                 in cast_fptr_to_obj fh2

upcastTFormula :: (FPtr a, ITFormula a) => a -> TFormula
upcastTFormula h = let fh = get_fptr h
                       fh2 :: ForeignPtr RawTFormula = castForeignPtr fh
                   in cast_fptr_to_obj fh2

upcastTAtt3D :: (FPtr a, ITAtt3D a) => a -> TAtt3D
upcastTAtt3D h = let fh = get_fptr h
                     fh2 :: ForeignPtr RawTAtt3D = castForeignPtr fh
                 in cast_fptr_to_obj fh2

upcastTAttAxis :: (FPtr a, ITAttAxis a) => a -> TAttAxis
upcastTAttAxis h = let fh = get_fptr h
                       fh2 :: ForeignPtr RawTAttAxis = castForeignPtr fh
                   in cast_fptr_to_obj fh2

upcastTAttBBox :: (FPtr a, ITAttBBox a) => a -> TAttBBox
upcastTAttBBox h = let fh = get_fptr h
                       fh2 :: ForeignPtr RawTAttBBox = castForeignPtr fh
                   in cast_fptr_to_obj fh2

upcastTAttCanvas :: (FPtr a, ITAttCanvas a) => a -> TAttCanvas
upcastTAttCanvas h = let fh = get_fptr h
                         fh2 :: ForeignPtr RawTAttCanvas = castForeignPtr fh
                     in cast_fptr_to_obj fh2

upcastTAttFill :: (FPtr a, ITAttFill a) => a -> TAttFill
upcastTAttFill h = let fh = get_fptr h
                       fh2 :: ForeignPtr RawTAttFill = castForeignPtr fh
                   in cast_fptr_to_obj fh2

upcastTAttImage :: (FPtr a, ITAttImage a) => a -> TAttImage
upcastTAttImage h = let fh = get_fptr h
                        fh2 :: ForeignPtr RawTAttImage = castForeignPtr fh
                    in cast_fptr_to_obj fh2

upcastTAttLine :: (FPtr a, ITAttLine a) => a -> TAttLine
upcastTAttLine h = let fh = get_fptr h
                       fh2 :: ForeignPtr RawTAttLine = castForeignPtr fh
                   in cast_fptr_to_obj fh2

upcastTAttMarker :: (FPtr a, ITAttMarker a) => a -> TAttMarker
upcastTAttMarker h = let fh = get_fptr h
                         fh2 :: ForeignPtr RawTAttMarker = castForeignPtr fh
                     in cast_fptr_to_obj fh2

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

upcastTAttParticle :: (FPtr a, ITAttParticle a) => a -> TAttParticle
upcastTAttParticle h = let fh = get_fptr h
                           fh2 :: ForeignPtr RawTAttParticle = castForeignPtr fh
                       in cast_fptr_to_obj fh2

upcastTAttText :: (FPtr a, ITAttText a) => a -> TAttText
upcastTAttText h = let fh = get_fptr h
                       fh2 :: ForeignPtr RawTAttText = castForeignPtr fh
                   in cast_fptr_to_obj fh2

upcastTHStack :: (FPtr a, ITHStack a) => a -> THStack
upcastTHStack h = let fh = get_fptr h
                      fh2 :: ForeignPtr RawTHStack = castForeignPtr fh
                  in cast_fptr_to_obj fh2

upcastTF1 :: (FPtr a, ITF1 a) => a -> TF1
upcastTF1 h = let fh = get_fptr h
                  fh2 :: ForeignPtr RawTF1 = castForeignPtr fh
              in cast_fptr_to_obj fh2

upcastTGraph :: (FPtr a, ITGraph a) => a -> TGraph
upcastTGraph h = let fh = get_fptr h
                     fh2 :: ForeignPtr RawTGraph = castForeignPtr fh
                 in cast_fptr_to_obj fh2

upcastTGraphAsymmErrors :: (FPtr a, ITGraphAsymmErrors a) => a -> TGraphAsymmErrors
upcastTGraphAsymmErrors h = let fh = get_fptr h
                                fh2 :: ForeignPtr RawTGraphAsymmErrors = castForeignPtr fh
                            in cast_fptr_to_obj fh2

upcastTCutG :: (FPtr a, ITCutG a) => a -> TCutG
upcastTCutG h = let fh = get_fptr h
                    fh2 :: ForeignPtr RawTCutG = castForeignPtr fh
                in cast_fptr_to_obj fh2

upcastTGraphBentErrors :: (FPtr a, ITGraphBentErrors a) => a -> TGraphBentErrors
upcastTGraphBentErrors h = let fh = get_fptr h
                               fh2 :: ForeignPtr RawTGraphBentErrors = castForeignPtr fh
                           in cast_fptr_to_obj fh2

upcastTGraphErrors :: (FPtr a, ITGraphErrors a) => a -> TGraphErrors
upcastTGraphErrors h = let fh = get_fptr h
                           fh2 :: ForeignPtr RawTGraphErrors = castForeignPtr fh
                       in cast_fptr_to_obj fh2

upcastTGraphPolar :: (FPtr a, ITGraphPolar a) => a -> TGraphPolar
upcastTGraphPolar h = let fh = get_fptr h
                          fh2 :: ForeignPtr RawTGraphPolar = castForeignPtr fh
                      in cast_fptr_to_obj fh2

upcastTGraphQQ :: (FPtr a, ITGraphQQ a) => a -> TGraphQQ
upcastTGraphQQ h = let fh = get_fptr h
                       fh2 :: ForeignPtr RawTGraphQQ = castForeignPtr fh
                   in cast_fptr_to_obj fh2

upcastTEllipse :: (FPtr a, ITEllipse a) => a -> TEllipse
upcastTEllipse h = let fh = get_fptr h
                       fh2 :: ForeignPtr RawTEllipse = castForeignPtr fh
                   in cast_fptr_to_obj fh2

upcastTArc :: (FPtr a, ITArc a) => a -> TArc
upcastTArc h = let fh = get_fptr h
                   fh2 :: ForeignPtr RawTArc = castForeignPtr fh
               in cast_fptr_to_obj fh2

upcastTCrown :: (FPtr a, ITCrown a) => a -> TCrown
upcastTCrown h = let fh = get_fptr h
                     fh2 :: ForeignPtr RawTCrown = castForeignPtr fh
                 in cast_fptr_to_obj fh2

upcastTLine :: (FPtr a, ITLine a) => a -> TLine
upcastTLine h = let fh = get_fptr h
                    fh2 :: ForeignPtr RawTLine = castForeignPtr fh
                in cast_fptr_to_obj fh2

upcastTArrow :: (FPtr a, ITArrow a) => a -> TArrow
upcastTArrow h = let fh = get_fptr h
                     fh2 :: ForeignPtr RawTArrow = castForeignPtr fh
                 in cast_fptr_to_obj fh2

upcastTGaxis :: (FPtr a, ITGaxis a) => a -> TGaxis
upcastTGaxis h = let fh = get_fptr h
                     fh2 :: ForeignPtr RawTGaxis = castForeignPtr fh
                 in cast_fptr_to_obj fh2

upcastTShape :: (FPtr a, ITShape a) => a -> TShape
upcastTShape h = let fh = get_fptr h
                     fh2 :: ForeignPtr RawTShape = castForeignPtr fh
                 in cast_fptr_to_obj fh2

upcastTBRIK :: (FPtr a, ITBRIK a) => a -> TBRIK
upcastTBRIK h = let fh = get_fptr h
                    fh2 :: ForeignPtr RawTBRIK = castForeignPtr fh
                in cast_fptr_to_obj fh2

upcastTTUBE :: (FPtr a, ITTUBE a) => a -> TTUBE
upcastTTUBE h = let fh = get_fptr h
                    fh2 :: ForeignPtr RawTTUBE = castForeignPtr fh
                in cast_fptr_to_obj fh2

upcastTPCON :: (FPtr a, ITPCON a) => a -> TPCON
upcastTPCON h = let fh = get_fptr h
                    fh2 :: ForeignPtr RawTPCON = castForeignPtr fh
                in cast_fptr_to_obj fh2

upcastTSPHE :: (FPtr a, ITSPHE a) => a -> TSPHE
upcastTSPHE h = let fh = get_fptr h
                    fh2 :: ForeignPtr RawTSPHE = castForeignPtr fh
                in cast_fptr_to_obj fh2

upcastTXTRU :: (FPtr a, ITXTRU a) => a -> TXTRU
upcastTXTRU h = let fh = get_fptr h
                    fh2 :: ForeignPtr RawTXTRU = castForeignPtr fh
                in cast_fptr_to_obj fh2

upcastTBox :: (FPtr a, ITBox a) => a -> TBox
upcastTBox h = let fh = get_fptr h
                   fh2 :: ForeignPtr RawTBox = castForeignPtr fh
               in cast_fptr_to_obj fh2

upcastTPave :: (FPtr a, ITPave a) => a -> TPave
upcastTPave h = let fh = get_fptr h
                    fh2 :: ForeignPtr RawTPave = castForeignPtr fh
                in cast_fptr_to_obj fh2

upcastTPaveText :: (FPtr a, ITPaveText a) => a -> TPaveText
upcastTPaveText h = let fh = get_fptr h
                        fh2 :: ForeignPtr RawTPaveText = castForeignPtr fh
                    in cast_fptr_to_obj fh2

upcastTDiamond :: (FPtr a, ITDiamond a) => a -> TDiamond
upcastTDiamond h = let fh = get_fptr h
                       fh2 :: ForeignPtr RawTDiamond = castForeignPtr fh
                   in cast_fptr_to_obj fh2

upcastTPaveStats :: (FPtr a, ITPaveStats a) => a -> TPaveStats
upcastTPaveStats h = let fh = get_fptr h
                         fh2 :: ForeignPtr RawTPaveStats = castForeignPtr fh
                     in cast_fptr_to_obj fh2

upcastTPavesText :: (FPtr a, ITPavesText a) => a -> TPavesText
upcastTPavesText h = let fh = get_fptr h
                         fh2 :: ForeignPtr RawTPavesText = castForeignPtr fh
                     in cast_fptr_to_obj fh2

upcastTLegend :: (FPtr a, ITLegend a) => a -> TLegend
upcastTLegend h = let fh = get_fptr h
                      fh2 :: ForeignPtr RawTLegend = castForeignPtr fh
                  in cast_fptr_to_obj fh2

upcastTPaveLabel :: (FPtr a, ITPaveLabel a) => a -> TPaveLabel
upcastTPaveLabel h = let fh = get_fptr h
                         fh2 :: ForeignPtr RawTPaveLabel = castForeignPtr fh
                     in cast_fptr_to_obj fh2

upcastTPaveClass :: (FPtr a, ITPaveClass a) => a -> TPaveClass
upcastTPaveClass h = let fh = get_fptr h
                         fh2 :: ForeignPtr RawTPaveClass = castForeignPtr fh
                     in cast_fptr_to_obj fh2

upcastTWbox :: (FPtr a, ITWbox a) => a -> TWbox
upcastTWbox h = let fh = get_fptr h
                    fh2 :: ForeignPtr RawTWbox = castForeignPtr fh
                in cast_fptr_to_obj fh2

upcastTFrame :: (FPtr a, ITFrame a) => a -> TFrame
upcastTFrame h = let fh = get_fptr h
                     fh2 :: ForeignPtr RawTFrame = castForeignPtr fh
                 in cast_fptr_to_obj fh2

upcastTSliderBox :: (FPtr a, ITSliderBox a) => a -> TSliderBox
upcastTSliderBox h = let fh = get_fptr h
                         fh2 :: ForeignPtr RawTSliderBox = castForeignPtr fh
                     in cast_fptr_to_obj fh2

upcastTTree :: (FPtr a, ITTree a) => a -> TTree
upcastTTree h = let fh = get_fptr h
                    fh2 :: ForeignPtr RawTTree = castForeignPtr fh
                in cast_fptr_to_obj fh2

upcastTChain :: (FPtr a, ITChain a) => a -> TChain
upcastTChain h = let fh = get_fptr h
                     fh2 :: ForeignPtr RawTChain = castForeignPtr fh
                 in cast_fptr_to_obj fh2

upcastTNtuple :: (FPtr a, ITNtuple a) => a -> TNtuple
upcastTNtuple h = let fh = get_fptr h
                      fh2 :: ForeignPtr RawTNtuple = castForeignPtr fh
                  in cast_fptr_to_obj fh2

upcastTNtupleD :: (FPtr a, ITNtupleD a) => a -> TNtupleD
upcastTNtupleD h = let fh = get_fptr h
                       fh2 :: ForeignPtr RawTNtupleD = castForeignPtr fh
                   in cast_fptr_to_obj fh2

upcastTTreeSQL :: (FPtr a, ITTreeSQL a) => a -> TTreeSQL
upcastTTreeSQL h = let fh = get_fptr h
                       fh2 :: ForeignPtr RawTTreeSQL = castForeignPtr fh
                   in cast_fptr_to_obj fh2

upcastTPolyLine :: (FPtr a, ITPolyLine a) => a -> TPolyLine
upcastTPolyLine h = let fh = get_fptr h
                        fh2 :: ForeignPtr RawTPolyLine = castForeignPtr fh
                    in cast_fptr_to_obj fh2

upcastTCurlyLine :: (FPtr a, ITCurlyLine a) => a -> TCurlyLine
upcastTCurlyLine h = let fh = get_fptr h
                         fh2 :: ForeignPtr RawTCurlyLine = castForeignPtr fh
                     in cast_fptr_to_obj fh2

upcastTCurlyArc :: (FPtr a, ITCurlyArc a) => a -> TCurlyArc
upcastTCurlyArc h = let fh = get_fptr h
                        fh2 :: ForeignPtr RawTCurlyArc = castForeignPtr fh
                    in cast_fptr_to_obj fh2

upcastTEfficiency :: (FPtr a, ITEfficiency a) => a -> TEfficiency
upcastTEfficiency h = let fh = get_fptr h
                          fh2 :: ForeignPtr RawTEfficiency = castForeignPtr fh
                      in cast_fptr_to_obj fh2

upcastTAxis :: (FPtr a, ITAxis a) => a -> TAxis
upcastTAxis h = let fh = get_fptr h
                    fh2 :: ForeignPtr RawTAxis = castForeignPtr fh
                in cast_fptr_to_obj fh2

upcastTLatex :: (FPtr a, ITLatex a) => a -> TLatex
upcastTLatex h = let fh = get_fptr h
                     fh2 :: ForeignPtr RawTLatex = castForeignPtr fh
                 in cast_fptr_to_obj fh2

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

upcastTDirectory :: (FPtr a, ITDirectory a) => a -> TDirectory
upcastTDirectory h = let fh = get_fptr h
                         fh2 :: ForeignPtr RawTDirectory = castForeignPtr fh
                     in cast_fptr_to_obj fh2

upcastTDirectoryFile :: (FPtr a, ITDirectoryFile a) => a -> TDirectoryFile
upcastTDirectoryFile h = let fh = get_fptr h
                             fh2 :: ForeignPtr RawTDirectoryFile = castForeignPtr fh
                         in cast_fptr_to_obj fh2

upcastTFile :: (FPtr a, ITFile a) => a -> TFile
upcastTFile h = let fh = get_fptr h
                    fh2 :: ForeignPtr RawTFile = castForeignPtr fh
                in cast_fptr_to_obj fh2

upcastTBranch :: (FPtr a, ITBranch a) => a -> TBranch
upcastTBranch h = let fh = get_fptr h
                      fh2 :: ForeignPtr RawTBranch = castForeignPtr fh
                  in cast_fptr_to_obj fh2

upcastTVirtualTreePlayer :: (FPtr a, ITVirtualTreePlayer a) => a -> TVirtualTreePlayer
upcastTVirtualTreePlayer h = let fh = get_fptr h
                                 fh2 :: ForeignPtr RawTVirtualTreePlayer = castForeignPtr fh
                             in cast_fptr_to_obj fh2

upcastTTreePlayer :: (FPtr a, ITTreePlayer a) => a -> TTreePlayer
upcastTTreePlayer h = let fh = get_fptr h
                          fh2 :: ForeignPtr RawTTreePlayer = castForeignPtr fh
                      in cast_fptr_to_obj fh2

upcastTArray :: (FPtr a, ITArray a) => a -> TArray
upcastTArray h = let fh = get_fptr h
                     fh2 :: ForeignPtr RawTArray = castForeignPtr fh
                 in cast_fptr_to_obj fh2

upcastTArrayC :: (FPtr a, ITArrayC a) => a -> TArrayC
upcastTArrayC h = let fh = get_fptr h
                      fh2 :: ForeignPtr RawTArrayC = castForeignPtr fh
                  in cast_fptr_to_obj fh2

upcastTArrayD :: (FPtr a, ITArrayD a) => a -> TArrayD
upcastTArrayD h = let fh = get_fptr h
                      fh2 :: ForeignPtr RawTArrayD = castForeignPtr fh
                  in cast_fptr_to_obj fh2

upcastTArrayF :: (FPtr a, ITArrayF a) => a -> TArrayF
upcastTArrayF h = let fh = get_fptr h
                      fh2 :: ForeignPtr RawTArrayF = castForeignPtr fh
                  in cast_fptr_to_obj fh2

upcastTArrayI :: (FPtr a, ITArrayI a) => a -> TArrayI
upcastTArrayI h = let fh = get_fptr h
                      fh2 :: ForeignPtr RawTArrayI = castForeignPtr fh
                  in cast_fptr_to_obj fh2

upcastTArrayL :: (FPtr a, ITArrayL a) => a -> TArrayL
upcastTArrayL h = let fh = get_fptr h
                      fh2 :: ForeignPtr RawTArrayL = castForeignPtr fh
                  in cast_fptr_to_obj fh2

upcastTArrayL64 :: (FPtr a, ITArrayL64 a) => a -> TArrayL64
upcastTArrayL64 h = let fh = get_fptr h
                        fh2 :: ForeignPtr RawTArrayL64 = castForeignPtr fh
                    in cast_fptr_to_obj fh2

upcastTArrayS :: (FPtr a, ITArrayS a) => a -> TArrayS
upcastTArrayS h = let fh = get_fptr h
                      fh2 :: ForeignPtr RawTArrayS = castForeignPtr fh
                  in cast_fptr_to_obj fh2

upcastTH1 :: (FPtr a, ITH1 a) => a -> TH1
upcastTH1 h = let fh = get_fptr h
                  fh2 :: ForeignPtr RawTH1 = castForeignPtr fh
              in cast_fptr_to_obj fh2

upcastTH2 :: (FPtr a, ITH2 a) => a -> TH2
upcastTH2 h = let fh = get_fptr h
                  fh2 :: ForeignPtr RawTH2 = castForeignPtr fh
              in cast_fptr_to_obj fh2

upcastTH3 :: (FPtr a, ITH3 a) => a -> TH3
upcastTH3 h = let fh = get_fptr h
                  fh2 :: ForeignPtr RawTH3 = castForeignPtr fh
              in cast_fptr_to_obj fh2

upcastTH1C :: (FPtr a, ITH1C a) => a -> TH1C
upcastTH1C h = let fh = get_fptr h
                   fh2 :: ForeignPtr RawTH1C = castForeignPtr fh
               in cast_fptr_to_obj fh2

upcastTH1D :: (FPtr a, ITH1D a) => a -> TH1D
upcastTH1D h = let fh = get_fptr h
                   fh2 :: ForeignPtr RawTH1D = castForeignPtr fh
               in cast_fptr_to_obj fh2

upcastTH1F :: (FPtr a, ITH1F a) => a -> TH1F
upcastTH1F h = let fh = get_fptr h
                   fh2 :: ForeignPtr RawTH1F = castForeignPtr fh
               in cast_fptr_to_obj fh2

upcastTH1I :: (FPtr a, ITH1I a) => a -> TH1I
upcastTH1I h = let fh = get_fptr h
                   fh2 :: ForeignPtr RawTH1I = castForeignPtr fh
               in cast_fptr_to_obj fh2

upcastTH1S :: (FPtr a, ITH1S a) => a -> TH1S
upcastTH1S h = let fh = get_fptr h
                   fh2 :: ForeignPtr RawTH1S = castForeignPtr fh
               in cast_fptr_to_obj fh2

upcastTH2C :: (FPtr a, ITH2C a) => a -> TH2C
upcastTH2C h = let fh = get_fptr h
                   fh2 :: ForeignPtr RawTH2C = castForeignPtr fh
               in cast_fptr_to_obj fh2

upcastTH2D :: (FPtr a, ITH2D a) => a -> TH2D
upcastTH2D h = let fh = get_fptr h
                   fh2 :: ForeignPtr RawTH2D = castForeignPtr fh
               in cast_fptr_to_obj fh2

upcastTH2F :: (FPtr a, ITH2F a) => a -> TH2F
upcastTH2F h = let fh = get_fptr h
                   fh2 :: ForeignPtr RawTH2F = castForeignPtr fh
               in cast_fptr_to_obj fh2

upcastTH2I :: (FPtr a, ITH2I a) => a -> TH2I
upcastTH2I h = let fh = get_fptr h
                   fh2 :: ForeignPtr RawTH2I = castForeignPtr fh
               in cast_fptr_to_obj fh2

upcastTH2Poly :: (FPtr a, ITH2Poly a) => a -> TH2Poly
upcastTH2Poly h = let fh = get_fptr h
                      fh2 :: ForeignPtr RawTH2Poly = castForeignPtr fh
                  in cast_fptr_to_obj fh2

upcastTH2S :: (FPtr a, ITH2S a) => a -> TH2S
upcastTH2S h = let fh = get_fptr h
                   fh2 :: ForeignPtr RawTH2S = castForeignPtr fh
               in cast_fptr_to_obj fh2

upcastTH3C :: (FPtr a, ITH3C a) => a -> TH3C
upcastTH3C h = let fh = get_fptr h
                   fh2 :: ForeignPtr RawTH3C = castForeignPtr fh
               in cast_fptr_to_obj fh2

upcastTH3D :: (FPtr a, ITH3D a) => a -> TH3D
upcastTH3D h = let fh = get_fptr h
                   fh2 :: ForeignPtr RawTH3D = castForeignPtr fh
               in cast_fptr_to_obj fh2

upcastTH3F :: (FPtr a, ITH3F a) => a -> TH3F
upcastTH3F h = let fh = get_fptr h
                   fh2 :: ForeignPtr RawTH3F = castForeignPtr fh
               in cast_fptr_to_obj fh2

upcastTH3I :: (FPtr a, ITH3I a) => a -> TH3I
upcastTH3I h = let fh = get_fptr h
                   fh2 :: ForeignPtr RawTH3I = castForeignPtr fh
               in cast_fptr_to_obj fh2

upcastTH3S :: (FPtr a, ITH3S a) => a -> TH3S
upcastTH3S h = let fh = get_fptr h
                   fh2 :: ForeignPtr RawTH3S = castForeignPtr fh
               in cast_fptr_to_obj fh2

upcastTQObject :: (FPtr a, ITQObject a) => a -> TQObject
upcastTQObject h = let fh = get_fptr h
                       fh2 :: ForeignPtr RawTQObject = castForeignPtr fh
                   in cast_fptr_to_obj fh2

upcastTVirtualPad :: (FPtr a, ITVirtualPad a) => a -> TVirtualPad
upcastTVirtualPad h = let fh = get_fptr h
                          fh2 :: ForeignPtr RawTVirtualPad = castForeignPtr fh
                      in cast_fptr_to_obj fh2

upcastTPad :: (FPtr a, ITPad a) => a -> TPad
upcastTPad h = let fh = get_fptr h
                   fh2 :: ForeignPtr RawTPad = castForeignPtr fh
               in cast_fptr_to_obj fh2

upcastTButton :: (FPtr a, ITButton a) => a -> TButton
upcastTButton h = let fh = get_fptr h
                      fh2 :: ForeignPtr RawTButton = castForeignPtr fh
                  in cast_fptr_to_obj fh2

upcastTGroupButton :: (FPtr a, ITGroupButton a) => a -> TGroupButton
upcastTGroupButton h = let fh = get_fptr h
                           fh2 :: ForeignPtr RawTGroupButton = castForeignPtr fh
                       in cast_fptr_to_obj fh2

upcastTCanvas :: (FPtr a, ITCanvas a) => a -> TCanvas
upcastTCanvas h = let fh = get_fptr h
                      fh2 :: ForeignPtr RawTCanvas = castForeignPtr fh
                  in cast_fptr_to_obj fh2

upcastTDialogCanvas :: (FPtr a, ITDialogCanvas a) => a -> TDialogCanvas
upcastTDialogCanvas h = let fh = get_fptr h
                            fh2 :: ForeignPtr RawTDialogCanvas = castForeignPtr fh
                        in cast_fptr_to_obj fh2

upcastTInspectCanvas :: (FPtr a, ITInspectCanvas a) => a -> TInspectCanvas
upcastTInspectCanvas h = let fh = get_fptr h
                             fh2 :: ForeignPtr RawTInspectCanvas = castForeignPtr fh
                         in cast_fptr_to_obj fh2

upcastTEvePad :: (FPtr a, ITEvePad a) => a -> TEvePad
upcastTEvePad h = let fh = get_fptr h
                      fh2 :: ForeignPtr RawTEvePad = castForeignPtr fh
                  in cast_fptr_to_obj fh2

upcastTSlider :: (FPtr a, ITSlider a) => a -> TSlider
upcastTSlider h = let fh = get_fptr h
                      fh2 :: ForeignPtr RawTSlider = castForeignPtr fh
                  in cast_fptr_to_obj fh2

upcastTApplication :: (FPtr a, ITApplication a) => a -> TApplication
upcastTApplication h = let fh = get_fptr h
                           fh2 :: ForeignPtr RawTApplication = castForeignPtr fh
                       in cast_fptr_to_obj fh2

upcastTRint :: (FPtr a, ITRint a) => a -> TRint
upcastTRint h = let fh = get_fptr h
                    fh2 :: ForeignPtr RawTRint = castForeignPtr fh
                in cast_fptr_to_obj fh2

upcastTRandom :: (FPtr a, ITRandom a) => a -> TRandom
upcastTRandom h = let fh = get_fptr h
                      fh2 :: ForeignPtr RawTRandom = castForeignPtr fh
                  in cast_fptr_to_obj fh2

upcastTCollection :: (FPtr a, ITCollection a) => a -> TCollection
upcastTCollection h = let fh = get_fptr h
                          fh2 :: ForeignPtr RawTCollection = castForeignPtr fh
                      in cast_fptr_to_obj fh2

upcastTSeqCollection :: (FPtr a, ITSeqCollection a) => a -> TSeqCollection
upcastTSeqCollection h = let fh = get_fptr h
                             fh2 :: ForeignPtr RawTSeqCollection = castForeignPtr fh
                         in cast_fptr_to_obj fh2

upcastTObjArray :: (FPtr a, ITObjArray a) => a -> TObjArray
upcastTObjArray h = let fh = get_fptr h
                        fh2 :: ForeignPtr RawTObjArray = castForeignPtr fh
                    in cast_fptr_to_obj fh2