{-# LANGUAGE EmptyDataDecls, ExistentialQuantification,
  FlexibleContexts, FlexibleInstances, ForeignFunctionInterface,
  MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies,
  TypeSynonymInstances #-}
module HROOT.Graf.TShape.Interface where
import Data.Word
import Data.Int
import Foreign.C
import Foreign.Ptr
import FFICXX.Runtime.Cast
import HROOT.Graf.TShape.RawType
import HROOT.Core.TNamed.Interface
import HROOT.Core.TAttLine.Interface
import HROOT.Core.TAttFill.Interface
import HROOT.Core.TAtt3D.Interface

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

upcastTShape :: forall a . (FPtr a, ITShape a) => a -> TShape
upcastTShape :: forall a. (FPtr a, ITShape a) => a -> TShape
upcastTShape a
h
  = let fh :: Ptr (Raw a)
fh = a -> Ptr (Raw a)
forall a. FPtr a => a -> Ptr (Raw a)
get_fptr a
h
        Ptr RawTShape
fh2 :: Ptr RawTShape = Ptr (Raw a) -> Ptr RawTShape
forall a b. Ptr a -> Ptr b
castPtr Ptr (Raw a)
fh
      in Ptr (Raw TShape) -> TShape
forall a. FPtr a => Ptr (Raw a) -> a
cast_fptr_to_obj Ptr (Raw TShape)
Ptr RawTShape
fh2

downcastTShape :: forall a . (FPtr a, ITShape a) => TShape -> a
downcastTShape :: forall a. (FPtr a, ITShape a) => TShape -> a
downcastTShape TShape
h
  = let fh :: Ptr (Raw TShape)
fh = TShape -> Ptr (Raw TShape)
forall a. FPtr a => a -> Ptr (Raw a)
get_fptr TShape
h
        fh2 :: Ptr (Raw a)
fh2 = Ptr RawTShape -> Ptr (Raw a)
forall a b. Ptr a -> Ptr b
castPtr Ptr (Raw TShape)
Ptr RawTShape
fh
      in Ptr (Raw a) -> a
forall a. FPtr a => Ptr (Raw a) -> a
cast_fptr_to_obj Ptr (Raw a)
fh2