-- 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/Base/MenuItem.chs" #-}
{-# LANGUAGE OverloadedStrings, CPP, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Graphics.UI.FLTK.LowLevel.Base.MenuItem
  (
   menuItemNew,
   menuItemCustom,
   addMenuItem,
   MenuItemName(..),
   MenuItemPointer(..),
   MenuItemReference(..),
   MenuItemLocator(..),
   toMenuItemDrawF,
   drawMenuItemBase
   -- Hierarchy
   --
   -- $hierarchy
   --

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





import C2HS hiding (cFromEnum, cFromBool, cToBool,cToEnum)
import Graphics.UI.FLTK.LowLevel.Base.Widget(defaultDestroyCallbacks)
import Graphics.UI.FLTK.LowLevel.Fl_Enumerations
import Graphics.UI.FLTK.LowLevel.Fl_Types
import Graphics.UI.FLTK.LowLevel.Utils
import Graphics.UI.FLTK.LowLevel.Hierarchy
import Graphics.UI.FLTK.LowLevel.Dispatch
import qualified Data.Text as T

data MenuItemPointer = forall a. (Parent a MenuItemBase) => MenuItemPointer (Ref a)
newtype MenuItemName = MenuItemName T.Text
data MenuItemReference = MenuItemByIndex AtIndex | MenuItemByPointer MenuItemPointer
data MenuItemLocator = MenuItemPointerLocator MenuItemPointer | MenuItemNameLocator MenuItemName

toMenuItemDrawF ::
  (Parent a MenuItemBase) => (Ref a -> Rectangle -> Maybe (Ref MenuPrimBase) -> Bool -> IO ()) ->
  IO (FunPtr MenuItemDrawF)
toMenuItemDrawF :: (Ref a -> Rectangle -> Maybe (Ref MenuPrimBase) -> Bool -> IO ())
-> IO (FunPtr MenuItemDrawF)
toMenuItemDrawF f :: Ref a -> Rectangle -> Maybe (Ref MenuPrimBase) -> Bool -> IO ()
f =
    MenuItemDrawF -> IO (FunPtr MenuItemDrawF)
mkMenuItemDrawFPtr (\menuItemPtr :: Ptr ()
menuItemPtr x' :: CInt
x' y' :: CInt
y' w' :: CInt
w' h' :: CInt
h' menuPtr :: Ptr ()
menuPtr selected :: CInt
selected -> do
                           ForeignPtr (Ptr ())
pp <- Ptr () -> String -> IO (ForeignPtr (Ptr ()))
forall a.
HasCallStack =>
Ptr a -> String -> IO (ForeignPtr (Ptr a))
wrapNonNull Ptr ()
menuItemPtr "Null pointer : toMenuItemDrawFPrim"
                           Maybe (Ref MenuPrimBase)
maybeMenu <- Ptr () -> IO (Maybe (Ref MenuPrimBase))
forall a. Ptr () -> IO (Maybe (Ref a))
toMaybeRef Ptr ()
menuPtr
                           let rectangle :: Rectangle
rectangle = (Int, Int, Int, Int) -> Rectangle
toRectangle (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x',CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
y',CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
w',CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
h')
                           Ref a -> Rectangle -> Maybe (Ref MenuPrimBase) -> Bool -> IO ()
f (Ref Any -> Ref a
forall a r. Ref a -> Ref r
castTo (ForeignPtr (Ptr ()) -> Ref Any
forall a. ForeignPtr (Ptr ()) -> Ref a
wrapInRef ForeignPtr (Ptr ())
pp)) Rectangle
rectangle Maybe (Ref MenuPrimBase)
maybeMenu (CInt -> Bool
forall a. (Eq a, Num a, Ord a) => a -> Bool
cToBool CInt
selected)
                       )
  
new' :: (FunPtr DestroyCallbacksPrim) -> IO ((Ptr ()))
new' :: FunPtr DestroyCallbacksPrim -> IO (Ptr ())
new' a1 :: FunPtr DestroyCallbacksPrim
a1 =
  let {a1' :: FunPtr DestroyCallbacksPrim
a1' = FunPtr DestroyCallbacksPrim -> FunPtr DestroyCallbacksPrim
forall a. a -> a
id FunPtr DestroyCallbacksPrim
a1} in 
  FunPtr DestroyCallbacksPrim -> IO (Ptr ())
new''_ FunPtr DestroyCallbacksPrim
a1' IO (Ptr ()) -> (Ptr () -> IO (Ptr ())) -> IO (Ptr ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: Ptr ()
res ->
  let {res' :: Ptr ()
res' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
res} in
  Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ()
res')

{-# LINE 52 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

menuItemNew :: IO (Ref MenuItem)
menuItemNew = do
  fptr <- toDestroyCallbacksPrim defaultDestroyCallbacks
  new' fptr >>= toRef

newWithDraw' :: (FunPtr MenuItemDrawF) -> (FunPtr DestroyCallbacksPrim) -> IO ((Ptr ()))
newWithDraw' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  newWithDraw''_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 58 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

menuItemCustom :: (Parent a MenuItemBase) => (Ref a -> Rectangle -> Maybe (Ref MenuPrimBase) -> Bool -> IO ()) -> IO (Ref MenuItem)
menuItemCustom drawF = do
  fPtr <- toMenuItemDrawF drawF
  destroyFptr <- toDestroyCallbacksPrim defaultDestroyCallbacks
  p <- newWithDraw' fPtr destroyFptr
  toRef p

destroy' :: (Ptr ()) -> IO ((()))
destroy' :: Ptr () -> IO ()
destroy' a1 :: Ptr ()
a1 =
  let {a1' = id a1} in 
  Ptr () -> IO ()
destroy''_ Ptr ()
a1' IO () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: ()
res ->
  let {res' :: ()
res' = () -> ()
forall a. a -> a
id ()
res} in
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (()
res')

{-# LINE 66 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (impl ~ IO ()) => Op (Destroy ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> destroy' menu_itemPtr

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

{-# LINE 70 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (Parent a MenuItemBase, impl ~ (Int -> IO (Maybe (Ref a)))) => Op (NextWithStep ()) MenuItemBase orig impl where
  runOp _ _ menu_item step =
    withRef menu_item $ \menu_itemPtr -> nextWithStep' menu_itemPtr step >>= toMaybeRef

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

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

instance (impl ~  IO (Maybe (Ref MenuItemBase))) => Op (Next ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> next' menu_itemPtr >>= toMaybeRef

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

{-# LINE 79 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (impl ~  IO (Maybe (Ref MenuItemBase))) => Op (GetFirst ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> first' menu_itemPtr >>=toMaybeRef

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

{-# LINE 83 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (impl ~  IO T.Text) => Op (GetLabel ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> label' menu_itemPtr >>= cStringToText

setLabel' :: (Ptr ()) -> (CString) -> IO ()
setLabel' a1 a2 =
  let {a1' = id a1} in 
  (flip ($)) a2 $ \a2' -> 
  setLabel''_ a1' a2' >>
  return ()

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

instance (impl ~ (T.Text ->  IO ())) => Op (SetLabel ()) MenuItemBase orig impl where
  runOp _ _ menu_item a = withRef menu_item $ \menu_itemPtr -> copyTextToCString a >>= setLabel' menu_itemPtr

setLabelWithLabeltype' :: (Ptr ()) -> (Labeltype) -> (CString) -> IO ()
setLabelWithLabeltype' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = cFromEnum a2} in 
  (flip ($)) a3 $ \a3' -> 
  setLabelWithLabeltype''_ a1' a2' a3' >>
  return ()

{-# LINE 91 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (impl ~ (Labeltype -> T.Text ->  IO ())) => Op (SetLabelWithLabeltype ()) MenuItemBase orig impl where
  runOp _ _ menu_item labeltype b = withRef menu_item $ \menu_itemPtr -> copyTextToCString b >>= setLabelWithLabeltype' menu_itemPtr labeltype

labeltype' :: (Ptr ()) -> IO ((Labeltype))
labeltype' a1 =
  let {a1' = id a1} in 
  labeltype''_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

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

instance (impl ~  IO (Labeltype)) => Op (GetLabeltype ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> labeltype' menu_itemPtr

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

{-# LINE 99 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (impl ~ (Labeltype ->  IO ())) => Op (SetLabeltype ()) MenuItemBase orig impl where
  runOp _ _ menu_item a = withRef menu_item $ \menu_itemPtr -> setLabeltype' menu_itemPtr a

labelcolor' :: (Ptr ()) -> IO ((Color))
labelcolor' a1 =
  let {a1' = id a1} in 
  labelcolor''_ a1' >>= \res ->
  let {res' = cToColor res} in
  return (res')

{-# LINE 103 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (impl ~  IO (Color)) => Op (GetLabelcolor ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> labelcolor' menu_itemPtr

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

{-# LINE 107 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (impl ~ (Color ->  IO ())) => Op (SetLabelcolor ()) MenuItemBase orig impl where
  runOp _ _ menu_item a = withRef menu_item $ \menu_itemPtr -> setLabelcolor' menu_itemPtr a

labelfont' :: (Ptr ()) -> IO ((Font))
labelfont' a1 =
  let {a1' = id a1} in 
  labelfont''_ a1' >>= \res ->
  let {res' = cToFont res} in
  return (res')

{-# LINE 111 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (impl ~  IO (Font)) => Op (GetLabelfont ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> labelfont' menu_itemPtr

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

{-# LINE 115 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (impl ~ (Font ->  IO ())) => Op (SetLabelfont ()) MenuItemBase orig impl where
  runOp _ _ menu_item a = withRef menu_item $ \menu_itemPtr -> setLabelfont' menu_itemPtr a

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

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

instance (impl ~  IO (FontSize)) => Op (GetLabelsize ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> labelsize' menu_itemPtr >>= return . FontSize

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

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

instance (impl ~ (FontSize ->  IO ())) => Op (SetLabelsize ()) MenuItemBase  orig impl where
  runOp _ _ menu_item (FontSize pix) = withRef menu_item $ \menu_itemPtr -> setLabelsize' menu_itemPtr pix

setCallback' :: (Ptr ()) -> (FunPtr CallbackWithUserDataPrim) -> IO ((FunPtr CallbackWithUserDataPrim))
setCallback' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  setCallback''_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 127 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (impl ~ ((Ref orig -> IO ()) -> IO ()) ) => Op (SetCallback ()) MenuItemBase orig impl where
  runOp _ _ menu_item c =
     withRef menu_item $ \menu_itemPtr -> do
      ptr <- toCallbackPrim c
      oldCb <- setCallback' menu_itemPtr (castFunPtr ptr)
      if (oldCb == nullFunPtr)
      then return ()
      else freeHaskellFunPtr oldCb

getCallback' :: (Ptr ()) -> IO ((FunPtr CallbackWithUserDataPrim))
getCallback' :: Ptr () -> IO (FunPtr DestroyCallbacksPrim)
getCallback' a1 =
  let {a1' = id a1} in 
  Ptr () -> IO (FunPtr DestroyCallbacksPrim)
getCallback''_ Ptr ()
a1' IO (FunPtr DestroyCallbacksPrim)
-> (FunPtr DestroyCallbacksPrim
    -> IO (FunPtr DestroyCallbacksPrim))
-> IO (FunPtr DestroyCallbacksPrim)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: FunPtr DestroyCallbacksPrim
res ->
  let {res' :: FunPtr DestroyCallbacksPrim
res' = FunPtr DestroyCallbacksPrim -> FunPtr DestroyCallbacksPrim
forall a. a -> a
id FunPtr DestroyCallbacksPrim
res} in
  FunPtr DestroyCallbacksPrim -> IO (FunPtr DestroyCallbacksPrim)
forall (m :: * -> *) a. Monad m => a -> m a
return (FunPtr DestroyCallbacksPrim
res')

{-# LINE 137 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (impl ~ (IO (FunPtr CallbackWithUserDataPrim))) => Op (GetCallback ()) MenuItemBase orig impl where
  runOp _ _ menuItem = withRef menuItem $ \menuItemPtr -> getCallback' menuItemPtr

shortcut' :: (Ptr ()) -> IO ((CInt))
shortcut' a1 =
  let {a1' = id a1} in 
  shortcut''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 141 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (impl ~  IO (Maybe ShortcutKeySequence)) => Op (GetShortcut ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> shortcut' menu_itemPtr >>= return . cIntToKeySequence

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

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

instance (impl ~ (ShortcutKeySequence ->  IO ())) => Op (SetShortcut ()) MenuItemBase orig impl where
  runOp _ _ input (ShortcutKeySequence modifiers char) =
    withRef input $ \inputPtr -> setShortcut' inputPtr (keySequenceToCInt modifiers char)

submenu' :: (Ptr ()) -> IO ((Bool))
submenu' a1 =
  let {a1' = id a1} in 
  submenu''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 150 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (impl ~  IO (Bool)) => Op (Submenu ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> submenu' menu_itemPtr

checkbox' :: (Ptr ()) -> IO ((Bool))
checkbox' a1 =
  let {a1' = id a1} in 
  checkbox''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

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

instance (impl ~  IO (Bool)) => Op (Checkbox ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> checkbox' menu_itemPtr

radio' :: (Ptr ()) -> IO ((Bool))
radio' a1 =
  let {a1' = id a1} in 
  radio''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

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

instance (impl ~  IO (Bool)) => Op (Radio ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> radio' menu_itemPtr

value' :: (Ptr ()) -> IO ((Bool))
value' a1 =
  let {a1' = id a1} in 
  value''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

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

instance (impl ~  IO (Bool)) => Op (GetValue ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> value' menu_itemPtr

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

{-# LINE 166 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (impl ~  IO ()) => Op (Set ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> set' menu_itemPtr

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

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

instance (impl ~  IO ()) => Op (Clear ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> clear' menu_itemPtr

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

{-# LINE 174 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (impl ~  IO ()) => Op (Setonly ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> setonly' menu_itemPtr

visible' :: (Ptr ()) -> IO ((Bool))
visible' a1 =
  let {a1' = id a1} in 
  visible''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 178 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (impl ~  IO (Bool)) => Op (Visible ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> visible' menu_itemPtr

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

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

instance (impl ~  IO ()) => Op (ShowWidget ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> show' menu_itemPtr

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

{-# LINE 186 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (impl ~  IO ()) => Op (Hide ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> hide' menu_itemPtr

active' :: (Ptr ()) -> IO ((Bool))
active' a1 =
  let {a1' = id a1} in 
  active''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 190 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (impl ~  IO (Bool)) => Op (Active ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> active' menu_itemPtr

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

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

instance (impl ~  IO ()) => Op (Activate ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> activate' menu_itemPtr

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

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

instance (impl ~  IO ()) => Op (Deactivate ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> deactivate' menu_itemPtr

activevisible' :: (Ptr ()) -> IO ((Bool))
activevisible' a1 =
  let {a1' = id a1} in 
  activevisible''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 202 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (impl ~  IO (Bool)) => Op (Activevisible ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> activevisible' menu_itemPtr

measure' :: (Ptr ()) -> (Ptr ()) -> IO ((Int), (Int))
measure' a1 a3 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  let {a3' = id a3} in 
  measure''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntConv  a2'>>= \a2'' -> 
  return (res', a2'')

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

instance (Parent a MenuPrimBase, impl ~ (Ref a ->  IO (Size))) => Op (Measure ()) MenuItemBase orig impl where
  runOp _ _ menu_item menu' = withRef menu_item $ \menu_itemPtr -> withRef menu' $ \menuPtr -> measure' menu_itemPtr menuPtr >>= \(h', w') -> return (Size (Width w') (Height h'))

drawWithT' :: (Ptr ()) -> (Int) -> (Int) -> (Int) -> (Int) -> (Ptr ()) -> (Bool) -> IO ()
drawWithT' a1 a2 a3 a4 a5 a6 a7 =
  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 
  let {a6' = id a6} in 
  let {a7' = cFromBool a7} in 
  drawWithT''_ a1' a2' a3' a4' a5' a6' a7' >>
  return ()

{-# LINE 210 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (Parent a MenuPrimBase, impl ~ (Rectangle -> Ref a -> Bool ->  IO ())) => Op (DrawWithT ()) MenuItemBase orig impl where
  runOp _ _ menu_item rectangle menu' selected =
    let (x_pos', y_pos', width', height') = fromRectangle rectangle in
    withRef menu_item $ \menu_itemPtr -> withRef menu' $ \menuPtr -> drawWithT' menu_itemPtr x_pos' y_pos' width' height' menuPtr selected

drawMenuItemBase :: Parent a MenuPrimBase => Ref MenuItemBase -> Rectangle -> Ref a ->  IO ()
drawMenuItemBase menu_item rectangle menu' =
  let (x_pos', y_pos', width', height') = fromRectangle rectangle in
  withRef menu_item $ \menu_itemPtr ->
  withRef menu' $ \menuPtr -> draw' menu_itemPtr x_pos' y_pos' width' height' menuPtr

draw' :: (Ptr ()) -> (Int) -> (Int) -> (Int) -> (Int) -> (Ptr ()) -> IO ()
draw' :: Ptr () -> Int -> Int -> Int -> Int -> Ptr () -> IO ()
draw' a1 :: Ptr ()
a1 a2 :: Int
a2 a3 :: Int
a3 a4 a5 :: Int
a5 a6 :: Ptr ()
a6 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  let {a5' :: CInt
a5' = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a5} in 
  let {a6' :: Ptr ()
a6' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a6} in 
  Ptr () -> CInt -> CInt -> CInt -> CInt -> Ptr () -> IO ()
draw''_ Ptr ()
a1' CInt
a2' CInt
a3' CInt
a4' CInt
a5' Ptr ()
a6' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 222 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (Parent a MenuPrim, impl ~ (Rectangle -> Ref a ->  IO ())) => Op (Draw ()) MenuItemBase orig impl where
  runOp _ _ menu_item rectangle menu' =
    let (x_pos', y_pos', width', height') = fromRectangle rectangle in
    withRef menu_item $ \menu_itemPtr ->
    withRef menu' $ \menuPtr -> draw' menu_itemPtr x_pos' y_pos' width' height' menuPtr

flags' :: (Ptr ()) -> IO ((Int))
flags' :: Ptr () -> IO Int
flags' a1 :: Ptr ()
a1 =
  let {a1' = id a1} in 
  Ptr () -> IO CInt
flags''_ Ptr ()
a1' IO CInt -> (CInt -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  let {res' :: Int
res' = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

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

instance (impl ~  IO (Maybe MenuItemFlags)) => Op (GetFlags ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> flags' menu_itemPtr >>= return . intToMenuItemFlags

setFlags' :: (Ptr ()) -> (Int) -> IO ()
setFlags' :: Ptr () -> Int -> IO ()
setFlags' a1 :: Ptr ()
a1 a2 :: Int
a2 =
  let {a1' = id a1} in 
  let {a2' :: CInt
a2' = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a2} in 
  Ptr () -> CInt -> IO ()
setFlags''_ Ptr ()
a1' CInt
a2' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance (impl ~ (MenuItemFlags ->  IO ())) => Op (SetFlags ()) MenuItemBase orig impl where
  runOp _ _ menu_item flags = withRef menu_item $ \menu_itemPtr -> setFlags' menu_itemPtr (menuItemFlagsToInt flags)

text' :: (Ptr ()) -> IO ((CString))
text' :: Ptr () -> IO CString
text' a1 :: Ptr ()
a1 =
  let {a1' = id a1} in 
  Ptr () -> IO CString
text''_ Ptr ()
a1' IO CString -> (CString -> IO CString) -> IO CString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CString
res ->
  CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
res IO CString -> (CString -> IO CString) -> IO CString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: CString
res' ->
  CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return (CString
res')

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

instance (impl ~ ( IO T.Text)) => Op (GetText ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> text' menu_itemPtr >>= cStringToText

pulldownWithArgs' :: (Ptr ()) -> (Int) -> (Int) -> (Int) -> (Int) -> (Ptr ()) -> (Ptr ()) -> (Ptr ()) -> (Bool) -> IO ((Ptr ()))
pulldownWithArgs' :: Ptr ()
-> Int
-> Int
-> Int
-> Int
-> Ptr ()
-> Ptr ()
-> Ptr ()
-> Bool
-> IO (Ptr ())
pulldownWithArgs' a1 :: Ptr ()
a1 a2 :: Int
a2 a3 :: Int
a3 a4 :: Int
a4 a5 :: Int
a5 a6 :: Ptr ()
a6 a7 :: Ptr ()
a7 a8 :: Ptr ()
a8 a9 :: Bool
a9 =
  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 
  let {a6' = id a6} in 
  let {a7' = id a7} in 
  let {a8' = id a8} in 
  let {a9' = fromBool a9} in 
  Ptr ()
-> CInt
-> CInt
-> CInt
-> CInt
-> Ptr ()
-> Ptr ()
-> Ptr ()
-> CInt
-> IO (Ptr ())
pulldownWithArgs''_ Ptr ()
a1' CInt
a2' CInt
a3' CInt
a4' CInt
a5' Ptr ()
a6' Ptr ()
a7' Ptr ()
a8' CInt
a9' IO (Ptr ()) -> (Ptr () -> IO (Ptr ())) -> IO (Ptr ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: Ptr ()
res ->
  let {res' :: Ptr ()
res' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
res} in
  Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ()
res')

{-# LINE 241 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (Parent a MenuPrimBase, Parent b MenuItemBase, Parent c MenuItemBase, impl ~ (Rectangle -> Maybe (Ref a) -> Maybe (Ref b) -> Maybe (Ref c) -> Maybe Bool -> IO (Maybe (Ref MenuItemBase)))) => Op (Pulldown ()) MenuItemBase orig impl where
  runOp _ _ menu_item rectangle picked' template_menu title menu_barFlag =
    let (x_pos, y_pos, width, height) = fromRectangle rectangle
        menu_bar = maybe False id menu_barFlag
    in
     withRef menu_item $ \menu_itemPtr ->
     withMaybeRef picked' $ \pickedPtr ->
     withMaybeRef template_menu $ \template_menuPtr ->
     withMaybeRef title $ \titlePtr ->
     pulldownWithArgs' menu_itemPtr x_pos y_pos width height pickedPtr template_menuPtr titlePtr menu_bar >>= toMaybeRef

popupWithArgs' :: (Ptr ()) -> (Int) -> (Int) -> (Ptr CChar) -> (Ptr ()) -> (Ptr ()) -> IO ((Ptr ()))
popupWithArgs' :: Ptr () -> Int -> Int -> CString -> Ptr () -> Ptr () -> IO (Ptr ())
popupWithArgs' a1 :: Ptr ()
a1 a2 :: Int
a2 a3 :: Int
a3 a4 :: CString
a4 a5 :: Ptr ()
a5 a6 :: Ptr ()
a6 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = id a4} in 
  let {a5' = id a5} in 
  let {a6' = id a6} in 
  Ptr ()
-> CInt -> CInt -> CString -> Ptr () -> Ptr () -> IO (Ptr ())
popupWithArgs''_ Ptr ()
a1' CInt
a2' CInt
a3' CString
a4' Ptr ()
a5' Ptr ()
a6' IO (Ptr ()) -> (Ptr () -> IO (Ptr ())) -> IO (Ptr ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: Ptr ()
res ->
  let {res' :: Ptr ()
res' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
res} in
  Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ()
res')

{-# LINE 253 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (Parent a MenuItemBase, Parent b MenuPrimBase, Parent c MenuItemBase, impl ~ (Position -> Maybe T.Text -> Maybe (Ref a) -> Maybe (Ref b) -> IO (Maybe (Ref c)))) => Op (Popup ()) MenuItemBase orig impl where
  runOp _ _ menu_item (Position (X x_pos) (Y y_pos)) title picked' template_menu =
    withRef menu_item $ \menu_itemPtr ->
    withMaybeRef picked' $ \pickedPtr ->
    withMaybeRef template_menu $ \template_menuPtr ->
    maybeNew copyTextToCString title >>= \titlePtr ->
    popupWithArgs' menu_itemPtr x_pos y_pos titlePtr pickedPtr template_menuPtr >>= toMaybeRef

testShortcut' :: (Ptr ()) -> IO ((Ptr ()))
testShortcut' :: Ptr () -> IO (Ptr ())
testShortcut' a1 :: Ptr ()
a1 =
  let {a1' = id a1} in 
  Ptr () -> IO (Ptr ())
testShortcut''_ Ptr ()
a1' IO (Ptr ()) -> (Ptr () -> IO (Ptr ())) -> IO (Ptr ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: Ptr ()
res ->
  let {res' :: Ptr ()
res' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
res} in
  Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ()
res')

{-# LINE 262 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (Parent a MenuItemBase, impl ~ ( IO (Maybe (Ref a)))) => Op (TestShortcut ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> testShortcut' menu_itemPtr >>= toMaybeRef

findShortcutWithIpRequireAlt' :: (Ptr ()) -> (Ptr CInt) -> (Bool) -> IO ((Ptr ()))
findShortcutWithIpRequireAlt' :: Ptr () -> Ptr CInt -> Bool -> IO (Ptr ())
findShortcutWithIpRequireAlt' a1 :: Ptr ()
a1 a2 :: Ptr CInt
a2 a3 :: Bool
a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = C2HSImp.fromBool a3} in 
  findShortcutWithIpRequireAlt''_ a1' a2' a3' >>= \res ->
  let {res' :: Ptr ()
res' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
res} in
  Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ()
res')

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

instance (Parent a MenuItemBase, impl ~ (Maybe AtIndex -> Bool -> IO (Maybe (Ref a)))) => Op (FindShortcut ()) MenuItemBase orig impl where
  runOp _ _ menu_item index' require_alt =
    withRef menu_item $ \menu_itemPtr ->
        maybeNew (new . fromIntegral) (fmap (\(AtIndex i) -> i) index') >>= \index_Ptr ->
            findShortcutWithIpRequireAlt' menu_itemPtr index_Ptr require_alt >>= toMaybeRef

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

{-# LINE 273 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (impl ~ (Ref Widget  ->  IO ())) => Op (DoCallback ()) MenuItemBase orig impl where
  runOp _ _ menu_item o = withRef menu_item $ \menu_itemPtr -> withRef o $ \oPtr -> doCallback' menu_itemPtr oPtr

addMenuItem ::
  (Parent menuItem MenuItemBase) =>
  Either (Ref MenuPrimBase) (Ref MenuItemBase) ->
  T.Text ->
  Maybe Shortcut ->
  Maybe (Ref menuItem -> IO ()) ->
  MenuItemFlags ->
  (Ptr () -> CString -> CInt -> FunPtr CallbackWithUserDataPrim -> Int -> IO Int) ->
  (Ptr () -> CString -> CString -> FunPtr CallbackWithUserDataPrim -> Int -> IO Int) ->
  IO (AtIndex)
addMenuItem :: Either (Ref MenuPrimBase) (Ref MenuItemBase)
-> Text
-> Maybe Shortcut
-> Maybe (Ref menuItem -> IO ())
-> MenuItemFlags
-> (Ptr ()
    -> CString -> CInt -> FunPtr DestroyCallbacksPrim -> Int -> IO Int)
-> (Ptr ()
    -> CString
    -> CString
    -> FunPtr DestroyCallbacksPrim
    -> Int
    -> IO Int)
-> IO AtIndex
addMenuItem refMenuOrMenuItem :: Either (Ref MenuPrimBase) (Ref MenuItemBase)
refMenuOrMenuItem name :: Text
name shortcut :: Maybe Shortcut
shortcut cb :: Maybe (Ref menuItem -> IO ())
cb flags :: MenuItemFlags
flags addWithFlags :: Ptr ()
-> CString -> CInt -> FunPtr DestroyCallbacksPrim -> Int -> IO Int
addWithFlags addWithShortcutnameFlags :: Ptr ()
-> CString
-> CString
-> FunPtr DestroyCallbacksPrim
-> Int
-> IO Int
addWithShortcutnameFlags =
     (Ref MenuPrimBase -> IO AtIndex)
-> (Ref MenuItemBase -> IO AtIndex)
-> Either (Ref MenuPrimBase) (Ref MenuItemBase)
-> IO AtIndex
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
       (\menu :: Ref MenuPrimBase
menu -> Ref MenuPrimBase -> (Ptr () -> IO AtIndex) -> IO AtIndex
forall a b c. HasCallStack => Ref a -> (Ptr b -> IO c) -> IO c
withRef Ref MenuPrimBase
menu ((Ptr () -> IO AtIndex) -> IO AtIndex)
-> (Ptr () -> IO AtIndex) -> IO AtIndex
forall a b. (a -> b) -> a -> b
$ \menuPtr :: Ptr ()
menuPtr ->
           String -> Ptr () -> IO AtIndex
go "Menu_.add: Shortcut format string cannot be empty" Ptr ()
menuPtr)
       (\menuItem :: Ref MenuItemBase
menuItem -> Ref MenuItemBase -> (Ptr () -> IO AtIndex) -> IO AtIndex
forall a b c. HasCallStack => Ref a -> (Ptr b -> IO c) -> IO c
withRef Ref MenuItemBase
menuItem ((Ptr () -> IO AtIndex) -> IO AtIndex)
-> (Ptr () -> IO AtIndex) -> IO AtIndex
forall a b. (a -> b) -> a -> b
$ \menuItemPtr :: Ptr ()
menuItemPtr ->
           String -> Ptr () -> IO AtIndex
go "MenuItem.add: Shortcut format string cannot be empty" Ptr ()
menuItemPtr)
       Either (Ref MenuPrimBase) (Ref MenuItemBase)
refMenuOrMenuItem
    where
      go :: String -> Ptr () -> IO AtIndex
      go :: String -> Ptr () -> IO AtIndex
go errorMsg :: String
errorMsg menu_Ptr :: Ptr ()
menu_Ptr = do
        let combinedFlags :: Int
combinedFlags = MenuItemFlags -> Int
menuItemFlagsToInt MenuItemFlags
flags
        FunPtr (Ptr () -> IO ())
ptr <- IO (FunPtr (Ptr () -> IO ()))
-> ((Ref menuItem -> IO ()) -> IO (FunPtr (Ptr () -> IO ())))
-> Maybe (Ref menuItem -> IO ())
-> IO (FunPtr (Ptr () -> IO ()))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FunPtr (Ptr () -> IO ()) -> IO (FunPtr (Ptr () -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr (Ptr () -> IO ())
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)) (Ref menuItem -> IO ()) -> IO (FunPtr (Ptr () -> IO ()))
forall a. (Ref a -> IO ()) -> IO (FunPtr (Ptr () -> IO ()))
toCallbackPrim Maybe (Ref menuItem -> IO ())
cb
        Int
idx' <- case Maybe Shortcut
shortcut of
                 Just s' :: Shortcut
s' -> case Shortcut
s' of
                   KeySequence (ShortcutKeySequence modifiers :: [EventState]
modifiers char :: KeyType
char) -> do
                     CString
nameString <- Text -> IO CString
copyTextToCString Text
name
                     Ptr ()
-> CString -> CInt -> FunPtr DestroyCallbacksPrim -> Int -> IO Int
addWithFlags
                      Ptr ()
menu_Ptr
                      CString
nameString
                      ([EventState] -> KeyType -> CInt
keySequenceToCInt [EventState]
modifiers KeyType
char)
                      (FunPtr (Ptr () -> IO ()) -> FunPtr DestroyCallbacksPrim
forall a b. FunPtr a -> FunPtr b
castFunPtr FunPtr (Ptr () -> IO ())
ptr)
                      Int
combinedFlags
                   KeyFormat format' :: Text
format' ->
                     if (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
format') then do
                       CString
nameString <- Text -> IO CString
copyTextToCString Text
name
                       CString
formatString <- Text -> IO CString
copyTextToCString Text
format'
                       Ptr ()
-> CString
-> CString
-> FunPtr DestroyCallbacksPrim
-> Int
-> IO Int
addWithShortcutnameFlags
                         Ptr ()
menu_Ptr
                         CString
nameString
                         CString
formatString
                         (FunPtr (Ptr () -> IO ()) -> FunPtr DestroyCallbacksPrim
forall a b. FunPtr a -> FunPtr b
castFunPtr FunPtr (Ptr () -> IO ())
ptr)
                         Int
combinedFlags
                     else String -> IO Int
forall a. HasCallStack => String -> a
error String
errorMsg
                 Nothing -> do
                     CString
nameString <- Text -> IO CString
copyTextToCString Text
name
                     Ptr ()
-> CString -> CInt -> FunPtr DestroyCallbacksPrim -> Int -> IO Int
addWithFlags
                      Ptr ()
menu_Ptr
                      CString
nameString
                      0
                      (FunPtr (Ptr () -> IO ()) -> FunPtr DestroyCallbacksPrim
forall a b. FunPtr a -> FunPtr b
castFunPtr FunPtr (Ptr () -> IO ())
ptr)
                      Int
combinedFlags
        AtIndex -> IO AtIndex
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> AtIndex
AtIndex Int
idx')

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

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

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

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

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

{-# LINE 332 "src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs" #-}

instance (Parent a MenuItemBase, impl ~ (T.Text -> Maybe Shortcut -> Maybe (Ref a -> IO ()) -> MenuItemFlags -> IO (AtIndex))) => Op (Add ()) MenuItemBase orig impl where
  runOp _ _ menu_item name shortcut cb flags =
    addMenuItem (Right menu_item) name shortcut cb flags addWithFlags' addWithShortcutnameFlags'

instance (Parent a MenuItemBase, impl ~ (AtIndex -> T.Text -> Maybe ShortcutKeySequence -> (Ref a -> IO ()) -> MenuItemFlags -> IO (AtIndex))) => Op (Insert ()) MenuItemBase orig impl where
  runOp _ _ menu_item (AtIndex index') name ks cb flags =
    withRef menu_item $ \menu_itemPtr ->
      let combinedFlags = menuItemFlagsToInt flags
          shortcutCode = maybe 0 (\(ShortcutKeySequence modifiers char) -> keySequenceToCInt modifiers char ) ks
      in do
        ptr <- toCallbackPrim cb
        nameString <- copyTextToCString name
        idx' <- insertWithFlags'
                 menu_itemPtr
                 index'
                 nameString
                 shortcutCode
                 (castFunPtr ptr)
                 combinedFlags
        return (AtIndex idx')

size' :: (Ptr ()) -> IO ((Int))
size' :: Ptr () -> IO Int
size' a1 :: Ptr ()
a1 =
  let {a1' = id a1} in 
  Ptr () -> IO CInt
size''_ Ptr ()
a1' IO CInt -> (CInt -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  let {res' :: Int
res' = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

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

instance (impl ~ ( IO (Int))) => Op (GetSize ()) MenuItemBase orig impl where
  runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> size' menu_itemPtr


-- $hierarchy
-- @
-- "Graphics.UI.FLTK.LowLevel.Base.MenuItem"
-- @

-- $functions
-- @
-- activate :: 'Ref' 'MenuItemBase' -> 'IO' ()
--
-- active :: 'Ref' 'MenuItemBase' -> 'IO' ('Bool')
--
-- activevisible :: 'Ref' 'MenuItemBase' -> 'IO' ('Bool')
--
-- add:: ('Parent' a 'MenuItemBase') => 'Ref' 'MenuItemBase' -> 'T.Text' -> 'Maybe' 'Shortcut' -> 'Maybe' ('Ref' a -> 'IO' ()) -> 'MenuItemFlags' -> 'IO' ('AtIndex')
--
-- checkbox :: 'Ref' 'MenuItemBase' -> 'IO' ('Bool')
--
-- clear :: 'Ref' 'MenuItemBase' -> 'IO' ()
--
-- deactivate :: 'Ref' 'MenuItemBase' -> 'IO' ()
--
-- destroy :: 'Ref' 'MenuItemBase' -> 'IO' ()
--
-- doCallback :: 'Ref' 'MenuItemBase' -> 'Ref' 'Widget' -> 'IO' ()
--
-- draw:: ('Parent' a 'MenuPrim') => 'Ref' 'MenuItemBase' -> 'Rectangle' -> 'Ref' a -> 'IO' ()
--
-- drawWithT:: ('Parent' a 'MenuPrimBase') => 'Ref' 'MenuItemBase' -> 'Rectangle' -> 'Ref' a -> 'Bool' -> 'IO' ()
--
-- findShortcut:: ('Parent' a 'MenuItemBase') => 'Ref' 'MenuItemBase' -> 'Maybe' 'AtIndex' -> 'Bool' -> 'IO' ('Maybe' ('Ref' a))
--
-- getCallback :: 'Ref' 'MenuItemBase' -> 'IO' ('FunPtr' 'CallbackWithUserDataPrim')
--
-- getFirst :: 'Ref' 'MenuItemBase' -> 'IO' ('Maybe' ('Ref' 'MenuItemBase'))
--
-- getFlags :: 'Ref' 'MenuItemBase' -> 'IO' ('Maybe' 'MenuItemFlags')
--
-- getLabel :: 'Ref' 'MenuItemBase' -> 'IO' 'T.Text'
--
-- getLabelcolor :: 'Ref' 'MenuItemBase' -> 'IO' ('Color')
--
-- getLabelfont :: 'Ref' 'MenuItemBase' -> 'IO' ('Font')
--
-- getLabelsize :: 'Ref' 'MenuItemBase' -> 'IO' ('FontSize')
--
-- getLabeltype :: 'Ref' 'MenuItemBase' -> 'IO' ('Labeltype')
--
-- getShortcut :: 'Ref' 'MenuItemBase' -> 'IO' ('Maybe' 'ShortcutKeySequence')
--
-- getSize :: 'Ref' 'MenuItemBase' -> 'IO' ('Int')
--
-- getText :: 'Ref' 'MenuItemBase' -> 'IO' 'T.Text'
--
-- getValue :: 'Ref' 'MenuItemBase' -> 'IO' ('Bool')
--
-- hide :: 'Ref' 'MenuItemBase' -> 'IO' ()
--
-- insert:: ('Parent' a 'MenuItemBase') => 'Ref' 'MenuItemBase' -> 'AtIndex' -> 'T.Text' -> 'Maybe' 'ShortcutKeySequence' -> ('Ref' a -> 'IO' ()) -> 'MenuItemFlags' -> 'IO' ('AtIndex')
--
-- measure:: ('Parent' a 'MenuPrimBase') => 'Ref' 'MenuItemBase' -> 'Ref' a -> 'IO' ('Size')
--
-- next :: 'Ref' 'MenuItemBase' -> 'IO' ('Maybe' ('Ref' 'MenuItemBase'))
--
-- nextWithStep:: ('Parent' a 'MenuItemBase') => 'Ref' 'MenuItemBase' -> 'Int' -> 'IO' ('Maybe' ('Ref' a))
--
-- popup:: ('Parent' a 'MenuItemBase', 'Parent' b 'MenuPrimBase', 'Parent' c 'MenuItemBase') => 'Ref' 'MenuItemBase' -> 'Position' -> 'Maybe' 'T.Text' -> 'Maybe' ('Ref' a) -> 'Maybe' ('Ref' b) -> 'IO' ('Maybe' ('Ref' c))
--
-- pulldown:: ('Parent' a 'MenuPrimBase', 'Parent' b 'MenuItemBase', 'Parent' c 'MenuItemBase') => 'Ref' 'MenuItemBase' -> 'Rectangle' -> 'Maybe' ('Ref' a) -> 'Maybe' ('Ref' b) -> 'Maybe' ('Ref' c) -> 'Maybe' 'Bool' -> 'IO' ('Maybe' ('Ref' 'MenuItemBase'))
--
-- radio :: 'Ref' 'MenuItemBase' -> 'IO' ('Bool')
--
-- set :: 'Ref' 'MenuItemBase' -> 'IO' ()
--
-- setCallback :: 'Ref' 'MenuItemBase' -> ('Ref' orig -> 'IO' ()) -> 'IO' ()
--
-- setFlags :: 'Ref' 'MenuItemBase' -> 'MenuItemFlags' -> 'IO' ()
--
-- setLabel :: 'Ref' 'MenuItemBase' -> 'T.Text' -> 'IO' ()
--
-- setLabelWithLabeltype :: 'Ref' 'MenuItemBase' -> 'Labeltype' -> 'T.Text' -> 'IO' ()
--
-- setLabelcolor :: 'Ref' 'MenuItemBase' -> 'Color' -> 'IO' ()
--
-- setLabelfont :: 'Ref' 'MenuItemBase' -> 'Font' -> 'IO' ()
--
-- setLabelsize :: 'Ref' 'MenuItemBase' -> 'FontSize' -> 'IO' ()
--
-- setLabeltype :: 'Ref' 'MenuItemBase' -> 'Labeltype' -> 'IO' ()
--
-- setShortcut :: 'Ref' 'MenuItemBase' -> 'ShortcutKeySequence' -> 'IO' ()
--
-- setonly :: 'Ref' 'MenuItemBase' -> 'IO' ()
--
-- showWidget :: 'Ref' 'MenuItemBase' -> 'IO' ()
--
-- submenu :: 'Ref' 'MenuItemBase' -> 'IO' ('Bool')
--
-- testShortcut:: ('Parent' a 'MenuItemBase') => 'Ref' 'MenuItemBase' -> 'IO' ('Maybe' ('Ref' a))
--
-- visible :: 'Ref' 'MenuItemBase' -> 'IO' ('Bool')
-- @

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs.h Fl_Menu_Item_New"
  new''_ :: ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs.h Fl_Menu_Item_New_With_Draw"
  newWithDraw''_ :: ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ()))))))))) -> ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))) -> (IO (C2HSImp.Ptr ()))))

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

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs.h Fl_Menu_Item_label"
  label''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs.h Fl_Menu_Item_set_label"
  setLabel''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ())))

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

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

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

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

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

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

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs.h Fl_Menu_Item_set_callback"
  setCallback''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))) -> (IO (C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs.h Fl_Menu_Item_callback"
  getCallback''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ()))))))

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs.h Fl_Menu_Item_text"
  text''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

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

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

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs.h Fl_Menu_Item_insert_with_flags"
  insertWithFlags''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs.h Fl_Menu_Item_add_with_flags"
  addWithFlags''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs.h Fl_Menu_Item_add_with_shortcutname_flags"
  addWithShortcutnameFlags''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))))

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