-- GENERATED by C->Haskell Compiler, version 0.28.5 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}
{-# LANGUAGE CPP, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, ScopedTypeVariables, UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Graphics.UI.FLTK.LowLevel.Base.Table
    (
     TableCoordinate(..),
     Row(..),
     Column(..),
     CustomTableFuncs(..),
     mkSetInt,
     mkDrawCell,
     toSetRowsPrim,
     toSetColumnsPrim,
     toDrawCellPrim,
     fillCustomTableFunctionStruct,
     defaultCustomTableFuncs,
     tableCustom,
     tableCustomFunctionStruct
    , drawTableBase
    , handleTableBase
    , resizeTableBase
    , hideTableBase
    , showWidgetTableBase
    , clearTableBase
    , setRowsTableBase
    , setColsTableBase
     -- * Hierarchy
     --
     -- $hierarchy

     -- * Table functions
     --
     -- $functions
    )
where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp





import C2HS hiding (cFromEnum, cFromBool, cToBool,cToEnum)

import Graphics.UI.FLTK.LowLevel.Fl_Enumerations
import Graphics.UI.FLTK.LowLevel.Base.Widget
import Graphics.UI.FLTK.LowLevel.Fl_Types
import Graphics.UI.FLTK.LowLevel.Utils
import Graphics.UI.FLTK.LowLevel.Hierarchy
import Graphics.UI.FLTK.LowLevel.Dispatch
import qualified Data.Text as T
data Row = Row Int
data Column = Column Int
data TableCoordinate = TableCoordinate Row Column
foreign import ccall "wrapper"
        mkDrawCell :: (Ptr () ->
                       CInt ->
                       CInt -> CInt ->
                       CInt -> CInt -> CInt -> CInt ->
                       IO ())
                       ->
                       IO (FunPtr (Ptr () ->
                                   CInt ->
                                   CInt -> CInt ->
                                   CInt -> CInt -> CInt -> CInt ->
                                   IO ()))

toSetRowsPrim :: (Ref a -> Rows -> IO ()) -> IO (FunPtr (Ptr () -> CInt -> IO ()))
toSetRowsPrim f =
    mkSetInt
    (
     \ptr num' -> do
       pp <- wrapNonNull ptr "Null pointer. toSetRowsPrim"
       f (wrapInRef pp) (Rows (fromIntegral num'))
    )

toSetColumnsPrim :: (Ref a -> Columns -> IO ()) -> IO (FunPtr (Ptr () -> CInt -> IO ()))
toSetColumnsPrim f =
    mkSetInt
    (
     \ptr num' -> do
       pp <- wrapNonNull ptr "Null pointer. toSetColumnsPrim"
       f (wrapInRef pp) (Columns (fromIntegral num'))
    )

toDrawCellPrim :: (Ref a -> TableContext -> TableCoordinate -> Rectangle -> IO ()) ->
                       IO (FunPtr (Ptr () ->
                                   CInt ->
                                   CInt -> CInt ->
                                   CInt -> CInt -> CInt -> CInt ->
                                   IO ()))
toDrawCellPrim f =
    mkDrawCell
     (
      \ptr context' row' col' x_pos y_pos width height ->
          let rectangle = toRectangle (fromIntegral x_pos,
                                       fromIntegral y_pos,
                                       fromIntegral width,
                                       fromIntegral height)
          in
          do
           pp <- wrapNonNull ptr "Null pointer. toDrawCellPrim"
           f (wrapInRef pp) (toEnum $ fromIntegral context') (TableCoordinate (Row (fromIntegral row')) (Column (fromIntegral col'))) rectangle
     )

data CustomTableFuncs a =
    CustomTableFuncs
    {
    clearCustom      :: Maybe (Ref a -> IO ())
    ,setRowsCustom    :: Maybe (Ref a -> Rows -> IO ())
    ,setColsCustom    :: Maybe (Ref a -> Columns -> IO ())
    }

fillCustomTableFunctionStruct :: forall a. (Parent a TableBase) =>
                                  Ptr () ->
                                  Maybe (Ref a -> TableContext -> TableCoordinate -> Rectangle -> IO ()) ->
                                  CustomTableFuncs a ->
                                  IO ()
fillCustomTableFunctionStruct structPtr _drawCell' (CustomTableFuncs _clear' _setRows' _setCols')  = do
   toDrawCellPrim `orNullFunPtr` _drawCell' >>= (\ptr val -> do {C2HSImp.pokeByteOff ptr 64 (val :: (C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))))))))))}) structPtr
   toCallbackPrim `orNullFunPtr` _clear' >>= (\ptr val -> do {C2HSImp.pokeByteOff ptr 72 (val :: (C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (IO ()))))}) structPtr
   toSetRowsPrim `orNullFunPtr` _setRows' >>= (\ptr val -> do {C2HSImp.pokeByteOff ptr 80 (val :: (C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))))}) structPtr
   toSetColumnsPrim `orNullFunPtr` _setCols' >>= (\ptr val -> do {C2HSImp.pokeByteOff ptr 88 (val :: (C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))))}) structPtr

defaultCustomTableFuncs :: forall a. (Parent a TableBase) => CustomTableFuncs a
defaultCustomTableFuncs = CustomTableFuncs Nothing Nothing Nothing

virtualFuncs' :: IO ((Ptr ()))
virtualFuncs' =
  virtualFuncs''_ >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 123 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

tableCustomFunctionStruct :: (Parent a WidgetBase,
                              Parent b TableBase) =>
                             Maybe (Ref a -> IO ()) ->
                             Maybe (Ref b -> TableContext -> TableCoordinate -> Rectangle -> IO ()) ->
                             CustomWidgetFuncs a ->
                             CustomTableFuncs b ->
                             IO (Ptr ())
tableCustomFunctionStruct draw'' drawCell' customWidgetFuncs' customTableFuncs' =
  do
   ptr <- virtualFuncs'
   fillCustomWidgetFunctionStruct ptr draw'' customWidgetFuncs'
   fillCustomTableFunctionStruct ptr drawCell' customTableFuncs'
   return ptr

tableNew' :: (Int) -> (Int) -> (Int) -> (Int) -> (Ptr ()) -> IO ((Ptr ()))
tableNew' a1 a2 a3 a4 a5 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = id a5} in
  tableNew''_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 138 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

tableNewWithLabel' :: (Int) -> (Int) -> (Int) -> (Int) -> (CString) -> (Ptr ()) -> IO ((Ptr ()))
tableNewWithLabel' a1 a2 a3 a4 a5 a6 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  (flip ($)) a5 $ \a5' ->
  let {a6' = id a6} in
  tableNewWithLabel''_ a1' a2' a3' a4' a5' a6' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 139 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

tableCustom :: Rectangle                                                            -- ^ Bounds of this table
            -> Maybe T.Text                                                         -- ^ Optional label
            -> Maybe (Ref Table -> IO ())                                           -- ^ Optional custom table drawing function
            -> (Ref Table -> TableContext -> TableCoordinate -> Rectangle -> IO ()) -- ^ Custom table cell drawing function
            -> CustomWidgetFuncs Table                                              -- ^ Widget overrides
            -> CustomTableFuncs Table                                               -- ^ Table overrides
            -> IO (Ref Table)
tableCustom rectangle label' draw'' drawCell' customWidgetFuncs' customTableFuncs' =
    do
      let (x_pos, y_pos, width, height) = fromRectangle rectangle
      ptr <- tableCustomFunctionStruct draw'' (Just drawCell') customWidgetFuncs' customTableFuncs'
      case label' of
        (Just l') -> copyTextToCString l' >>= \l'' -> tableNewWithLabel' x_pos y_pos width height l'' ptr >>= toRef
        Nothing -> tableNew' x_pos y_pos width height ptr >>= toRef

tableDestroy' :: (Ptr ()) -> IO ((()))
tableDestroy' a1 =
  let {a1' = id a1} in
  tableDestroy''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 155 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( IO ())) => Op (Destroy ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> tableDestroy' tablePtr
setTableBox' :: (Ptr ()) -> (Boxtype) -> IO ()
setTableBox' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromEnum a2} in
  setTableBox''_ a1' a2' >>
  return ()

{-# LINE 158 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Boxtype ->  IO ())) => Op (SetTableBox ()) TableBase orig impl where
  runOp _ _ table val = withRef table $ \tablePtr -> setTableBox' tablePtr val
tableBox' :: (Ptr ()) -> IO ((Boxtype))
tableBox' a1 =
  let {a1' = id a1} in
  tableBox''_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 161 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO (Boxtype))) => Op (GetTableBox ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> tableBox' tablePtr
rows' :: (Ptr ()) -> IO ((Int))
rows' a1 =
  let {a1' = id a1} in
  rows''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 164 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO (Rows))) => Op (GetRows ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> rows' tablePtr >>= return . Rows
cols' :: (Ptr ()) -> IO ((Int))
cols' a1 =
  let {a1' = id a1} in
  cols''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 167 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO (Columns))) => Op (GetCols ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> cols' tablePtr >>= return . Columns
visibleCells' :: (Ptr ()) -> IO ((Int), (Int), (Int), (Int))
visibleCells' a1 =
  let {a1' = id a1} in
  alloca $ \a2' ->
  alloca $ \a3' ->
  alloca $ \a4' ->
  alloca $ \a5' ->
  visibleCells''_ a1' a2' a3' a4' a5' >>
  peekIntConv  a2'>>= \a2'' ->
  peekIntConv  a3'>>= \a3'' ->
  peekIntConv  a4'>>= \a4'' ->
  peekIntConv  a5'>>= \a5'' ->
  return (a2'', a3'', a4'', a5'')

{-# LINE 170 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (IO (TableCoordinate,TableCoordinate))) => Op (GetVisibleCells ()) TableBase orig impl where
  runOp _ _ table =
    withRef table $ \tablePtr ->
    visibleCells' tablePtr >>= \(r1', r2', c1', c2') ->
    return ((TableCoordinate (Row r1') (Column c1')), (TableCoordinate (Row r2') (Column c2')))
isInteractiveResize' :: (Ptr ()) -> IO ((Bool))
isInteractiveResize' a1 =
  let {a1' = id a1} in
  isInteractiveResize''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 176 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO (Bool))) => Op (IsInteractiveResize ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> isInteractiveResize' tablePtr
rowResize' :: (Ptr ()) -> IO ((Bool))
rowResize' a1 =
  let {a1' = id a1} in
  rowResize''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 179 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO (Bool))) => Op (GetRowResize ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> rowResize' tablePtr
setRowResize' :: (Ptr ()) -> (Int) -> IO ()
setRowResize' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setRowResize''_ a1' a2' >>
  return ()

{-# LINE 182 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Bool ->  IO ())) => Op (SetRowResize ()) TableBase orig impl where
  runOp _ _ table flag = withRef table $ \tablePtr -> setRowResize' tablePtr (cFromBool flag)
colResize' :: (Ptr ()) -> IO ((Bool))
colResize' a1 =
  let {a1' = id a1} in
  colResize''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 185 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO (Bool))) => Op (GetColResize ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> colResize' tablePtr
setColResize' :: (Ptr ()) -> (Int) -> IO ()
setColResize' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setColResize''_ a1' a2' >>
  return ()

{-# LINE 188 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Bool ->  IO ())) => Op (SetColResize ()) TableBase orig impl where
  runOp _ _ table flag = withRef table $ \tablePtr -> setColResize' tablePtr (cFromBool flag)
colResizeMin' :: (Ptr ()) -> IO ((Int))
colResizeMin' a1 =
  let {a1' = id a1} in
  colResizeMin''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 191 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO (Int))) => Op (GetColResizeMin ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> colResizeMin' tablePtr
setColResizeMin' :: (Ptr ()) -> (Int) -> IO ()
setColResizeMin' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setColResizeMin''_ a1' a2' >>
  return ()

{-# LINE 194 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Int ->  IO ())) => Op (SetColResizeMin ()) TableBase orig impl where
  runOp _ _ table val = withRef table $ \tablePtr -> setColResizeMin' tablePtr val
rowResizeMin' :: (Ptr ()) -> IO ((Int))
rowResizeMin' a1 =
  let {a1' = id a1} in
  rowResizeMin''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 197 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO (Int))) => Op (GetRowResizeMin ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> rowResizeMin' tablePtr
setRowResizeMin' :: (Ptr ()) -> (Int) -> IO ()
setRowResizeMin' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setRowResizeMin''_ a1' a2' >>
  return ()

{-# LINE 200 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Int ->  IO ())) => Op (SetRowResizeMin ()) TableBase orig impl where
  runOp _ _ table val = withRef table $ \tablePtr -> setRowResizeMin' tablePtr val
rowHeader' :: (Ptr ()) -> IO ((Int))
rowHeader' a1 =
  let {a1' = id a1} in
  rowHeader''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 203 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO Bool)) => Op (GetRowHeader ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> rowHeader' tablePtr >>= return . cToBool
setRowHeader' :: (Ptr ()) -> (Int) -> IO ()
setRowHeader' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setRowHeader''_ a1' a2' >>
  return ()

{-# LINE 206 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Bool ->  IO ())) => Op (SetRowHeader ()) TableBase orig impl where
  runOp _ _ table flag = withRef table $ \tablePtr -> setRowHeader' tablePtr (cFromBool flag)
colHeader' :: (Ptr ()) -> IO ((Bool))
colHeader' a1 =
  let {a1' = id a1} in
  colHeader''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 209 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO (Bool))) => Op (GetColHeader ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> colHeader' tablePtr
setColHeader' :: (Ptr ()) -> (Int) -> IO ()
setColHeader' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setColHeader''_ a1' a2' >>
  return ()

{-# LINE 212 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Bool ->  IO ())) => Op (SetColHeader ()) TableBase orig impl where
  runOp _ _ table flag = withRef table $ \tablePtr -> setColHeader' tablePtr (cFromBool flag)
setColHeaderHeight' :: (Ptr ()) -> (Int) -> IO ()
setColHeaderHeight' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setColHeaderHeight''_ a1' a2' >>
  return ()

{-# LINE 215 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Int ->  IO ())) => Op (SetColHeaderHeight ()) TableBase orig impl where
  runOp _ _ table height = withRef table $ \tablePtr -> setColHeaderHeight' tablePtr height
colHeaderHeight' :: (Ptr ()) -> IO ((Int))
colHeaderHeight' a1 =
  let {a1' = id a1} in
  colHeaderHeight''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 218 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO (Int))) => Op (GetColHeaderHeight ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> colHeaderHeight' tablePtr
setRowHeaderWidth' :: (Ptr ()) -> (Int) -> IO ()
setRowHeaderWidth' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setRowHeaderWidth''_ a1' a2' >>
  return ()

{-# LINE 221 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Int ->  IO ())) => Op (SetRowHeaderWidth ()) TableBase orig impl where
  runOp _ _ table width = withRef table $ \tablePtr -> setRowHeaderWidth' tablePtr width
rowHeaderWidth' :: (Ptr ()) -> IO ((Int))
rowHeaderWidth' a1 =
  let {a1' = id a1} in
  rowHeaderWidth''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 224 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO (Int))) => Op (GetRowHeaderWidth ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> rowHeaderWidth' tablePtr
setRowHeaderColor' :: (Ptr ()) -> (Color) -> IO ()
setRowHeaderColor' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromColor a2} in
  setRowHeaderColor''_ a1' a2' >>
  return ()

{-# LINE 227 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Color ->  IO ())) => Op (SetRowHeaderColor ()) TableBase orig impl where
  runOp _ _ table val = withRef table $ \tablePtr -> setRowHeaderColor' tablePtr val
rowHeaderColor' :: (Ptr ()) -> IO ((Color))
rowHeaderColor' a1 =
  let {a1' = id a1} in
  rowHeaderColor''_ a1' >>= \res ->
  let {res' = cToColor res} in
  return (res')

{-# LINE 230 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO (Color))) => Op (GetRowHeaderColor ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> rowHeaderColor' tablePtr
setColHeaderColor' :: (Ptr ()) -> (Color) -> IO ()
setColHeaderColor' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromColor a2} in
  setColHeaderColor''_ a1' a2' >>
  return ()

{-# LINE 233 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Color ->  IO ())) => Op (SetColHeaderColor ()) TableBase orig impl where
  runOp _ _ table val = withRef table $ \tablePtr -> setColHeaderColor' tablePtr val
colHeaderColor' :: (Ptr ()) -> IO ((Color))
colHeaderColor' a1 =
  let {a1' = id a1} in
  colHeaderColor''_ a1' >>= \res ->
  let {res' = cToColor res} in
  return (res')

{-# LINE 236 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO (Color))) => Op (GetColHeaderColor ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> colHeaderColor' tablePtr
setRowHeight' :: (Ptr ()) -> (Int) -> (Int) -> IO ()
setRowHeight' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  setRowHeight''_ a1' a2' a3' >>
  return ()

{-# LINE 239 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Row -> Int ->  IO ())) => Op (SetRowHeight ()) TableBase orig impl where
  runOp _ _ table (Row row) height = withRef table $ \tablePtr -> setRowHeight' tablePtr row height
rowHeight' :: (Ptr ()) -> (Int) -> IO ((Int))
rowHeight' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  rowHeight''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 242 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Row ->  IO (Int))) => Op (GetRowHeight ()) TableBase orig impl where
  runOp _ _ table (Row row) = withRef table $ \tablePtr -> rowHeight' tablePtr row
setColWidth' :: (Ptr ()) -> (Int) -> (Int) -> IO ()
setColWidth' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  setColWidth''_ a1' a2' a3' >>
  return ()

{-# LINE 245 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Column -> Int ->  IO ())) => Op (SetColWidth ()) TableBase orig impl where
  runOp _ _ table (Column col) width = withRef table $ \tablePtr -> setColWidth' tablePtr col width
colWidth' :: (Ptr ()) -> (Int) -> IO ((Int))
colWidth' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  colWidth''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 248 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Column ->  IO (Int))) => Op (GetColWidth ()) TableBase orig impl where
  runOp _ _ table (Column col) = withRef table $ \tablePtr -> colWidth' tablePtr col
setRowHeightAll' :: (Ptr ()) -> (Int) -> IO ()
setRowHeightAll' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setRowHeightAll''_ a1' a2' >>
  return ()

{-# LINE 251 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Int ->  IO ())) => Op (SetRowHeightAll ()) TableBase orig impl where
  runOp _ _ table height = withRef table $ \tablePtr -> setRowHeightAll' tablePtr height
setColWidthAll' :: (Ptr ()) -> (Int) -> IO ()
setColWidthAll' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setColWidthAll''_ a1' a2' >>
  return ()

{-# LINE 254 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Int ->  IO ())) => Op (SetColWidthAll ()) TableBase orig impl where
  runOp _ _ table width = withRef table $ \tablePtr -> setColWidthAll' tablePtr width
setRowPosition' :: (Ptr ()) -> (Int) -> IO ()
setRowPosition' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setRowPosition''_ a1' a2' >>
  return ()

{-# LINE 257 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Row ->  IO ())) => Op (SetRowPosition ()) TableBase orig impl where
  runOp _ _ table (Row row) = withRef table $ \tablePtr -> setRowPosition' tablePtr row
setColPosition' :: (Ptr ()) -> (Int) -> IO ()
setColPosition' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setColPosition''_ a1' a2' >>
  return ()

{-# LINE 260 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Column ->  IO ())) => Op (SetColPosition ()) TableBase orig impl where
  runOp _ _ table (Column col) = withRef table $ \tablePtr -> setColPosition' tablePtr col
rowPosition' :: (Ptr ()) -> IO ((Int))
rowPosition' a1 =
  let {a1' = id a1} in
  rowPosition''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 263 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO (Row))) => Op (GetRowPosition ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> rowPosition' tablePtr >>= return . Row
colPosition' :: (Ptr ()) -> IO ((Int))
colPosition' a1 =
  let {a1' = id a1} in
  colPosition''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 266 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO (Column))) => Op (GetColPosition ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> colPosition' tablePtr >>= return . Column
setTopRow' :: (Ptr ()) -> (Int) -> IO ()
setTopRow' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setTopRow''_ a1' a2' >>
  return ()

{-# LINE 269 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Row ->  IO ())) => Op (SetTopRow ()) TableBase orig impl where
  runOp _ _ table (Row row) = withRef table $ \tablePtr -> setTopRow' tablePtr row
topRow' :: (Ptr ()) -> IO ((Int))
topRow' a1 =
  let {a1' = id a1} in
  topRow''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 272 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO (Row))) => Op (GetTopRow ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> topRow' tablePtr >>= return . Row
isSelected' :: (Ptr ()) -> (Int) -> (Int) -> IO ((Bool))
isSelected' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  isSelected''_ a1' a2' a3' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 275 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (TableCoordinate ->  IO Bool)) => Op (IsSelected ()) TableBase orig impl where
  runOp _ _ table (TableCoordinate (Row r) (Column c)) = withRef table $ \tablePtr -> isSelected' tablePtr r c
getSelection' :: (Ptr ()) -> IO ((Int), (Int), (Int), (Int))
getSelection' a1 =
  let {a1' = id a1} in
  alloca $ \a2' ->
  alloca $ \a3' ->
  alloca $ \a4' ->
  alloca $ \a5' ->
  getSelection''_ a1' a2' a3' a4' a5' >>
  peekIntConv  a2'>>= \a2'' ->
  peekIntConv  a3'>>= \a3'' ->
  peekIntConv  a4'>>= \a4'' ->
  peekIntConv  a5'>>= \a5'' ->
  return (a2'', a3'', a4'', a5'')

{-# LINE 278 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ IO (TableCoordinate, TableCoordinate)) => Op (GetSelection ()) TableBase orig impl where
  runOp _ _ table =
    withRef table $ \tablePtr ->
        getSelection' tablePtr >>= \(top', left',bottom',right') ->
            return ((TableCoordinate (Row top') (Column left')), (TableCoordinate (Row bottom') (Column right')))
setSelection' :: (Ptr ()) -> (Int) -> (Int) -> (Int) -> (Int) -> IO ()
setSelection' a1 a2 a3 a4 a5 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = fromIntegral a5} in
  setSelection''_ a1' a2' a3' a4' a5' >>
  return ()

{-# LINE 284 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( TableCoordinate -> TableCoordinate ->IO ())) => Op (SetSelection ()) TableBase orig impl where
  runOp _ _ table (TableCoordinate (Row row_top) (Column col_left))
                  (TableCoordinate (Row row_bot) (Column col_right)) =
    withRef table $ \tablePtr -> setSelection' tablePtr row_top col_left row_bot col_right
moveCursor' :: (Ptr ()) -> (Int) -> (Int) -> IO ((Int))
moveCursor' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  moveCursor''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 289 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( TableCoordinate ->  IO (Either NoChange ()))) => Op (MoveCursor ()) TableBase orig impl where
  runOp _ _ table (TableCoordinate (Row r) (Column c)) = withRef table $ \tablePtr -> moveCursor' tablePtr r c >>= return . successOrNoChange
initSizes' :: (Ptr ()) -> IO ()
initSizes' a1 =
  let {a1' = id a1} in
  initSizes''_ a1' >>
  return ()

{-# LINE 292 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO ())) => Op (InitSizes ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> initSizes' tablePtr
add' :: (Ptr ()) -> (Ptr ()) -> IO ()
add' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  add''_ a1' a2' >>
  return ()

{-# LINE 295 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (Parent a WidgetBase, impl ~ (Ref a  ->  IO ())) => Op (Add ()) TableBase orig impl where
  runOp _ _ table wgt = withRef table $ \tablePtr -> withRef wgt $ \wgtPtr -> add' tablePtr wgtPtr
insert' :: (Ptr ()) -> (Ptr ()) -> (Int) -> IO ()
insert' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = fromIntegral a3} in
  insert''_ a1' a2' a3' >>
  return ()

{-# LINE 298 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (Parent a WidgetBase, impl ~ (Ref a -> AtIndex ->  IO ())) => Op (Insert ()) TableBase orig impl where
  runOp _ _ table wgt (AtIndex n) = withRef table $ \tablePtr -> withRef wgt $ \wgtPtr -> insert' tablePtr wgtPtr n
insertWithWidget' :: (Ptr ()) -> (Ptr ()) -> (Ptr ()) -> IO ()
insertWithWidget' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = id a3} in
  insertWithWidget''_ a1' a2' a3' >>
  return ()

{-# LINE 301 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (Parent a WidgetBase, Parent b Widget, impl ~ (Ref a -> Ref b ->  IO ())) => Op (InsertBefore ()) TableBase orig impl where
  runOp _ _ self w before = withRef self $ \selfPtr -> withRef w $ \wPtr -> withRef before $ \beforePtr -> insertWithWidget' selfPtr wPtr beforePtr
begin' :: (Ptr ()) -> IO ()
begin' a1 =
  let {a1' = id a1} in
  begin''_ a1' >>
  return ()

{-# LINE 304 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO ())) => Op (Begin ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> begin' tablePtr
end' :: (Ptr ()) -> IO ()
end' a1 =
  let {a1' = id a1} in
  end''_ a1' >>
  return ()

{-# LINE 307 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO ())) => Op (End ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> end' tablePtr
array' :: (Ptr ()) -> IO ((Ptr (Ptr ())))
array' a1 =
  let {a1' = id a1} in
  array''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 310 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO [Ref Widget])) => Op (GetArray ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> do
                     childArrayPtr <- array' tablePtr
                     numChildren <- children table
                     arrayToRefs childArrayPtr numChildren
child' :: (Ptr ()) -> (Int) -> IO ((Ptr ()))
child' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  child''_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 316 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( AtIndex ->  IO (Maybe (Ref Widget)))) => Op (GetChild ()) TableBase orig impl where
  runOp _ _ table (AtIndex n) = withRef table $ \tablePtr -> child' tablePtr n >>= toMaybeRef
children' :: (Ptr ()) -> IO ((Int))
children' a1 =
  let {a1' = id a1} in
  children''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 319 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO (Int))) => Op (Children ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> children' tablePtr
find' :: (Ptr ()) -> (Ptr ()) -> IO ((Int))
find' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  find''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 322 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (Parent a WidgetBase, impl ~ (Ref a ->  IO (Int))) => Op (Find ()) TableBase orig impl where
  runOp _ _ table wgt = withRef table $ \tablePtr -> withRef wgt $ \wgtPtr -> find' tablePtr wgtPtr
callbackRow' :: (Ptr ()) -> IO ((Int))
callbackRow' a1 =
  let {a1' = id a1} in
  callbackRow''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 325 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO (Row))) => Op (CallbackRow ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> callbackRow' tablePtr >>= return . Row
callbackCol' :: (Ptr ()) -> IO ((Int))
callbackCol' a1 =
  let {a1' = id a1} in
  callbackCol''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 328 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO (Column))) => Op (CallbackCol ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> callbackCol' tablePtr >>= return . Column
callbackContext' :: (Ptr ()) -> IO ((TableContext))
callbackContext' a1 =
  let {a1' = id a1} in
  callbackContext''_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 331 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO (TableContext))) => Op (CallbackContext ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> callbackContext' tablePtr
doCallback' :: (Ptr ()) -> (TableContext) -> (Int) -> (Int) -> IO ()
doCallback' a1 a2 a3 a4 =
  let {a1' = id a1} in
  let {a2' = cFromEnum a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  doCallback''_ a1' a2' a3' a4' >>
  return ()

{-# LINE 334 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( TableContext -> TableCoordinate ->  IO ())) => Op (DoCallback ()) TableBase orig impl where
  runOp _ _ table tablecontext (TableCoordinate (Row row) (Column col)) = withRef table $ \tablePtr -> doCallback' tablePtr tablecontext row col
findCell' :: (Ptr ()) -> (TableContext) -> (Int) -> (Int) -> IO ((CInt), (Int), (Int), (Int), (Int))
findCell' a1 a2 a3 a4 =
  let {a1' = id a1} in
  let {a2' = cFromEnum a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  alloca $ \a5' ->
  alloca $ \a6' ->
  alloca $ \a7' ->
  alloca $ \a8' ->
  findCell''_ a1' a2' a3' a4' a5' a6' a7' a8' >>= \res ->
  let {res' = id res} in
  peekIntConv  a5'>>= \a5'' ->
  peekIntConv  a6'>>= \a6'' ->
  peekIntConv  a7'>>= \a7'' ->
  peekIntConv  a8'>>= \a8'' ->
  return (res', a5'', a6'', a7'', a8'')

{-# LINE 337 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( TableContext -> TableCoordinate -> IO (Maybe Rectangle))) => Op (FindCell ()) TableBase orig impl where
  runOp _ _ table context (TableCoordinate (Row r) (Column c))  =
    withRef table $ \tablePtr ->
        findCell' tablePtr context r c >>= \(result, x_pos', y_pos', width', height') -> do
          if (result /= -1)
            then return $ Just $ toRectangle (x_pos', y_pos', width', height')
            else return $ Nothing
tabCellNav' :: (Ptr ()) -> IO ((Bool))
tabCellNav' a1 =
  let {a1' = id a1} in
  tabCellNav''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 345 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO (Bool))) => Op (GetTabCellNav ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> tabCellNav' tablePtr
setTabCellNav' :: (Ptr ()) -> (Bool) -> IO ()
setTabCellNav' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromBool a2} in
  setTabCellNav''_ a1' a2' >>
  return ()

{-# LINE 348 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Bool ->  IO ())) => Op (SetTabCellNav ()) TableBase orig impl where
  runOp _ _ table val = withRef table $ \tablePtr -> setTabCellNav' tablePtr val

drawSuper' :: (Ptr ()) -> IO ((()))
drawSuper' a1 =
  let {a1' = id a1} in
  drawSuper''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 352 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

drawTableBase ::  Ref TableBase -> IO ()
drawTableBase table = withRef table $ \tablePtr -> drawSuper' tablePtr
handleSuper' :: (Ptr ()) -> (Int) -> IO ((Int))
handleSuper' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  handleSuper''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 355 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

handleTableBase :: Ref TableBase -> Event ->  IO (Either UnknownEvent ())
handleTableBase table event = withRef table $ \tablePtr -> handleSuper' tablePtr (fromIntegral (fromEnum event)) >>= return . successOrUnknownEvent
resizeSuper' :: (Ptr ()) -> (Int) -> (Int) -> (Int) -> (Int) -> IO ((()))
resizeSuper' a1 a2 a3 a4 a5 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = fromIntegral a5} in
  resizeSuper''_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 358 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

resizeTableBase :: Ref TableBase -> Rectangle -> IO ()
resizeTableBase table rectangle =
    let (x_pos, y_pos, width, height) = fromRectangle rectangle
    in withRef table $ \tablePtr -> resizeSuper' tablePtr x_pos y_pos width height
hideSuper' :: (Ptr ()) -> IO ((()))
hideSuper' a1 =
  let {a1' = id a1} in
  hideSuper''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 363 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

hideTableBase ::  Ref TableBase -> IO ()
hideTableBase table = withRef table $ \tablePtr -> hideSuper' tablePtr
showSuper' :: (Ptr ()) -> IO ((()))
showSuper' a1 =
  let {a1' = id a1} in
  showSuper''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 366 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

showWidgetTableBase ::  Ref TableBase -> IO ()
showWidgetTableBase table = withRef table $ \tablePtr -> showSuper' tablePtr
clearSuper' :: (Ptr ()) -> IO ()
clearSuper' a1 =
  let {a1' = id a1} in
  clearSuper''_ a1' >>
  return ()

{-# LINE 369 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

clearTableBase :: Ref Table -> IO ()
clearTableBase table = withRef table $ \tablePtr -> clearSuper' tablePtr
setRowsSuper' :: (Ptr ()) -> (Int) -> IO ()
setRowsSuper' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setRowsSuper''_ a1' a2' >>
  return ()

{-# LINE 372 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

setRowsTableBase :: Ref Table -> Rows -> IO ()
setRowsTableBase table (Rows val) = withRef table $ \tablePtr -> setRowsSuper' tablePtr val
setColsSuper' :: (Ptr ()) -> (Int) -> IO ()
setColsSuper' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setColsSuper''_ a1' a2' >>
  return ()

{-# LINE 375 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

setColsTableBase :: Ref Table -> Columns ->  IO ()
setColsTableBase table (Columns val) = withRef table $ \tablePtr -> setColsSuper' tablePtr val

draw' :: (Ptr ()) -> IO ()
draw' a1 =
  let {a1' = id a1} in
  draw''_ a1' >>
  return ()

{-# LINE 379 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO ())) => Op (Draw ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> draw' tablePtr
handle' :: (Ptr ()) -> (Event) -> IO ((Int))
handle' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromEnum a2} in
  handle''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 382 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Event ->  IO( Either UnknownEvent ()))) => Op (Handle ()) TableBase orig impl where
  runOp _ _ table event = withRef table $ \tablePtr -> handle' tablePtr event >>= return  . successOrUnknownEvent
resize' :: (Ptr ()) -> (Int) -> (Int) -> (Int) -> (Int) -> IO ()
resize' a1 a2 a3 a4 a5 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = fromIntegral a5} in
  resize''_ a1' a2' a3' a4' a5' >>
  return ()

{-# LINE 385 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Rectangle ->  IO ())) => Op (Resize ()) TableBase orig impl where
  runOp _ _ table rectangle = let (x_pos', y_pos', width', height') = fromRectangle rectangle in withRef table $ \tablePtr -> resize' tablePtr x_pos' y_pos' width' height'
clear' :: (Ptr ()) -> IO ()
clear' a1 =
  let {a1' = id a1} in
  clear''_ a1' >>
  return ()

{-# LINE 388 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ (  IO ())) => Op (Clear ()) TableBase orig impl where
  runOp _ _ table = withRef table $ \tablePtr -> clear' tablePtr
show' :: (Ptr ()) -> IO ((()))
show' a1 =
  let {a1' = id a1} in
  show''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 391 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( IO ())) => Op (ShowWidget ()) TableBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> show' widgetPtr
hide' :: (Ptr ()) -> IO ((()))
hide' a1 =
  let {a1' = id a1} in
  hide''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 394 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( IO ())) => Op (Hide ()) TableBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> hide' widgetPtr
setRows' :: (Ptr ()) -> (Int) -> IO ()
setRows' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setRows''_ a1' a2' >>
  return ()

{-# LINE 397 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Rows ->  IO ())) => Op (SetRows ()) TableBase orig impl where
  runOp _ _ table (Rows val) = withRef table $ \tablePtr -> setRows' tablePtr val
setCols' :: (Ptr ()) -> (Int) -> IO ()
setCols' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setCols''_ a1' a2' >>
  return ()

{-# LINE 400 "src/Graphics/UI/FLTK/LowLevel/Base/Table.chs" #-}

instance (impl ~ ( Columns ->  IO ())) => Op (SetCols ()) TableBase orig impl where
  runOp _ _ table (Columns val) = withRef table $ \tablePtr -> setCols' tablePtr val


-- $hierarchy
-- @
-- "Graphics.UI.FLTK.LowLevel.Base.Widget"
--  |
--  v
-- "Graphics.UI.FLTK.LowLevel.Base.Group"
--  |
--  v
-- "Graphics.UI.FLTK.LowLevel.Base.Table"
-- @

-- $functions
-- @
-- add:: ('Parent' a 'WidgetBase') => 'Ref' 'TableBase' -> 'Ref' a -> 'IO' ()
--
-- begin :: 'Ref' 'TableBase' -> 'IO' ()
--
-- callbackCol :: 'Ref' 'TableBase' -> 'IO' ('Column')
--
-- callbackContext :: 'Ref' 'TableBase' -> 'IO' ('TableContext')
--
-- callbackRow :: 'Ref' 'TableBase' -> 'IO' ('Row')
--
-- children :: 'Ref' 'TableBase' -> 'IO' ('Int')
--
-- clear :: 'Ref' 'TableBase' -> 'IO' ()
--
-- destroy :: 'Ref' 'TableBase' -> 'IO' ()
--
-- doCallback :: 'Ref' 'TableBase' -> 'TableContext' -> 'TableCoordinate' -> 'IO' ()
--
-- draw :: 'Ref' 'TableBase' -> 'IO' ()
--
-- end :: 'Ref' 'TableBase' -> 'IO' ()
--
-- find:: ('Parent' a 'WidgetBase') => 'Ref' 'TableBase' -> 'Ref' a -> 'IO' ('Int')
--
-- findCell :: 'Ref' 'TableBase' -> 'TableContext' -> 'TableCoordinate' -> 'IO' ('Maybe' 'Rectangle')
--
-- getArray :: 'Ref' 'TableBase' -> 'IO' ['Ref' 'Widget']
--
-- getChild :: 'Ref' 'TableBase' -> 'AtIndex' -> 'IO' ('Maybe' ('Ref' 'Widget'))
--
-- getColHeader :: 'Ref' 'TableBase' -> 'IO' ('Bool')
--
-- getColHeaderColor :: 'Ref' 'TableBase' -> 'IO' ('Color')
--
-- getColHeaderHeight :: 'Ref' 'TableBase' -> 'IO' ('Int')
--
-- getColPosition :: 'Ref' 'TableBase' -> 'IO' ('Column')
--
-- getColResize :: 'Ref' 'TableBase' -> 'IO' ('Bool')
--
-- getColResizeMin :: 'Ref' 'TableBase' -> 'IO' ('Int')
--
-- getColWidth :: 'Ref' 'TableBase' -> 'Column' -> 'IO' ('Int')
--
-- getCols :: 'Ref' 'TableBase' -> 'IO' ('Columns')
--
-- getRowHeader :: 'Ref' 'TableBase' -> 'IO' 'Bool'
--
-- getRowHeaderColor :: 'Ref' 'TableBase' -> 'IO' ('Color')
--
-- getRowHeaderWidth :: 'Ref' 'TableBase' -> 'IO' ('Int')
--
-- getRowHeight :: 'Ref' 'TableBase' -> 'Row' -> 'IO' ('Int')
--
-- getRowPosition :: 'Ref' 'TableBase' -> 'IO' ('Row')
--
-- getRowResize :: 'Ref' 'TableBase' -> 'IO' ('Bool')
--
-- getRowResizeMin :: 'Ref' 'TableBase' -> 'IO' ('Int')
--
-- getRows :: 'Ref' 'TableBase' -> 'IO' ('Rows')
--
-- getSelection :: 'Ref' 'TableBase' -> 'IO' ('TableCoordinate', 'TableCoordinate')
--
-- getTabCellNav :: 'Ref' 'TableBase' -> 'IO' ('Bool')
--
-- getTableBox :: 'Ref' 'TableBase' -> 'IO' ('Boxtype')
--
-- getTopRow :: 'Ref' 'TableBase' -> 'IO' ('Row')
--
-- getVisibleCells :: 'Ref' 'TableBase' -> 'IO' ('TableCoordinate,TableCoordinate')
--
-- handle :: 'Ref' 'TableBase' -> 'Event' -> 'IO'( 'Either' 'UnknownEvent' ())
--
-- hide :: 'Ref' 'TableBase' -> 'IO' ()
--
-- initSizes :: 'Ref' 'TableBase' -> 'IO' ()
--
-- insert:: ('Parent' a 'WidgetBase') => 'Ref' 'TableBase' -> 'Ref' a -> 'AtIndex' -> 'IO' ()
--
-- insertBefore:: ('Parent' a 'WidgetBase', 'Parent' b 'Widget') => 'Ref' 'TableBase' -> 'Ref' a -> 'Ref' b -> 'IO' ()
--
-- isInteractiveResize :: 'Ref' 'TableBase' -> 'IO' ('Bool')
--
-- isSelected :: 'Ref' 'TableBase' -> 'TableCoordinate' -> 'IO' 'Bool'
--
-- moveCursor :: 'Ref' 'TableBase' -> 'TableCoordinate' -> 'IO' ('Either' 'NoChange' ())
--
-- resize :: 'Ref' 'TableBase' -> 'Rectangle' -> 'IO' ()
--
-- setColHeader :: 'Ref' 'TableBase' -> 'Bool' -> 'IO' ()
--
-- setColHeaderColor :: 'Ref' 'TableBase' -> 'Color' -> 'IO' ()
--
-- setColHeaderHeight :: 'Ref' 'TableBase' -> 'Int' -> 'IO' ()
--
-- setColPosition :: 'Ref' 'TableBase' -> 'Column' -> 'IO' ()
--
-- setColResize :: 'Ref' 'TableBase' -> 'Bool' -> 'IO' ()
--
-- setColResizeMin :: 'Ref' 'TableBase' -> 'Int' -> 'IO' ()
--
-- setColWidth :: 'Ref' 'TableBase' -> 'Column' -> 'Int' -> 'IO' ()
--
-- setColWidthAll :: 'Ref' 'TableBase' -> 'Int' -> 'IO' ()
--
-- setCols :: 'Ref' 'TableBase' -> 'Columns' -> 'IO' ()
--
-- setRowHeader :: 'Ref' 'TableBase' -> 'Bool' -> 'IO' ()
--
-- setRowHeaderColor :: 'Ref' 'TableBase' -> 'Color' -> 'IO' ()
--
-- setRowHeaderWidth :: 'Ref' 'TableBase' -> 'Int' -> 'IO' ()
--
-- setRowHeight :: 'Ref' 'TableBase' -> 'Row' -> 'Int' -> 'IO' ()
--
-- setRowHeightAll :: 'Ref' 'TableBase' -> 'Int' -> 'IO' ()
--
-- setRowPosition :: 'Ref' 'TableBase' -> 'Row' -> 'IO' ()
--
-- setRowResize :: 'Ref' 'TableBase' -> 'Bool' -> 'IO' ()
--
-- setRowResizeMin :: 'Ref' 'TableBase' -> 'Int' -> 'IO' ()
--
-- setRows :: 'Ref' 'TableBase' -> 'Rows' -> 'IO' ()
--
-- setSelection :: 'Ref' 'TableBase' -> 'TableCoordinate' -> 'TableCoordinate' ->'IO' ()
--
-- setTabCellNav :: 'Ref' 'TableBase' -> 'Bool' -> 'IO' ()
--
-- setTableBox :: 'Ref' 'TableBase' -> 'Boxtype' -> 'IO' ()
--
-- setTopRow :: 'Ref' 'TableBase' -> 'Row' -> 'IO' ()
--
-- showWidget :: 'Ref' 'TableBase' -> 'IO' ()
-- @

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_default_virtual_funcs"
  virtualFuncs''_ :: (IO (C2HSImp.Ptr ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_New"
  tableNew''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_New_WithLabel"
  tableNewWithLabel''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ()))))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_Destroy"
  tableDestroy''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_table_box"
  setTableBox''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_table_box"
  tableBox''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_rows"
  rows''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_cols"
  cols''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_visible_cells"
  visibleCells''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_is_interactive_resize"
  isInteractiveResize''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_row_resize"
  rowResize''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_row_resize"
  setRowResize''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_col_resize"
  colResize''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_col_resize"
  setColResize''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_col_resize_min"
  colResizeMin''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_col_resize_min"
  setColResizeMin''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_row_resize_min"
  rowResizeMin''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_row_resize_min"
  setRowResizeMin''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_row_header"
  rowHeader''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_row_header"
  setRowHeader''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_col_header"
  colHeader''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_col_header"
  setColHeader''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_col_header_height"
  setColHeaderHeight''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_col_header_height"
  colHeaderHeight''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_row_header_width"
  setRowHeaderWidth''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_row_header_width"
  rowHeaderWidth''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_row_header_color"
  setRowHeaderColor''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CUInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_row_header_color"
  rowHeaderColor''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CUInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_col_header_color"
  setColHeaderColor''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CUInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_col_header_color"
  colHeaderColor''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CUInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_row_height"
  setRowHeight''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_row_height"
  rowHeight''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_col_width"
  setColWidth''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_col_width"
  colWidth''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_row_height_all"
  setRowHeightAll''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_col_width_all"
  setColWidthAll''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_row_position"
  setRowPosition''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_col_position"
  setColPosition''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_row_position"
  rowPosition''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_col_position"
  colPosition''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_top_row"
  setTopRow''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_top_row"
  topRow''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_is_selected"
  isSelected''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_get_selection"
  getSelection''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_selection"
  setSelection''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ()))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_move_cursor"
  moveCursor''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_init_sizes"
  initSizes''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_add"
  add''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_insert"
  insert''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_insert_with_widget"
  insertWithWidget''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_begin"
  begin''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_end"
  end''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_array"
  array''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr (C2HSImp.Ptr ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_child"
  child''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_children"
  children''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_find"
  find''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_callback_row"
  callbackRow''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_callback_col"
  callbackCol''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_callback_context"
  callbackContext''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_do_callback"
  doCallback''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_find_cell"
  findCell''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_tab_cell_nav"
  tabCellNav''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_tab_cell_nav"
  setTabCellNav''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_draw_super"
  drawSuper''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_handle_super"
  handleSuper''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_resize_super"
  resizeSuper''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ()))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_hide_super"
  hideSuper''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_show_super"
  showSuper''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_clear_super"
  clearSuper''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_rows_super"
  setRowsSuper''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_cols_super"
  setColsSuper''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_draw"
  draw''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_handle"
  handle''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_resize"
  resize''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ()))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_clear"
  clear''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_show"
  show''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_hide"
  hide''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_rows"
  setRows''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Table.chs.h Fl_Table_set_cols"
  setCols''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))