{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, 
             FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, 
             OverlappingInstances, IncoherentInstances #-}

module HROOT.Class.TPavesText.Implementation where


import HROOT.TypeCast

import HROOT.Class.TPavesText.RawType
import HROOT.Class.TPavesText.FFI
import HROOT.Class.TPavesText.Interface
import HROOT.Class.TPavesText.Cast
import HROOT.Class.TClass.RawType
import HROOT.Class.TClass.Cast
import HROOT.Class.TClass.Interface
import HROOT.Class.TPaveText.RawType
import HROOT.Class.TPaveText.Cast
import HROOT.Class.TPaveText.Interface
import HROOT.Class.TPave.RawType
import HROOT.Class.TPave.Cast
import HROOT.Class.TPave.Interface
import HROOT.Class.TAttText.RawType
import HROOT.Class.TAttText.Cast
import HROOT.Class.TAttText.Interface
import HROOT.Class.TBox.RawType
import HROOT.Class.TBox.Cast
import HROOT.Class.TBox.Interface
import HROOT.Class.TObject.RawType
import HROOT.Class.TObject.Cast
import HROOT.Class.TObject.Interface
import HROOT.Class.TAttLine.RawType
import HROOT.Class.TAttLine.Cast
import HROOT.Class.TAttLine.Interface
import HROOT.Class.TAttFill.RawType
import HROOT.Class.TAttFill.Cast
import HROOT.Class.TAttFill.Interface
import HROOT.Class.Deletable.RawType
import HROOT.Class.Deletable.Cast
import HROOT.Class.Deletable.Interface

import Data.Word
-- import Foreign.C            
-- import Foreign.Ptr
import Foreign.ForeignPtr

import System.IO.Unsafe


instance ITPavesText TPavesText where
instance ITPaveText TPavesText where
instance ITPave TPavesText where
instance ITAttText TPavesText where
  getTextAlign = xform0 c_tpavestext_gettextalign
  getTextAngle = xform0 c_tpavestext_gettextangle
  getTextColor = xform0 c_tpavestext_gettextcolor
  getTextFont = xform0 c_tpavestext_gettextfont
  getTextSize = xform0 c_tpavestext_gettextsize
  resetAttText = xform1 c_tpavestext_resetatttext
  setTextAttributes = xform0 c_tpavestext_settextattributes
  setTextAlign = xform1 c_tpavestext_settextalign
  setTextAngle = xform1 c_tpavestext_settextangle
  setTextColor = xform1 c_tpavestext_settextcolor
  setTextFont = xform1 c_tpavestext_settextfont
  setTextSize = xform1 c_tpavestext_settextsize
  setTextSizePixels = xform1 c_tpavestext_settextsizepixels
instance ITBox TPavesText where
instance ITObject TPavesText where
  draw = xform1 c_tpavestext_draw
  findObject = xform1 c_tpavestext_findobject
  getName = xform0 c_tpavestext_getname
  isA = xform0 c_tpavestext_isa
  isFolder = xform0 c_tpavestext_isfolder
  isEqual = xform1 c_tpavestext_isequal
  isSortable = xform0 c_tpavestext_issortable
  paint = xform1 c_tpavestext_paint
  printObj = xform1 c_tpavestext_printobj
  recursiveRemove = xform1 c_tpavestext_recursiveremove
  saveAs = xform2 c_tpavestext_saveas
  useCurrentStyle = xform0 c_tpavestext_usecurrentstyle
  write = xform3 c_tpavestext_write
instance ITAttLine TPavesText where
  getLineColor = xform0 c_tpavestext_getlinecolor
  getLineStyle = xform0 c_tpavestext_getlinestyle
  getLineWidth = xform0 c_tpavestext_getlinewidth
  resetAttLine = xform1 c_tpavestext_resetattline
  setLineAttributes = xform0 c_tpavestext_setlineattributes
  setLineColor = xform1 c_tpavestext_setlinecolor
  setLineStyle = xform1 c_tpavestext_setlinestyle
  setLineWidth = xform1 c_tpavestext_setlinewidth
instance ITAttFill TPavesText where
  setFillColor = xform1 c_tpavestext_setfillcolor
  setFillStyle = xform1 c_tpavestext_setfillstyle
instance IDeletable TPavesText where
  delete = xform0 c_tpavestext_delete

instance ITPavesText (Exist TPavesText) where

instance ITPaveText (Exist TPavesText) where

instance ITPave (Exist TPavesText) where

instance ITAttText (Exist TPavesText) where
  getTextAlign (ETPavesText x) = getTextAlign x
  getTextAngle (ETPavesText x) = getTextAngle x
  getTextColor (ETPavesText x) = getTextColor x
  getTextFont (ETPavesText x) = getTextFont x
  getTextSize (ETPavesText x) = getTextSize x
  resetAttText (ETPavesText x) = resetAttText x
  setTextAttributes (ETPavesText x) = setTextAttributes x
  setTextAlign (ETPavesText x) = setTextAlign x
  setTextAngle (ETPavesText x) = setTextAngle x
  setTextColor (ETPavesText x) = setTextColor x
  setTextFont (ETPavesText x) = setTextFont x
  setTextSize (ETPavesText x) = setTextSize x
  setTextSizePixels (ETPavesText x) = setTextSizePixels x
instance ITBox (Exist TPavesText) where

instance ITObject (Exist TPavesText) where
  draw (ETPavesText x) = draw x
  findObject (ETPavesText x) = findObject x
  getName (ETPavesText x) = getName x
  isA (ETPavesText x) = isA x
  isFolder (ETPavesText x) = isFolder x
  isEqual (ETPavesText x) = isEqual x
  isSortable (ETPavesText x) = isSortable x
  paint (ETPavesText x) = paint x
  printObj (ETPavesText x) = printObj x
  recursiveRemove (ETPavesText x) = recursiveRemove x
  saveAs (ETPavesText x) = saveAs x
  useCurrentStyle (ETPavesText x) = useCurrentStyle x
  write (ETPavesText x) = write x
instance ITAttLine (Exist TPavesText) where
  getLineColor (ETPavesText x) = getLineColor x
  getLineStyle (ETPavesText x) = getLineStyle x
  getLineWidth (ETPavesText x) = getLineWidth x
  resetAttLine (ETPavesText x) = resetAttLine x
  setLineAttributes (ETPavesText x) = setLineAttributes x
  setLineColor (ETPavesText x) = setLineColor x
  setLineStyle (ETPavesText x) = setLineStyle x
  setLineWidth (ETPavesText x) = setLineWidth x
instance ITAttFill (Exist TPavesText) where
  setFillColor (ETPavesText x) = setFillColor x
  setFillStyle (ETPavesText x) = setFillStyle x
instance IDeletable (Exist TPavesText) where
  delete (ETPavesText x) = delete x


newTPavesText :: Double -> Double -> Double -> Double -> Int -> String -> IO TPavesText
newTPavesText = xform5 c_tpavestext_newtpavestext





instance FPtr (Exist TPavesText) where
  type Raw (Exist TPavesText) = RawTPavesText
  get_fptr (ETPavesText obj) = castForeignPtr (get_fptr obj)
  cast_fptr_to_obj fptr = ETPavesText (cast_fptr_to_obj (fptr :: ForeignPtr RawTPavesText) :: TPavesText)