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


{-# LINE 1 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}
{-# LANGUAGE CPP, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Graphics.UI.FLTK.LowLevel.Tree
  (
    treeNew,
    treeCustom
    -- * Hierarchy
    --
    -- $hierarchy

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





import C2HS hiding (cFromEnum, cFromBool, cToBool,cToEnum)
import Graphics.UI.FLTK.LowLevel.Fl_Enumerations
import Graphics.UI.FLTK.LowLevel.TreeItem
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
import Graphics.UI.FLTK.LowLevel.Widget

overriddenWidgetNewWithLabel' :: (Int) -> (Int) -> (Int) -> (Int) -> (T.Text) -> (Ptr ()) -> IO ((Ptr ()))
overriddenWidgetNewWithLabel' 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
  let {a5' = unsafeToCString a5} in
  let {a6' = id a6} in
  overriddenWidgetNewWithLabel''_ a1' a2' a3' a4' a5' a6' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 29 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

overriddenWidgetNew' :: (Int) -> (Int) -> (Int) -> (Int) -> (Ptr ()) -> IO ((Ptr ()))
overriddenWidgetNew' 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
  overriddenWidgetNew''_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 30 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

treeCustom ::
       Rectangle                         -- ^ The bounds of this Tree
    -> Maybe T.Text                      -- ^ The Tree label
    -> Maybe (Ref Tree -> IO ())           -- ^ Optional custom drawing function
    -> Maybe (CustomWidgetFuncs Tree)      -- ^ Optional custom widget functions
    -> IO (Ref Tree)
treeCustom rectangle l' draw' funcs' =
  widgetMaker
    rectangle
    l'
    draw'
    funcs'
    overriddenWidgetNew'
    overriddenWidgetNewWithLabel'


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

{-# LINE 47 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

treeNewWithLabel' :: (Int) -> (Int) -> (Int) -> (Int) -> (T.Text) -> IO ((Ptr ()))
treeNewWithLabel' 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' = unsafeToCString a5} in
  treeNewWithLabel''_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 48 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

treeNew :: Rectangle -> Maybe T.Text -> IO (Ref Tree)
treeNew rectangle l' =
  widgetMaker
    rectangle
    l'
    Nothing
    Nothing
    overriddenWidgetNew'
    overriddenWidgetNewWithLabel'

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

{-# LINE 59 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (IO ())) => Op (Destroy ()) Tree orig impl where
  runOp _ _ tree = swapRef tree $ \treePtr -> do
    treeDestroy' treePtr
    return nullPtr

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

{-# LINE 65 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO ()) ) => Op (ShowSelf ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> showSelf' treePtr
rootLabel' :: (Ptr ()) -> (Ptr CChar) -> IO ()
rootLabel' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  rootLabel''_ a1' a2' >>
  return ()

{-# LINE 68 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (T.Text ->  IO ()) ) => Op (RootLabel ()) Tree orig impl where
  runOp _ _ tree new_label = withRef tree $ \treePtr -> withText new_label (\new_labelPtr -> rootLabel' treePtr new_labelPtr)
root' :: (Ptr ()) -> IO ((Ptr ()))
root' a1 =
  let {a1' = id a1} in
  root''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 71 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Maybe (Ref TreeItem))) ) => Op (Root ()) Tree orig impl where
  runOp _ _  tree = withRef tree $ \treePtr -> root' treePtr >>= toMaybeRef
add' :: (Ptr ()) -> (Ptr CChar) -> IO ((Ptr ()))
add' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  add''_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 74 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

addWithItemName' :: (Ptr ()) -> (Ptr ()) -> (Ptr CChar) -> IO ((Ptr ()))
addWithItemName' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = id a3} in
  addWithItemName''_ a1' a2' a3' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 75 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (T.Text ->  IO (Maybe (Ref TreeItem)))) => Op (Add ()) Tree orig impl where
  runOp _ _  tree path' = withRef tree $ \treePtr -> withText path' (\pathPtr' -> add' treePtr pathPtr' >>= toMaybeRef )
instance (Parent a TreeItem, impl ~ (T.Text -> Ref a -> IO (Maybe (Ref TreeItem)))) => Op (AddAt ()) Tree orig impl where
  runOp _ _ tree path' item' =
    withRef tree  $ \treePtr ->
    withRef item' $ \itemPtr ->
    withText path' $ \pathPtr ->
    addWithItemName' treePtr itemPtr pathPtr >>= toMaybeRef
insertAbove' :: (Ptr ()) -> (Ptr ()) -> (T.Text) -> IO ((Ptr ()))
insertAbove' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = unsafeToCString a3} in
  insertAbove''_ a1' a2' a3' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 84 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (Parent a TreeItem, impl ~ (Ref a -> T.Text ->  IO (Maybe (Ref a)))) => Op (InsertAbove ()) Tree orig impl where
  runOp _ _  tree above name = withRef tree $ \treePtr -> withRef above $ \abovePtr -> insertAbove' treePtr abovePtr name >>= toMaybeRef
insert' :: (Ptr ()) -> (Ptr ()) -> (T.Text) -> (Int) -> IO ((Ptr ()))
insert' a1 a2 a3 a4 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = unsafeToCString a3} in
  let {a4' = fromIntegral a4} in
  insert''_ a1' a2' a3' a4' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 87 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (Parent a TreeItem, impl ~ (Ref a -> T.Text -> AtIndex ->  IO (Maybe (Ref a)))) => Op (Insert ()) Tree orig impl where
  runOp _ _ tree item name (AtIndex pos) = withRef tree $ \treePtr -> withRef item $ \itemPtr -> insert' treePtr itemPtr name pos >>= toMaybeRef
remove' :: (Ptr ()) -> (Ptr ()) -> IO ((Int))
remove' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  remove''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 90 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Ref TreeItem  ->  IO (Either TreeItemNotFound ())) ) => Op (Remove ()) Tree orig impl where
  runOp _ _ tree item = withRef tree $ \treePtr -> withRef item $ \itemPtr -> do
    status' <- remove' treePtr itemPtr
    if (status' == (-1)) then (return $ Left TreeItemNotFound) else (return $ Right ())
clear' :: (Ptr ()) -> IO ()
clear' a1 =
  let {a1' = id a1} in
  clear''_ a1' >>
  return ()

{-# LINE 95 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO ()) ) => Op (Clear ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> clear' treePtr
clearChildren' :: (Ptr ()) -> (Ptr ()) -> IO ()
clearChildren' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  clearChildren''_ a1' a2' >>
  return ()

{-# LINE 98 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (Parent a TreeItem, impl ~ (Ref a ->  IO ()) ) => Op (ClearChildren ()) Tree orig impl where
  runOp _ _ tree item = withRef tree $ \treePtr -> withRef item $ \itemPtr -> clearChildren' treePtr itemPtr
findItem' :: (Ptr ()) -> (T.Text) -> IO ((Ptr ()))
findItem' a1 a2 =
  let {a1' = id a1} in
  let {a2' = unsafeToCString a2} in
  findItem''_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 101 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (T.Text ->  IO (Maybe (Ref TreeItem))) ) => Op (FindItem ()) Tree orig impl where
  runOp _ _ tree path = withRef tree $ \treePtr -> findItem' treePtr path >>= toMaybeRef
itemPathname' :: (Ptr ()) -> (Ptr CChar) -> (Int) -> (Ptr ()) -> IO ((Int))
itemPathname' a1 a2 a3 a4 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = id a4} in
  itemPathname''_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 104 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (Parent a TreeItem, impl ~ (Ref a ->  IO (Maybe T.Text)) ) => Op (ItemPathname ()) Tree orig impl where
  runOp _ _ tree item =
    withRef tree $ \treePtr ->
    withRef item $ \itemPtr ->
    allocaBytes oneKb $ \pathPtr -> do
    retVal' <- itemPathname' treePtr pathPtr oneKb itemPtr
    if retVal' < 0
      then return Nothing
      else do
       b' <- cStringToText (castPtr pathPtr)
       return (Just b')
itemClicked' :: (Ptr ()) -> IO ((Ptr ()))
itemClicked' a1 =
  let {a1' = id a1} in
  itemClicked''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 116 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Maybe (Ref TreeItem))) ) => Op (ItemClicked ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> itemClicked' treePtr >>= toMaybeRef
first' :: (Ptr ()) -> IO ((Ptr ()))
first' a1 =
  let {a1' = id a1} in
  first''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 119 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Maybe (Ref TreeItem))) ) => Op (GetFirst ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> first' treePtr >>= toMaybeRef
firstVisible' :: (Ptr ()) -> IO ((Ptr ()))
firstVisible' a1 =
  let {a1' = id a1} in
  firstVisible''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 122 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Maybe (Ref TreeItem))) ) => Op (FirstVisible ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> firstVisible' treePtr >>= toMaybeRef
next' :: (Ptr ()) -> IO ((Ptr ()))
next' a1 =
  let {a1' = id a1} in
  next''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 125 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Maybe (Ref TreeItem))) ) => Op (Next ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> next' treePtr >>= toMaybeRef
nextWithItem' :: (Ptr ()) -> (Ptr ()) -> IO ((Ptr ()))
nextWithItem' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  nextWithItem''_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 128 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Ref TreeItem  ->  IO (Maybe (Ref TreeItem))) ) => Op (NextAfterItem ()) Tree orig impl where
  runOp _ _ tree item = withRef tree $ \treePtr -> withRef item $ \itemPtr -> nextWithItem' treePtr itemPtr >>= toMaybeRef
nextItem' :: (Ptr ()) -> (Ptr ()) -> (CInt) -> (Bool) -> IO ((Ptr ()))
nextItem' a1 a2 a3 a4 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = id a3} in
  let {a4' = cFromBool a4} in
  nextItem''_ a1' a2' a3' a4' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 131 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Ref TreeItem  ->  Maybe SearchDirection -> Bool -> IO (Maybe (Ref TreeItem))) ) => Op (NextItem ()) Tree orig impl where
  runOp _ _ tree item dir visible' =
    withRef tree $ \treePtr -> withRef item $ \itemPtr -> nextItem' treePtr itemPtr (maybe 0 (fromIntegral . fromEnum) dir) visible'
       >>= toMaybeRef
prev' :: (Ptr ()) -> IO ((Ptr ()))
prev' a1 =
  let {a1' = id a1} in
  prev''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 136 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Maybe (Ref TreeItem))) ) => Op (Prev ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> prev' treePtr >>= toMaybeRef
prevWithItem' :: (Ptr ()) -> (Ptr ()) -> IO ((Ptr ()))
prevWithItem' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  prevWithItem''_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

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

instance (impl ~ (Ref TreeItem  ->  IO (Maybe (Ref TreeItem))) ) => Op (PrevBeforeItem ()) Tree orig impl where
  runOp _ _ tree item = withRef tree $ \treePtr -> withRef item $ \itemPtr -> prevWithItem' treePtr itemPtr >>= toMaybeRef
last' :: (Ptr ()) -> IO ((Ptr ()))
last' a1 =
  let {a1' = id a1} in
  last''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 142 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Maybe (Ref TreeItem))) ) => Op (GetLast ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> last' treePtr >>= toMaybeRef
lastVisible' :: (Ptr ()) -> IO ((Ptr ()))
lastVisible' a1 =
  let {a1' = id a1} in
  lastVisible''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 145 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Maybe (Ref TreeItem))) ) => Op (LastVisible ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> lastVisible' treePtr >>= toMaybeRef
firstSelectedItem' :: (Ptr ()) -> IO ((Ptr ()))
firstSelectedItem' a1 =
  let {a1' = id a1} in
  firstSelectedItem''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 148 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Maybe (Ref TreeItem))) ) => Op (FirstSelectedItem ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> firstSelectedItem' treePtr >>= toMaybeRef
lastSelectedItem' :: (Ptr ()) -> IO ((Ptr ()))
lastSelectedItem' a1 =
  let {a1' = id a1} in
  lastSelectedItem''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 151 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Maybe (Ref TreeItem))) ) => Op (LastSelectedItem ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> lastSelectedItem' treePtr >>= toMaybeRef
nextSelectedItem' :: (Ptr ()) -> IO ((Ptr ()))
nextSelectedItem' a1 =
  let {a1' = id a1} in
  nextSelectedItem''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 154 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Maybe (Ref TreeItem))) ) => Op (NextSelectedItem ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> nextSelectedItem' treePtr >>= toMaybeRef
nextSelectedItemWithItemDirection' :: (Ptr ()) -> (Ptr ()) -> (CInt) -> IO ((Ptr ()))
nextSelectedItemWithItemDirection' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = id a3} in
  nextSelectedItemWithItemDirection''_ a1' a2' a3' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 157 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Ref TreeItem  ->  Maybe SearchDirection -> IO (Maybe (Ref TreeItem))) ) => Op (NextSelectedItemAfterItem ()) Tree orig impl where
  runOp _ _ tree item dir = withRef tree $ \treePtr -> withRef item $ \itemPtr -> nextSelectedItemWithItemDirection' treePtr itemPtr (maybe 0 (fromIntegral . fromEnum) dir) >>= toMaybeRef
openWithItem' :: (Ptr ()) -> (Ptr ()) -> IO ((Int))
openWithItem' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  openWithItem''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 160 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

openWithItemDocallback' :: (Ptr ()) -> (Ptr ()) -> (Bool) -> IO ((Int))
openWithItemDocallback' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = cFromBool a3} in
  openWithItemDocallback''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

openWithPath' :: (Ptr ()) -> (T.Text) -> IO ((Int))
openWithPath' a1 a2 =
  let {a1' = id a1} in
  let {a2' = unsafeToCString a2} in
  openWithPath''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 162 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

openWithPathDocallback' :: (Ptr ()) -> (T.Text) -> (Bool) -> IO ((Int))
openWithPathDocallback' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = unsafeToCString a2} in
  let {a3' = cFromBool a3} in
  openWithPathDocallback''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 163 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (TreeItemLocator -> IO ()) ) => Op (Open ()) Tree orig impl where
  runOp _ _ tree_item locator' =
    withRef tree_item $ \tree_itemPtr ->
    case locator' of
      TreeItemPointerLocator (TreeItemPointer itemRef) -> withRef itemRef $ \itemRefPtr -> openWithItem' tree_itemPtr itemRefPtr >> return ()
      TreeItemNameLocator (TreeItemName n') -> openWithPath' tree_itemPtr n' >> return ()
instance  (impl ~ (TreeItemLocator -> Bool -> IO ())) => Op (OpenAndCallback ()) Tree orig impl where
  runOp _ _ tree_item locator' docallback' =
    withRef tree_item $ \tree_itemPtr ->
    case locator' of
      TreeItemPointerLocator (TreeItemPointer itemRef) -> withRef itemRef $ \itemRefPtr -> openWithItemDocallback' tree_itemPtr itemRefPtr docallback' >> return ()
      TreeItemNameLocator (TreeItemName n') -> openWithPathDocallback' tree_itemPtr n' docallback' >> return ()
openToggle' :: (Ptr ()) -> (Ptr ()) -> IO ()
openToggle' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  openToggle''_ a1' a2' >>
  return ()

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

openToggleWithDocallback' :: (Ptr ()) -> (Ptr ()) -> (Bool) -> IO ()
openToggleWithDocallback' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = cFromBool a3} in
  openToggleWithDocallback''_ a1' a2' a3' >>
  return ()

{-# LINE 177 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Ref TreeItem  ->  IO ()) ) => Op (OpenToggle ()) Tree orig impl where
  runOp _ _ tree item = withRef tree $ \treePtr -> withRef item $ \itemPtr -> openToggle' treePtr itemPtr
instance (impl ~ (Ref TreeItem  -> Bool ->  IO ()) ) => Op (OpenToggleAndCallback ()) Tree orig impl where
  runOp _ _ tree item docallback = withRef tree $ \treePtr -> withRef item $ \itemPtr -> openToggleWithDocallback' treePtr itemPtr docallback
closeWithItem' :: (Ptr ()) -> (Ptr ()) -> IO ((Int))
closeWithItem' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  closeWithItem''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

closeWithItemDocallback' :: (Ptr ()) -> (Ptr ()) -> (Bool) -> IO ((Int))
closeWithItemDocallback' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = cFromBool a3} in
  closeWithItemDocallback''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 183 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

closeWithPath' :: (Ptr ()) -> (T.Text) -> IO ((Int))
closeWithPath' a1 a2 =
  let {a1' = id a1} in
  let {a2' = unsafeToCString a2} in
  closeWithPath''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 184 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

closeWithPathDocallback' :: (Ptr ()) -> (T.Text) -> (Bool) -> IO ((Int))
closeWithPathDocallback' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = unsafeToCString a2} in
  let {a3' = cFromBool a3} in
  closeWithPathDocallback''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

instance (impl ~ (TreeItemLocator -> IO ()) ) => Op (Close ()) Tree orig impl where
  runOp _ _ tree_item locator' =
    withRef tree_item $ \tree_itemPtr ->
    case locator' of
      TreeItemPointerLocator (TreeItemPointer itemRef) -> withRef itemRef $ \itemRefPtr -> closeWithItem' tree_itemPtr itemRefPtr >> return ()
      TreeItemNameLocator (TreeItemName n') -> closeWithPath' tree_itemPtr n' >> return ()
instance  (impl ~ (TreeItemLocator -> Bool -> IO ())) => Op (CloseAndCallback ()) Tree orig impl where
  runOp _ _ tree_item locator' docallback' =
    withRef tree_item $ \tree_itemPtr ->
    case locator' of
      TreeItemPointerLocator (TreeItemPointer itemRef) -> withRef itemRef $ \itemRefPtr -> closeWithItemDocallback' tree_itemPtr itemRefPtr docallback' >> return ()
      TreeItemNameLocator (TreeItemName n') -> closeWithPathDocallback' tree_itemPtr n' docallback' >> return ()
isOpenWithItem' :: (Ptr ()) -> (Ptr ()) -> IO ((Bool))
isOpenWithItem' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  isOpenWithItem''_ a1' a2' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 198 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

isOpenWithPath' :: (Ptr ()) -> (T.Text) -> IO ((Bool))
isOpenWithPath' a1 a2 =
  let {a1' = id a1} in
  let {a2' = unsafeToCString a2} in
  isOpenWithPath''_ a1' a2' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 199 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (TreeItemLocator ->  IO (Bool)) ) => Op (IsOpen ()) Tree orig impl where
  runOp _ _ tree locator' = withRef tree $ \treePtr ->
    case locator' of
      TreeItemPointerLocator (TreeItemPointer r') -> withRef r' $ \r'Ptr -> isOpenWithItem' treePtr r'Ptr
      TreeItemNameLocator (TreeItemName n') ->
        isOpenWithPath' treePtr n'
isCloseWithItem' :: (Ptr ()) -> (Ptr ()) -> IO ((Bool))
isCloseWithItem' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  isCloseWithItem''_ a1' a2' >>= \res ->
  let {res' = cToBool res} in
  return (res')

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

isCloseWithPath' :: (Ptr ()) -> (T.Text) -> IO ((Bool))
isCloseWithPath' a1 a2 =
  let {a1' = id a1} in
  let {a2' = unsafeToCString a2} in
  isCloseWithPath''_ a1' a2' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 207 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (TreeItemLocator ->  IO (Bool)) ) => Op (IsClose ()) Tree orig impl where
  runOp _ _ tree locator' = withRef tree $ \treePtr ->
    case locator' of
      TreeItemPointerLocator (TreeItemPointer r') -> withRef r' $ \r'Ptr -> isCloseWithItem' treePtr r'Ptr
      TreeItemNameLocator (TreeItemName n') -> isCloseWithPath' treePtr n'
selectWithItem' :: (Ptr ()) -> (Ptr ()) -> IO ((Int))
selectWithItem' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  selectWithItem''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 213 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

selectWithItemDocallback' :: (Ptr ()) -> (Ptr ()) -> (Bool) -> IO ((Int))
selectWithItemDocallback' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = cFromBool a3} in
  selectWithItemDocallback''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 214 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

selectWithPath' :: (Ptr ()) -> (T.Text) -> IO ((Int))
selectWithPath' a1 a2 =
  let {a1' = id a1} in
  let {a2' = unsafeToCString a2} in
  selectWithPath''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

selectWithPathDocallback' :: (Ptr ()) -> (T.Text) -> (Bool) -> IO ((Int))
selectWithPathDocallback' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = unsafeToCString a2} in
  let {a3' = cFromBool a3} in
  selectWithPathDocallback''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 216 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (TreeItemLocator  ->  IO (Either NoChange ())) ) => Op (Select ()) Tree orig impl where
  runOp _ _ tree locator' =
    withRef tree $ \treePtr ->
    case locator' of
      TreeItemPointerLocator (TreeItemPointer r') -> withRef r' $ \r'Ptr -> selectWithItem' treePtr r'Ptr >>= return . successOrNoChange
      TreeItemNameLocator (TreeItemName n') -> selectWithPath' treePtr n' >>= return . successOrNoChange
instance  (impl ~ (TreeItemLocator -> Bool -> IO ())) => Op (SelectAndCallback ()) Tree orig impl where
  runOp _ _ tree_item locator' docallback' =
    withRef tree_item $ \tree_itemPtr ->
    case locator' of
      TreeItemPointerLocator (TreeItemPointer itemRef) -> withRef itemRef $ \itemRefPtr -> selectWithItemDocallback' tree_itemPtr itemRefPtr docallback' >> return ()
      TreeItemNameLocator (TreeItemName n') -> selectWithPathDocallback' tree_itemPtr n' docallback' >> return ()
selectToggle' :: (Ptr ()) -> (Ptr ()) -> IO ()
selectToggle' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  selectToggle''_ a1' a2' >>
  return ()

{-# LINE 229 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

selectToggleWithDocallback' :: (Ptr ()) -> (Ptr ()) -> (Bool) -> IO ()
selectToggleWithDocallback' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = cFromBool a3} in
  selectToggleWithDocallback''_ a1' a2' a3' >>
  return ()

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

instance (impl ~ (Ref TreeItem  ->  IO ()) ) => Op (SelectToggle ()) Tree orig impl where
  runOp _ _ tree item = withRef tree $ \treePtr -> withRef item $ \itemPtr -> selectToggle' treePtr itemPtr
instance (impl ~ (Ref TreeItem  -> Bool ->  IO ()) ) => Op (SelectToggleAndCallback ()) Tree orig impl where
  runOp _ _ tree item docallback = withRef tree $ \treePtr -> withRef item $ \itemPtr -> selectToggleWithDocallback' treePtr itemPtr docallback
deselectWithItem' :: (Ptr ()) -> (Ptr ()) -> IO ((Int))
deselectWithItem' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  deselectWithItem''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 235 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

deselectWithItemDocallback' :: (Ptr ()) -> (Ptr ()) -> (Bool) -> IO ((Int))
deselectWithItemDocallback' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = cFromBool a3} in
  deselectWithItemDocallback''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

deselectWithPath' :: (Ptr ()) -> (T.Text) -> IO ((Int))
deselectWithPath' a1 a2 =
  let {a1' = id a1} in
  let {a2' = unsafeToCString a2} in
  deselectWithPath''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 237 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

deselectWithPathDocallback' :: (Ptr ()) -> (T.Text) -> (Bool) -> IO ((Int))
deselectWithPathDocallback' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = unsafeToCString a2} in
  let {a3' = cFromBool a3} in
  deselectWithPathDocallback''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 238 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (TreeItemLocator  ->  IO (Either NoChange ())) ) => Op (Deselect ()) Tree orig impl where
  runOp _ _ tree locator' =
    withRef tree $ \treePtr ->
    case locator' of
      TreeItemPointerLocator (TreeItemPointer r') -> withRef r' $ \r'Ptr -> deselectWithItem' treePtr r'Ptr >>= return . successOrNoChange
      TreeItemNameLocator (TreeItemName n') -> deselectWithPath' treePtr n' >>= return . successOrNoChange
instance  (impl ~ (TreeItemLocator -> Bool -> IO ())) => Op (DeselectAndCallback ()) Tree orig impl where
  runOp _ _ tree_item locator' docallback' =
    withRef tree_item $ \tree_itemPtr ->
    case locator' of
      TreeItemPointerLocator (TreeItemPointer itemRef) -> withRef itemRef $ \itemRefPtr -> deselectWithItemDocallback' tree_itemPtr itemRefPtr docallback' >> return ()
      TreeItemNameLocator (TreeItemName n') -> deselectWithPathDocallback' tree_itemPtr n' docallback' >> return ()
selectOnly' :: (Ptr ()) -> (Ptr ()) -> IO ()
selectOnly' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  selectOnly''_ a1' a2' >>
  return ()

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

selectOnlyWithDocallback' :: (Ptr ()) -> (Ptr ()) -> (Bool) -> IO ()
selectOnlyWithDocallback' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = cFromBool a3} in
  selectOnlyWithDocallback''_ a1' a2' a3' >>
  return ()

{-# LINE 252 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Ref TreeItem  ->  IO ()) ) => Op (SelectOnly ()) Tree orig impl where
  runOp _ _ tree item = withRef tree $ \treePtr -> withRef item $ \itemPtr -> selectOnly' treePtr itemPtr
instance (impl ~ (Ref TreeItem  -> Bool ->  IO ()) ) => Op (SelectOnlyAndCallback ()) Tree orig impl where
  runOp _ _ tree item docallback = withRef tree $ \treePtr -> withRef item $ \itemPtr -> selectOnlyWithDocallback' treePtr itemPtr docallback
selectAll' :: (Ptr ()) -> (Ptr ()) -> IO ()
selectAll' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  selectAll''_ a1' a2' >>
  return ()

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

selectAllWithDocallback' :: (Ptr ()) -> (Ptr ()) -> (Bool) -> IO ()
selectAllWithDocallback' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = cFromBool a3} in
  selectAllWithDocallback''_ a1' a2' a3' >>
  return ()

{-# LINE 258 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (IO ()) ) => Op (SelectAll ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr ->  selectAll' treePtr nullPtr
instance (impl ~ (Maybe (Ref TreeItem)  -> Bool ->  IO ()) ) => Op (SelectAllAndCallback ()) Tree orig impl where
  runOp _ _ tree item docallback = withRef tree $ \treePtr -> withMaybeRef item $ \itemPtr -> selectAllWithDocallback' treePtr itemPtr docallback
deselectAll' :: (Ptr ()) -> (Ptr ()) -> IO ()
deselectAll' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  deselectAll''_ a1' a2' >>
  return ()

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

deselectAllWithDocallback' :: (Ptr ()) -> (Ptr ()) -> (Bool) -> IO ()
deselectAllWithDocallback' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = cFromBool a3} in
  deselectAllWithDocallback''_ a1' a2' a3' >>
  return ()

{-# LINE 264 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (IO ()) ) => Op (DeselectAll ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr ->  deselectAll' treePtr nullPtr
instance (impl ~ (Maybe (Ref TreeItem)  -> Bool ->  IO ()) ) => Op (DeselectAllAndCallback ()) Tree orig impl where
  runOp _ _ tree item docallback = withRef tree $ \treePtr -> withMaybeRef item $ \itemPtr -> deselectAllWithDocallback' treePtr itemPtr docallback
setItemFocus' :: (Ptr ()) -> (Ptr ()) -> IO ()
setItemFocus' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  setItemFocus''_ a1' a2' >>
  return ()

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

instance (impl ~ (Ref TreeItem  ->  IO ()) ) => Op (SetItemFocus ()) Tree orig impl where
  runOp _ _ tree item = withRef tree $ \treePtr -> withRef item $ \itemPtr -> setItemFocus' treePtr itemPtr
getItemFocus' :: (Ptr ()) -> IO ((Ptr ()))
getItemFocus' a1 =
  let {a1' = id a1} in
  getItemFocus''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

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

instance (impl ~ ( IO (Maybe (Ref TreeItem))) ) => Op (GetItemFocus ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> getItemFocus' treePtr >>= toMaybeRef
isSelectedWithItem' :: (Ptr ()) -> (Ptr ()) -> IO ((Bool))
isSelectedWithItem' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  isSelectedWithItem''_ a1' a2' >>= \res ->
  let {res' = cToBool res} in
  return (res')

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

isSelectedWithPath' :: (Ptr ()) -> (T.Text) -> IO ((Bool))
isSelectedWithPath' a1 a2 =
  let {a1' = id a1} in
  let {a2' = unsafeToCString a2} in
  isSelectedWithPath''_ a1' a2' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 276 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (TreeItemLocator ->  IO (Bool)) ) => Op (IsSelected ()) Tree orig impl where
  runOp _ _ tree locator' = withRef tree $ \treePtr ->
    case locator' of
      TreeItemPointerLocator (TreeItemPointer item) -> withRef item $ \itemPtr -> isSelectedWithItem' treePtr itemPtr
      TreeItemNameLocator (TreeItemName path) -> isSelectedWithPath' treePtr path
itemLabelfont' :: (Ptr ()) -> IO ((Font))
itemLabelfont' a1 =
  let {a1' = id a1} in
  itemLabelfont''_ a1' >>= \res ->
  let {res' = cToFont res} in
  return (res')

{-# LINE 282 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Font)) ) => Op (GetItemLabelfont ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> itemLabelfont' treePtr
itemSetLabelfont' :: (Ptr ()) -> (Font) -> IO ()
itemSetLabelfont' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromFont a2} in
  itemSetLabelfont''_ a1' a2' >>
  return ()

{-# LINE 285 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Font ->  IO ()) ) => Op (SetItemLabelfont ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> itemSetLabelfont' treePtr val
itemLabelsize' :: (Ptr ()) -> IO ((CInt))
itemLabelsize' a1 =
  let {a1' = id a1} in
  itemLabelsize''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 288 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (FontSize)) ) => Op (GetItemLabelsize ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> itemLabelsize' treePtr >>= return . FontSize
itemSetLabelsize' :: (Ptr ()) -> (CInt) -> IO ()
itemSetLabelsize' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  itemSetLabelsize''_ a1' a2' >>
  return ()

{-# LINE 291 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (FontSize ->  IO ()) ) => Op (SetItemLabelsize ()) Tree orig impl where
  runOp _ _ tree (FontSize val) = withRef tree $ \treePtr -> itemSetLabelsize' treePtr val
itemLabelfgcolor' :: (Ptr ()) -> IO ((Color))
itemLabelfgcolor' a1 =
  let {a1' = id a1} in
  itemLabelfgcolor''_ a1' >>= \res ->
  let {res' = cToColor res} in
  return (res')

{-# LINE 294 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Color)) ) => Op (GetItemLabelfgcolor ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> itemLabelfgcolor' treePtr
setItemLabelfgcolor' :: (Ptr ()) -> (Color) -> IO ()
setItemLabelfgcolor' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromColor a2} in
  setItemLabelfgcolor''_ a1' a2' >>
  return ()

{-# LINE 297 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Color ->  IO ()) ) => Op (SetItemLabelfgcolor ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> setItemLabelfgcolor' treePtr val
itemLabelbgcolor' :: (Ptr ()) -> IO ((Color))
itemLabelbgcolor' a1 =
  let {a1' = id a1} in
  itemLabelbgcolor''_ a1' >>= \res ->
  let {res' = cToColor res} in
  return (res')

{-# LINE 300 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Color)) ) => Op (GetItemLabelbgcolor ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> itemLabelbgcolor' treePtr
setItemLabelbgcolor' :: (Ptr ()) -> (Color) -> IO ()
setItemLabelbgcolor' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromColor a2} in
  setItemLabelbgcolor''_ a1' a2' >>
  return ()

{-# LINE 303 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Color ->  IO ()) ) => Op (SetItemLabelbgcolor ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> setItemLabelbgcolor' treePtr val
connectorcolor' :: (Ptr ()) -> IO ((Color))
connectorcolor' a1 =
  let {a1' = id a1} in
  connectorcolor''_ a1' >>= \res ->
  let {res' = cToColor res} in
  return (res')

{-# LINE 306 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Color)) ) => Op (GetConnectorcolor ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> connectorcolor' treePtr
setConnectorcolor' :: (Ptr ()) -> (Color) -> IO ()
setConnectorcolor' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromColor a2} in
  setConnectorcolor''_ a1' a2' >>
  return ()

{-# LINE 309 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Color ->  IO ()) ) => Op (SetConnectorcolor ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> setConnectorcolor' treePtr val
marginleft' :: (Ptr ()) -> IO ((Int))
marginleft' a1 =
  let {a1' = id a1} in
  marginleft''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 312 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Int)) ) => Op (GetMarginleft ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> marginleft' treePtr
setMarginleft' :: (Ptr ()) -> (Int) -> IO ()
setMarginleft' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setMarginleft''_ a1' a2' >>
  return ()

{-# LINE 315 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Int ->  IO ()) ) => Op (SetMarginleft ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> setMarginleft' treePtr val
margintop' :: (Ptr ()) -> IO ((Int))
margintop' a1 =
  let {a1' = id a1} in
  margintop''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 318 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Int)) ) => Op (GetMargintop ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> margintop' treePtr
setMargintop' :: (Ptr ()) -> (Int) -> IO ()
setMargintop' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setMargintop''_ a1' a2' >>
  return ()

{-# LINE 321 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Int ->  IO ()) ) => Op (SetMargintop ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> setMargintop' treePtr val
linespacing' :: (Ptr ()) -> IO ((Int))
linespacing' a1 =
  let {a1' = id a1} in
  linespacing''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 324 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Int)) ) => Op (GetLinespacing ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> linespacing' treePtr
setLinespacing' :: (Ptr ()) -> (Int) -> IO ()
setLinespacing' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setLinespacing''_ a1' a2' >>
  return ()

{-# LINE 327 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Int ->  IO ()) ) => Op (SetLinespacing ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> setLinespacing' treePtr val
openchildMarginbottom' :: (Ptr ()) -> IO ((Int))
openchildMarginbottom' a1 =
  let {a1' = id a1} in
  openchildMarginbottom''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 330 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Int)) ) => Op (GetOpenchildMarginbottom ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> openchildMarginbottom' treePtr
setOpenchildMarginbottom' :: (Ptr ()) -> (Int) -> IO ()
setOpenchildMarginbottom' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setOpenchildMarginbottom''_ a1' a2' >>
  return ()

{-# LINE 333 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Int ->  IO ()) ) => Op (SetOpenchildMarginbottom ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> setOpenchildMarginbottom' treePtr val
usericonmarginleft' :: (Ptr ()) -> IO ((Int))
usericonmarginleft' a1 =
  let {a1' = id a1} in
  usericonmarginleft''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 336 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Int)) ) => Op (GetUsericonmarginleft ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> usericonmarginleft' treePtr
setUsericonmarginleft' :: (Ptr ()) -> (Int) -> IO ()
setUsericonmarginleft' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setUsericonmarginleft''_ a1' a2' >>
  return ()

{-# LINE 339 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Int ->  IO ()) ) => Op (SetUsericonmarginleft ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> setUsericonmarginleft' treePtr val
labelmarginleft' :: (Ptr ()) -> IO ((Int))
labelmarginleft' a1 =
  let {a1' = id a1} in
  labelmarginleft''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 342 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Int)) ) => Op (GetLabelmarginleft ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> labelmarginleft' treePtr
setLabelmarginleft' :: (Ptr ()) -> (Int) -> IO ()
setLabelmarginleft' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setLabelmarginleft''_ a1' a2' >>
  return ()

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

instance (impl ~ (Int ->  IO ()) ) => Op (SetLabelmarginleft ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> setLabelmarginleft' treePtr val
connectorwidth' :: (Ptr ()) -> IO ((Int))
connectorwidth' a1 =
  let {a1' = id a1} in
  connectorwidth''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

instance (impl ~ ( IO (Int)) ) => Op (GetConnectorwidth ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> connectorwidth' treePtr
setConnectorwidth' :: (Ptr ()) -> (Int) -> IO ()
setConnectorwidth' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setConnectorwidth''_ a1' a2' >>
  return ()

{-# LINE 351 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Int ->  IO ()) ) => Op (SetConnectorwidth ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> setConnectorwidth' treePtr val
usericon' :: (Ptr ()) -> IO ((Ptr ()))
usericon' a1 =
  let {a1' = id a1} in
  usericon''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 354 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Maybe (Ref Image))) ) => Op (GetUsericon ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> usericon' treePtr >>= toMaybeRef
setUsericon' :: (Ptr ()) -> (Ptr ()) -> IO ()
setUsericon' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  setUsericon''_ a1' a2' >>
  return ()

{-# LINE 357 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (Parent a Image, impl ~ (Maybe( Ref a )  ->  IO ()) ) => Op (SetUsericon ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> withMaybeRef val $ \valPtr -> setUsericon' treePtr valPtr
openicon' :: (Ptr ()) -> IO ((Ptr ()))
openicon' a1 =
  let {a1' = id a1} in
  openicon''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 360 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Maybe (Ref Image))) ) => Op (GetOpenicon ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> openicon' treePtr >>= toMaybeRef
setOpenicon' :: (Ptr ()) -> (Ptr ()) -> IO ()
setOpenicon' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  setOpenicon''_ a1' a2' >>
  return ()

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

instance (Parent a Image , impl ~ (Maybe( Ref a )  ->  IO ()) ) => Op (SetOpenicon ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> withMaybeRef val $ \valPtr -> setOpenicon' treePtr valPtr
closeicon' :: (Ptr ()) -> IO ((Ptr ()))
closeicon' a1 =
  let {a1' = id a1} in
  closeicon''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

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

instance (impl ~ ( IO (Maybe (Ref Image))) ) => Op (GetCloseicon ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> closeicon' treePtr >>= toMaybeRef
setCloseicon' :: (Ptr ()) -> (Ptr ()) -> IO ()
setCloseicon' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  setCloseicon''_ a1' a2' >>
  return ()

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

instance (Parent a Image, impl ~ (Maybe( Ref a )  ->  IO ()) ) => Op (SetCloseicon ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> withMaybeRef val $ \valPtr -> setCloseicon' treePtr valPtr
showcollapse' :: (Ptr ()) -> IO ((Bool))
showcollapse' a1 =
  let {a1' = id a1} in
  showcollapse''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

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

instance (impl ~ ( IO (Bool)) ) => Op (GetShowcollapse ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> showcollapse' treePtr
setShowcollapse' :: (Ptr ()) -> (Bool) -> IO ()
setShowcollapse' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromBool a2} in
  setShowcollapse''_ a1' a2' >>
  return ()

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

instance (impl ~ (Bool ->  IO ()) ) => Op (SetShowcollapse ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> setShowcollapse' treePtr val
showroot' :: (Ptr ()) -> IO ((Bool))
showroot' a1 =
  let {a1' = id a1} in
  showroot''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 378 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Bool)) ) => Op (GetShowroot ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> showroot' treePtr
setShowroot' :: (Ptr ()) -> (Bool) -> IO ()
setShowroot' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromBool a2} in
  setShowroot''_ a1' a2' >>
  return ()

{-# LINE 381 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Bool ->  IO ()) ) => Op (SetShowroot ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> setShowroot' treePtr val
connectorstyle' :: (Ptr ()) -> IO ((TreeConnector))
connectorstyle' a1 =
  let {a1' = id a1} in
  connectorstyle''_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 384 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (TreeConnector)) ) => Op (GetConnectorstyle ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> connectorstyle' treePtr
setConnectorstyle' :: (Ptr ()) -> (TreeConnector) -> IO ()
setConnectorstyle' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromEnum a2} in
  setConnectorstyle''_ a1' a2' >>
  return ()

{-# LINE 387 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (TreeConnector ->  IO ()) ) => Op (SetConnectorstyle ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> setConnectorstyle' treePtr val
sortorder' :: (Ptr ()) -> IO ((TreeSort))
sortorder' a1 =
  let {a1' = id a1} in
  sortorder''_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 390 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (TreeSort)) ) => Op (GetSortorder ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> sortorder' treePtr
setSortorder' :: (Ptr ()) -> (TreeSort) -> IO ()
setSortorder' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromEnum a2} in
  setSortorder''_ a1' a2' >>
  return ()

{-# LINE 393 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (TreeSort ->  IO ()) ) => Op (SetSortorder ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> setSortorder' treePtr val
selectbox' :: (Ptr ()) -> IO ((Boxtype))
selectbox' a1 =
  let {a1' = id a1} in
  selectbox''_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 396 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Boxtype)) ) => Op (GetSelectbox ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> selectbox' treePtr
setSelectbox' :: (Ptr ()) -> (Boxtype) -> IO ()
setSelectbox' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromEnum a2} in
  setSelectbox''_ a1' a2' >>
  return ()

{-# LINE 399 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Boxtype ->  IO ()) ) => Op (SetSelectbox ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> setSelectbox' treePtr val
selectmode' :: (Ptr ()) -> IO ((TreeSelect))
selectmode' a1 =
  let {a1' = id a1} in
  selectmode''_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 402 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (TreeSelect)) ) => Op (Selectmode ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> selectmode' treePtr
setSelectmode' :: (Ptr ()) -> (TreeSelect) -> IO ()
setSelectmode' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromEnum a2} in
  setSelectmode''_ a1' a2' >>
  return ()

{-# LINE 405 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (TreeSelect ->  IO ()) ) => Op (SetSelectmode ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> setSelectmode' treePtr val
displayed' :: (Ptr ()) -> (Ptr ()) -> IO ((Bool))
displayed' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  displayed''_ a1' a2' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 408 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Ref TreeItem  ->  IO (Bool)) ) => Op (Displayed ()) Tree orig impl where
  runOp _ _ tree item = withRef tree $ \treePtr -> withRef item $ \itemPtr -> displayed' treePtr itemPtr
showItemWithYoff' :: (Ptr ()) -> (Ptr ()) -> (Int) -> IO ()
showItemWithYoff' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = fromIntegral a3} in
  showItemWithYoff''_ a1' a2' a3' >>
  return ()

{-# LINE 411 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

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

{-# LINE 412 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Ref TreeItem  -> Maybe Y ->  IO ()) ) => Op (ShowItemWithYoff ()) Tree orig impl where
  runOp _ _ tree item yoff =
    withRef tree $ \treePtr ->
    withRef item $ \itemPtr ->
    case yoff of
      Just (Y y') -> showItemWithYoff' treePtr itemPtr y'
      Nothing -> showItem' treePtr itemPtr
showItemTop' :: (Ptr ()) -> (Ptr ()) -> IO ()
showItemTop' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  showItemTop''_ a1' a2' >>
  return ()

{-# LINE 420 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Ref TreeItem  ->  IO ()) ) => Op (ShowItemTop ()) Tree orig impl where
  runOp _ _ tree item = withRef tree $ \treePtr -> withRef item $ \itemPtr -> showItemTop' treePtr itemPtr
showItemMiddle' :: (Ptr ()) -> (Ptr ()) -> IO ()
showItemMiddle' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  showItemMiddle''_ a1' a2' >>
  return ()

{-# LINE 423 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Ref TreeItem  ->  IO ()) ) => Op (ShowItemMiddle ()) Tree orig impl where
  runOp _ _ tree item = withRef tree $ \treePtr -> withRef item $ \itemPtr -> showItemMiddle' treePtr itemPtr
showItemBottom' :: (Ptr ()) -> (Ptr ()) -> IO ()
showItemBottom' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  showItemBottom''_ a1' a2' >>
  return ()

{-# LINE 426 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Ref TreeItem  ->  IO ()) ) => Op (ShowItemBottom ()) Tree orig impl where
  runOp _ _ tree item = withRef tree $ \treePtr -> withRef item $ \itemPtr -> showItemBottom' treePtr itemPtr
display' :: (Ptr ()) -> (Ptr ()) -> IO ()
display' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  display''_ a1' a2' >>
  return ()

{-# LINE 429 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Ref TreeItem  ->  IO ()) ) => Op (Display ()) Tree orig impl where
  runOp _ _ tree item = withRef tree $ \treePtr -> withRef item $ \itemPtr -> display' treePtr itemPtr
vposition' :: (Ptr ()) -> IO ((Int))
vposition' a1 =
  let {a1' = id a1} in
  vposition''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 432 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Int)) ) => Op (GetVposition ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> vposition' treePtr
setVposition' :: (Ptr ()) -> (Int) -> IO ()
setVposition' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setVposition''_ a1' a2' >>
  return ()

{-# LINE 435 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Int ->  IO ()) ) => Op (SetVposition ()) Tree orig impl where
  runOp _ _ tree pos = withRef tree $ \treePtr -> setVposition' treePtr pos
isScrollbar' :: (Ptr ()) -> (Ptr ()) -> IO ((Bool))
isScrollbar' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  isScrollbar''_ a1' a2' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 438 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (Parent a Widget, impl ~ (Ref a  ->  IO (Bool)) ) => Op (IsScrollbar ()) Tree orig impl where
  runOp _ _ tree w = withRef tree $ \treePtr -> withRef w $ \wPtr -> isScrollbar' treePtr wPtr
scrollbarSize' :: (Ptr ()) -> IO ((Int))
scrollbarSize' a1 =
  let {a1' = id a1} in
  scrollbarSize''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 441 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (IO (Int)) ) => Op (GetScrollbarSize ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> scrollbarSize' treePtr
setScrollbarSize' :: (Ptr ()) -> (Int) -> IO ()
setScrollbarSize' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setScrollbarSize''_ a1' a2' >>
  return ()

{-# LINE 444 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Int ->  IO ()) ) => Op (SetScrollbarSize ()) Tree orig impl where
  runOp _ _ tree size = withRef tree $ \treePtr -> setScrollbarSize' treePtr size
isVscrollVisible' :: (Ptr ()) -> IO ((Bool))
isVscrollVisible' a1 =
  let {a1' = id a1} in
  isVscrollVisible''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 447 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Bool)) ) => Op (IsVscrollVisible ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> isVscrollVisible' treePtr
setCallbackItem' :: (Ptr ()) -> (Ptr ()) -> IO ()
setCallbackItem' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  setCallbackItem''_ a1' a2' >>
  return ()

{-# LINE 450 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (Parent a TreeItem, impl ~ (Ref a ->  IO ()) ) => Op (SetCallbackItem ()) Tree orig impl where
  runOp _ _ tree item = withRef tree $ \treePtr -> withRef item $ \itemPtr -> setCallbackItem' treePtr itemPtr
callbackItem' :: (Ptr ()) -> IO ((Ptr ()))
callbackItem' a1 =
  let {a1' = id a1} in
  callbackItem''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 453 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Maybe (Ref TreeItem))) ) => Op (GetCallbackItem ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> callbackItem' treePtr >>= toMaybeRef
setCallbackReason' :: (Ptr ()) -> (TreeReasonType) -> IO ()
setCallbackReason' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromEnum a2} in
  setCallbackReason''_ a1' a2' >>
  return ()

{-# LINE 456 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (TreeReasonType ->  IO ()) ) => Op (SetCallbackReason ()) Tree orig impl where
  runOp _ _ tree reason = withRef tree $ \treePtr -> setCallbackReason' treePtr reason
callbackReason' :: (Ptr ()) -> IO ((TreeReasonType))
callbackReason' a1 =
  let {a1' = id a1} in
  callbackReason''_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 459 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (TreeReasonType)) ) => Op (GetCallbackReason ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> callbackReason' treePtr
draw'' :: (Ptr ()) -> IO ()
draw'' a1 =
  let {a1' = id a1} in
  draw'''_ a1' >>
  return ()

{-# LINE 462 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (  IO ())) => Op (Draw ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> draw'' treePtr
drawSuper' :: (Ptr ()) -> IO ((()))
drawSuper' a1 =
  let {a1' = id a1} in
  drawSuper''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 465 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO ())) => Op (DrawSuper ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> drawSuper' treePtr
treeHandle' :: (Ptr ()) -> (CInt) -> IO ((Int))
treeHandle' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  treeHandle''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 468 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Event -> IO (Either UnknownEvent ()))) => Op (Handle ()) Tree orig impl where
  runOp _ _ tree event = withRef tree (\p -> treeHandle' p (fromIntegral . fromEnum $ event)) >>= return  . successOrUnknownEvent
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 471 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Event ->  IO (Either UnknownEvent ()))) => Op (HandleSuper ()) Tree orig impl where
  runOp _ _ tree event = withRef tree $ \treePtr -> handleSuper' treePtr (fromIntegral (fromEnum 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' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 474 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Rectangle -> IO ())) => Op (Resize ()) Tree orig impl where
  runOp _ _ tree rectangle = withRef tree $ \treePtr -> do
                                 let (x_pos,y_pos,w_pos,h_pos) = fromRectangle rectangle
                                 resize' treePtr x_pos y_pos w_pos h_pos
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 479 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Rectangle -> IO ())) => Op (ResizeSuper ()) Tree orig impl where
  runOp _ _ tree rectangle =
    let (x_pos, y_pos, width, height) = fromRectangle rectangle
    in withRef tree $ \treePtr -> resizeSuper' treePtr x_pos y_pos width height
hide' :: (Ptr ()) -> IO ()
hide' a1 =
  let {a1' = id a1} in
  hide''_ a1' >>
  return ()

{-# LINE 484 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (  IO ())) => Op (Hide ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> hide' treePtr
hideSuper' :: (Ptr ()) -> IO ((()))
hideSuper' a1 =
  let {a1' = id a1} in
  hideSuper''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 487 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO ())) => Op (HideSuper ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> hideSuper' treePtr
show' :: (Ptr ()) -> IO ()
show' a1 =
  let {a1' = id a1} in
  show''_ a1' >>
  return ()

{-# LINE 490 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (  IO ())) => Op (ShowWidget ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> show' treePtr
showSuper' :: (Ptr ()) -> IO ((()))
showSuper' a1 =
  let {a1' = id a1} in
  showSuper''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 493 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO ())) => Op (ShowWidgetSuper ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> showSuper' treePtr
recalcTree' :: (Ptr ()) -> IO ((()))
recalcTree' a1 =
  let {a1' = id a1} in
  recalcTree''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 496 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO ())) => Op (RecalcTree ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> recalcTree' treePtr
marginbottom' :: (Ptr ()) -> IO ((Int))
marginbottom' a1 =
  let {a1' = id a1} in
  marginbottom''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 499 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Int)) ) => Op (GetMarginbottom ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> marginbottom' treePtr
setMarginbottom' :: (Ptr ()) -> (Int) -> IO ()
setMarginbottom' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setMarginbottom''_ a1' a2' >>
  return ()

{-# LINE 502 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Int ->  IO ()) ) => Op (SetMarginbottom ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> setMarginbottom' treePtr val
widgetmarginleft' :: (Ptr ()) -> IO ((Int))
widgetmarginleft' a1 =
  let {a1' = id a1} in
  widgetmarginleft''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 505 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (Int)) ) => Op (GetWidgetmarginleft ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> widgetmarginleft' treePtr
setWidgetmarginleft' :: (Ptr ()) -> (Int) -> IO ()
setWidgetmarginleft' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setWidgetmarginleft''_ a1' a2' >>
  return ()

{-# LINE 508 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (Int ->  IO ()) ) => Op (SetWidgetmarginleft ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> setWidgetmarginleft' treePtr val
item_reselect_mode' :: (Ptr ()) -> IO ((TreeItemReselectMode))
item_reselect_mode' a1 =
  let {a1' = id a1} in
  item_reselect_mode''_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 511 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO (TreeItemReselectMode)) ) => Op (GetItemReselectMode ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> item_reselect_mode' treePtr
setItem_Reselect_Mode' :: (Ptr ()) -> (TreeItemReselectMode) -> IO ()
setItem_Reselect_Mode' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromEnum a2} in
  setItem_Reselect_Mode''_ a1' a2' >>
  return ()

{-# LINE 514 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ (TreeItemReselectMode ->  IO ()) ) => Op (SetItemReselectMode ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> setItem_Reselect_Mode' treePtr val
item_draw_mode' :: (Ptr ()) -> IO ((CInt))
item_draw_mode' a1 =
  let {a1' = id a1} in
  item_draw_mode''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 517 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ( IO ([TreeItemDrawMode])) ) => Op (GetItemDrawMode ()) Tree orig impl where
  runOp _ _ tree = withRef tree $ \treePtr -> item_draw_mode' treePtr >>= return . extract allTreeItemDrawModes
setItem_Draw_Mode' :: (Ptr ()) -> (CInt) -> IO ()
setItem_Draw_Mode' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setItem_Draw_Mode''_ a1' a2' >>
  return ()

{-# LINE 520 "src/Graphics/UI/FLTK/LowLevel/Tree.chs" #-}

instance (impl ~ ([TreeItemDrawMode] ->  IO ()) ) => Op (SetItemDrawMode ()) Tree orig impl where
  runOp _ _ tree val = withRef tree $ \treePtr -> setItem_Draw_Mode' treePtr (fromIntegral (combine val))

-- $functions
-- @
-- add :: 'Ref' 'Tree' -> 'T.Text' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- addAt:: ('Parent' a 'TreeItem') => 'Ref' 'Tree' -> 'T.Text' -> 'Ref' a -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- clear :: 'Ref' 'Tree' -> 'IO' ()
--
-- clearChildren:: ('Parent' a 'TreeItem') => 'Ref' 'Tree' -> 'Ref' a -> 'IO' ()
--
-- close :: 'Ref' 'Tree' -> 'TreeItemLocator' -> 'IO' ()
--
-- closeAndCallback :: 'Ref' 'Tree' -> 'TreeItemLocator' -> 'Bool' -> 'IO' ()
--
-- deselect :: 'Ref' 'Tree' -> 'TreeItemLocator' -> 'IO' ('Either' 'NoChange' ())
--
-- deselectAll :: 'Ref' 'Tree' -> 'IO' ()
--
-- deselectAllAndCallback :: 'Ref' 'Tree' -> 'Maybe' ('Ref' 'TreeItem') -> 'Bool' -> 'IO' ()
--
-- deselectAndCallback :: 'Ref' 'Tree' -> 'TreeItemLocator' -> 'Bool' -> 'IO' ()
--
-- destroy :: 'Ref' 'Tree' -> 'IO' ()
--
-- display :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'IO' ()
--
-- displayed :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'IO' ('Bool')
--
-- draw :: 'Ref' 'Tree' -> 'IO' ()
--
-- drawSuper :: 'Ref' 'Tree' -> 'IO' ()
--
-- findItem :: 'Ref' 'Tree' -> 'T.Text' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- firstSelectedItem :: 'Ref' 'Tree' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- firstVisible :: 'Ref' 'Tree' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- getCallbackItem :: 'Ref' 'Tree' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- getCallbackReason :: 'Ref' 'Tree' -> 'IO' ('TreeReasonType')
--
-- getCloseicon :: 'Ref' 'Tree' -> 'IO' ('Maybe' ('Ref' 'Image'))
--
-- getConnectorcolor :: 'Ref' 'Tree' -> 'IO' ('Color')
--
-- getConnectorstyle :: 'Ref' 'Tree' -> 'IO' ('TreeConnector')
--
-- getConnectorwidth :: 'Ref' 'Tree' -> 'IO' ('Int')
--
-- getFirst :: 'Ref' 'Tree' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- getItemDrawMode :: 'Ref' 'Tree' -> 'IO' (['TreeItemDrawMode')]
--
-- getItemFocus :: 'Ref' 'Tree' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- getItemLabelbgcolor :: 'Ref' 'Tree' -> 'IO' ('Color')
--
-- getItemLabelfgcolor :: 'Ref' 'Tree' -> 'IO' ('Color')
--
-- getItemLabelfont :: 'Ref' 'Tree' -> 'IO' ('Font')
--
-- getItemLabelsize :: 'Ref' 'Tree' -> 'IO' ('FontSize')
--
-- getItemReselectMode :: 'Ref' 'Tree' -> 'IO' ('TreeItemReselectMode')
--
-- getLabelmarginleft :: 'Ref' 'Tree' -> 'IO' ('Int')
--
-- getLast :: 'Ref' 'Tree' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- getLinespacing :: 'Ref' 'Tree' -> 'IO' ('Int')
--
-- getMarginbottom :: 'Ref' 'Tree' -> 'IO' ('Int')
--
-- getMarginleft :: 'Ref' 'Tree' -> 'IO' ('Int')
--
-- getMargintop :: 'Ref' 'Tree' -> 'IO' ('Int')
--
-- getOpenchildMarginbottom :: 'Ref' 'Tree' -> 'IO' ('Int')
--
-- getOpenicon :: 'Ref' 'Tree' -> 'IO' ('Maybe' ('Ref' 'Image'))
--
-- getScrollbarSize :: 'Ref' 'Tree' -> 'IO' ('Int')
--
-- getSelectbox :: 'Ref' 'Tree' -> 'IO' ('Boxtype')
--
-- getShowcollapse :: 'Ref' 'Tree' -> 'IO' ('Bool')
--
-- getShowroot :: 'Ref' 'Tree' -> 'IO' ('Bool')
--
-- getSortorder :: 'Ref' 'Tree' -> 'IO' ('TreeSort')
--
-- getUsericon :: 'Ref' 'Tree' -> 'IO' ('Maybe' ('Ref' 'Image'))
--
-- getUsericonmarginleft :: 'Ref' 'Tree' -> 'IO' ('Int')
--
-- getVposition :: 'Ref' 'Tree' -> 'IO' ('Int')
--
-- getWidgetmarginleft :: 'Ref' 'Tree' -> 'IO' ('Int')
--
-- handle :: 'Ref' 'Tree' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ())
--
-- handleSuper :: 'Ref' 'Tree' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ())
--
-- hide :: 'Ref' 'Tree' -> 'IO' ()
--
-- hideSuper :: 'Ref' 'Tree' -> 'IO' ()
--
-- insert:: ('Parent' a 'TreeItem') => 'Ref' 'Tree' -> 'Ref' a -> 'T.Text' -> 'AtIndex' -> 'IO' ('Maybe' ('Ref' a))
--
-- insertAbove:: ('Parent' a 'TreeItem') => 'Ref' 'Tree' -> 'Ref' a -> 'T.Text' -> 'IO' ('Maybe' ('Ref' a))
--
-- isClose :: 'Ref' 'Tree' -> 'TreeItemLocator' -> 'IO' ('Bool')
--
-- isOpen :: 'Ref' 'Tree' -> 'TreeItemLocator' -> 'IO' ('Bool')
--
-- isScrollbar:: ('Parent' a 'Widget') => 'Ref' 'Tree' -> 'Ref' a -> 'IO' ('Bool')
--
-- isSelected :: 'Ref' 'Tree' -> 'TreeItemLocator' -> 'IO' ('Bool')
--
-- isVscrollVisible :: 'Ref' 'Tree' -> 'IO' ('Bool')
--
-- itemClicked :: 'Ref' 'Tree' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- itemPathname:: ('Parent' a 'TreeItem') => 'Ref' 'Tree' -> 'Ref' a -> 'IO' ('Maybe' 'T.Text')
--
-- lastSelectedItem :: 'Ref' 'Tree' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- lastVisible :: 'Ref' 'Tree' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- next :: 'Ref' 'Tree' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- nextAfterItem :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- nextItem :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'Maybe' 'SearchDirection' -> 'Bool' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- nextSelectedItem :: 'Ref' 'Tree' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- nextSelectedItemAfterItem :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'Maybe' 'SearchDirection' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- open :: 'Ref' 'Tree' -> 'TreeItemLocator' -> 'IO' ()
--
-- openAndCallback :: 'Ref' 'Tree' -> 'TreeItemLocator' -> 'Bool' -> 'IO' ()
--
-- openToggle :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'IO' ()
--
-- openToggleAndCallback :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'Bool' -> 'IO' ()
--
-- prev :: 'Ref' 'Tree' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- prevBeforeItem :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- recalcTree :: 'Ref' 'Tree' -> 'IO' ()
--
-- remove :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'IO' ('Either' 'TreeItemNotFound' ())
--
-- resize :: 'Ref' 'Tree' -> 'Rectangle' -> 'IO' ()
--
-- resizeSuper :: 'Ref' 'Tree' -> 'Rectangle' -> 'IO' ()
--
-- root :: 'Ref' 'Tree' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- rootLabel :: 'Ref' 'Tree' -> 'T.Text' -> 'IO' ()
--
-- select :: 'Ref' 'Tree' -> 'TreeItemLocator' -> 'IO' ('Either' 'NoChange' ())
--
-- selectAll :: 'Ref' 'Tree' -> 'IO' ()
--
-- selectAllAndCallback :: 'Ref' 'Tree' -> 'Maybe' ('Ref' 'TreeItem') -> 'Bool' -> 'IO' ()
--
-- selectAndCallback :: 'Ref' 'Tree' -> 'TreeItemLocator' -> 'Bool' -> 'IO' ()
--
-- selectOnly :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'IO' ()
--
-- selectOnlyAndCallback :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'Bool' -> 'IO' ()
--
-- selectToggle :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'IO' ()
--
-- selectToggleAndCallback :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'Bool' -> 'IO' ()
--
-- selectmode :: 'Ref' 'Tree' -> 'IO' ('TreeSelect')
--
-- setCallbackItem:: ('Parent' a 'TreeItem') => 'Ref' 'Tree' -> 'Ref' a -> 'IO' ()
--
-- setCallbackReason :: 'Ref' 'Tree' -> 'TreeReasonType' -> 'IO' ()
--
-- setCloseicon:: ('Parent' a 'Image') => 'Ref' 'Tree' -> 'Maybe'( 'Ref' a ) -> 'IO' ()
--
-- setConnectorcolor :: 'Ref' 'Tree' -> 'Color' -> 'IO' ()
--
-- setConnectorstyle :: 'Ref' 'Tree' -> 'TreeConnector' -> 'IO' ()
--
-- setConnectorwidth :: 'Ref' 'Tree' -> 'Int' -> 'IO' ()
--
-- setItemDrawMode :: 'Ref' 'Tree' -> ['TreeItemDrawMode'] -> 'IO' ()
--
-- setItemFocus :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'IO' ()
--
-- setItemLabelbgcolor :: 'Ref' 'Tree' -> 'Color' -> 'IO' ()
--
-- setItemLabelfgcolor :: 'Ref' 'Tree' -> 'Color' -> 'IO' ()
--
-- setItemLabelfont :: 'Ref' 'Tree' -> 'Font' -> 'IO' ()
--
-- setItemLabelsize :: 'Ref' 'Tree' -> 'FontSize' -> 'IO' ()
--
-- setItemReselectMode :: 'Ref' 'Tree' -> 'TreeItemReselectMode' -> 'IO' ()
--
-- setLabelmarginleft :: 'Ref' 'Tree' -> 'Int' -> 'IO' ()
--
-- setLinespacing :: 'Ref' 'Tree' -> 'Int' -> 'IO' ()
--
-- setMarginbottom :: 'Ref' 'Tree' -> 'Int' -> 'IO' ()
--
-- setMarginleft :: 'Ref' 'Tree' -> 'Int' -> 'IO' ()
--
-- setMargintop :: 'Ref' 'Tree' -> 'Int' -> 'IO' ()
--
-- setOpenchildMarginbottom :: 'Ref' 'Tree' -> 'Int' -> 'IO' ()
--
-- setOpenicon:: ('Parent' a 'Image') => 'Ref' 'Tree' -> 'Maybe'( 'Ref' a ) -> 'IO' ()
--
-- setScrollbarSize :: 'Ref' 'Tree' -> 'Int' -> 'IO' ()
--
-- setSelectbox :: 'Ref' 'Tree' -> 'Boxtype' -> 'IO' ()
--
-- setSelectmode :: 'Ref' 'Tree' -> 'TreeSelect' -> 'IO' ()
--
-- setShowcollapse :: 'Ref' 'Tree' -> 'Bool' -> 'IO' ()
--
-- setShowroot :: 'Ref' 'Tree' -> 'Bool' -> 'IO' ()
--
-- setSortorder :: 'Ref' 'Tree' -> 'TreeSort' -> 'IO' ()
--
-- setUsericon:: ('Parent' a 'Image') => 'Ref' 'Tree' -> 'Maybe'( 'Ref' a ) -> 'IO' ()
--
-- setUsericonmarginleft :: 'Ref' 'Tree' -> 'Int' -> 'IO' ()
--
-- setVposition :: 'Ref' 'Tree' -> 'Int' -> 'IO' ()
--
-- setWidgetmarginleft :: 'Ref' 'Tree' -> 'Int' -> 'IO' ()
--
-- showItemBottom :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'IO' ()
--
-- showItemMiddle :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'IO' ()
--
-- showItemTop :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'IO' ()
--
-- showItemWithYoff :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'Maybe' 'Y' -> 'IO' ()
--
-- showSelf :: 'Ref' 'Tree' -> 'IO' ()
--
-- showWidget :: 'Ref' 'Tree' -> 'IO' ()
--
-- showWidgetSuper :: 'Ref' 'Tree' -> 'IO' ()
-- @

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_OverriddenTree_New_WithLabel"
  overriddenWidgetNewWithLabel''_ :: (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/Tree.chs.h Fl_OverriddenTree_New"
  overriddenWidgetNew''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_New"
  treeNew''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr ()))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_New_WithLabel"
  treeNewWithLabel''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr ())))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_Destroy"
  treeDestroy''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_show_self"
  showSelf''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_root_label"
  rootLabel''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_root"
  root''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_add_with_item_name"
  addWithItemName''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr ())))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_insert_above"
  insertAbove''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr ())))))

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_remove"
  remove''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_clear_children"
  clearChildren''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_find_item"
  findItem''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_item_pathname"
  itemPathname''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_item_clicked"
  itemClicked''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_first"
  first''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_first_visible"
  firstVisible''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_next"
  next''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_next_with_item"
  nextWithItem''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_next_item"
  nextItem''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr ()))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_prev"
  prev''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_prev_with_item"
  prevWithItem''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_last"
  last''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_last_visible"
  lastVisible''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_first_selected_item"
  firstSelectedItem''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_last_selected_item"
  lastSelectedItem''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_next_selected_item"
  nextSelectedItem''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_next_selected_item_with_item_direction"
  nextSelectedItemWithItemDirection''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr ())))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_open_with_item"
  openWithItem''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_open_with_item_docallback"
  openWithItemDocallback''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_open_with_path"
  openWithPath''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_open_with_path_docallback"
  openWithPathDocallback''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_open_toggle"
  openToggle''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_open_toggle_with_docallback"
  openToggleWithDocallback''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_close_with_item"
  closeWithItem''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_close_with_item_docallback"
  closeWithItemDocallback''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_close_with_path"
  closeWithPath''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_close_with_path_docallback"
  closeWithPathDocallback''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_is_open_with_item"
  isOpenWithItem''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_is_open_with_path"
  isOpenWithPath''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_is_close_with_item"
  isCloseWithItem''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_is_close_with_path"
  isCloseWithPath''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_select_with_item"
  selectWithItem''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_select_with_item_docallback"
  selectWithItemDocallback''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_select_with_path"
  selectWithPath''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_select_with_path_docallback"
  selectWithPathDocallback''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_select_toggle"
  selectToggle''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_select_toggle_with_docallback"
  selectToggleWithDocallback''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_deselect_with_item"
  deselectWithItem''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_deselect_with_item_docallback"
  deselectWithItemDocallback''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_deselect_with_path"
  deselectWithPath''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_deselect_with_path_docallback"
  deselectWithPathDocallback''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_select_only"
  selectOnly''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_select_only_with_docallback"
  selectOnlyWithDocallback''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_select_all"
  selectAll''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_select_all_with_docallback"
  selectAllWithDocallback''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_deselect_all_with_item"
  deselectAll''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_deselect_all_with_item_docallback"
  deselectAllWithDocallback''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_item_focus"
  setItemFocus''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_get_item_focus"
  getItemFocus''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_is_selected_with_item"
  isSelectedWithItem''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_is_selected_with_path"
  isSelectedWithPath''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_item_labelfont"
  itemLabelfont''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_item_labelfont"
  itemSetLabelfont''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_item_labelsize"
  itemLabelsize''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_item_labelsize"
  itemSetLabelsize''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_item_labelfgcolor"
  itemLabelfgcolor''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CUInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_item_labelfgcolor"
  setItemLabelfgcolor''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CUInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_item_labelbgcolor"
  itemLabelbgcolor''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CUInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_item_labelbgcolor"
  setItemLabelbgcolor''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CUInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_connectorcolor"
  connectorcolor''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CUInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_connectorcolor"
  setConnectorcolor''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CUInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_marginleft"
  marginleft''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_marginleft"
  setMarginleft''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_margintop"
  margintop''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_margintop"
  setMargintop''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_linespacing"
  linespacing''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_linespacing"
  setLinespacing''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_openchild_marginbottom"
  openchildMarginbottom''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_openchild_marginbottom"
  setOpenchildMarginbottom''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_usericonmarginleft"
  usericonmarginleft''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_usericonmarginleft"
  setUsericonmarginleft''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_labelmarginleft"
  labelmarginleft''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_labelmarginleft"
  setLabelmarginleft''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_connectorwidth"
  connectorwidth''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_connectorwidth"
  setConnectorwidth''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_usericon"
  usericon''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_usericon"
  setUsericon''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_openicon"
  openicon''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_openicon"
  setOpenicon''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_closeicon"
  closeicon''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_closeicon"
  setCloseicon''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_showcollapse"
  showcollapse''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_showcollapse"
  setShowcollapse''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_showroot"
  showroot''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_showroot"
  setShowroot''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_connectorstyle"
  connectorstyle''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_connectorstyle"
  setConnectorstyle''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_sortorder"
  sortorder''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_sortorder"
  setSortorder''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_selectbox"
  selectbox''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_selectbox"
  setSelectbox''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_selectmode"
  selectmode''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_selectmode"
  setSelectmode''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_displayed"
  displayed''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_show_item_with_yoff"
  showItemWithYoff''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_show_item"
  showItem''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_show_item_top"
  showItemTop''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_show_item_middle"
  showItemMiddle''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_show_item_bottom"
  showItemBottom''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_display"
  display''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_vposition"
  vposition''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_vposition"
  setVposition''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_is_scrollbar"
  isScrollbar''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_scrollbar_size"
  scrollbarSize''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_scrollbar_size"
  setScrollbarSize''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_is_vscroll_visible"
  isVscrollVisible''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_callback_item"
  setCallbackItem''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_callback_item"
  callbackItem''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_callback_reason"
  setCallbackReason''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_callback_reason"
  callbackReason''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_handle"
  treeHandle''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

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

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

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

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

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_recalc_tree"
  recalcTree''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_marginbottom"
  marginbottom''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_marginbottom"
  setMarginbottom''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_widgetmarginleft"
  widgetmarginleft''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_widgetmarginleft"
  setWidgetmarginleft''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_item_reselect_mode"
  item_reselect_mode''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_item_reselect_mode"
  setItem_Reselect_Mode''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_item_draw_mode"
  item_draw_mode''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Tree.chs.h Fl_Tree_set_item_draw_mode"
  setItem_Draw_Mode''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))