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


{-# LINE 1 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}
{-# LANGUAGE CPP, RankNTypes, UndecidableInstances, GADTs, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Graphics.UI.FLTK.LowLevel.Base.Widget
    (
     -- * Constructor
     widgetCustom,
     widgetMaker,
     -- * Custom
     CustomWidgetFuncs(..),
     defaultCustomWidgetFuncs,
     fillCustomWidgetFunctionStruct,
     customWidgetFunctionStruct,
     WidgetFlag(..),
     defaultDestroyCallbacks,
     defaultDestroyWidgetCallbacks
  , handleWidgetBase
  , resizeWidgetBase
  , hideWidgetBase
  , showWidgetWidgetBase
     -- * Hierarchy
     --
     -- $hierarchy

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





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

import Graphics.UI.FLTK.LowLevel.Fl_Enumerations
import Graphics.UI.FLTK.LowLevel.Fl_Types
import Graphics.UI.FLTK.LowLevel.Utils
import Graphics.UI.FLTK.LowLevel.Dispatch
import qualified Data.Text as T
import Graphics.UI.FLTK.LowLevel.Hierarchy
import Data.Maybe

data WidgetFlag = WidgetFlagInactive
                | WidgetFlagInvisible
                | WidgetFlagOutput
                | WidgetFlagNoBorder
                | WidgetFlagForcePosition
                | WidgetFlagNonModal
                | WidgetFlagShortcutLabel
                | WidgetFlagChanged
                | WidgetFlagOverride
                | WidgetFlagVisibleFocus
                | WidgetFlagCopiedLabel
                | WidgetFlagClipChildren
                | WidgetFlagMenuWindow
                | WidgetFlagTooltipWindow
                | WidgetFlagModal
                | WidgetFlagNoOverlay
                | WidgetFlagGroupRelative
                | WidgetFlagCopiedTooltip
                | WidgetFlagFullscreen
                | WidgetFlagMacUseAccentsMenu
                | WidgetFlagNeedsKeyboard
                | WidgetFlagUserFlag3
                | WidgetFlagUserFlag2
                | WidgetFlagUserFlag1
  deriving (Show,Eq)
instance Enum WidgetFlag where
  succ WidgetFlagInactive = WidgetFlagInvisible
  succ WidgetFlagInvisible = WidgetFlagOutput
  succ WidgetFlagOutput = WidgetFlagNoBorder
  succ WidgetFlagNoBorder = WidgetFlagForcePosition
  succ WidgetFlagForcePosition = WidgetFlagNonModal
  succ WidgetFlagNonModal = WidgetFlagShortcutLabel
  succ WidgetFlagShortcutLabel = WidgetFlagChanged
  succ WidgetFlagChanged = WidgetFlagOverride
  succ WidgetFlagOverride = WidgetFlagVisibleFocus
  succ WidgetFlagVisibleFocus = WidgetFlagCopiedLabel
  succ WidgetFlagCopiedLabel = WidgetFlagClipChildren
  succ WidgetFlagClipChildren = WidgetFlagMenuWindow
  succ WidgetFlagMenuWindow = WidgetFlagTooltipWindow
  succ WidgetFlagTooltipWindow = WidgetFlagModal
  succ WidgetFlagModal = WidgetFlagNoOverlay
  succ WidgetFlagNoOverlay = WidgetFlagGroupRelative
  succ WidgetFlagGroupRelative = WidgetFlagCopiedTooltip
  succ WidgetFlagCopiedTooltip = WidgetFlagFullscreen
  succ WidgetFlagFullscreen = WidgetFlagMacUseAccentsMenu
  succ WidgetFlagMacUseAccentsMenu = WidgetFlagNeedsKeyboard
  succ WidgetFlagNeedsKeyboard = WidgetFlagUserFlag3
  succ WidgetFlagUserFlag3 = WidgetFlagUserFlag2
  succ WidgetFlagUserFlag2 = WidgetFlagUserFlag1
  succ WidgetFlagUserFlag1 = error "WidgetFlag.succ: WidgetFlagUserFlag1 has no successor"

  pred WidgetFlagInvisible = WidgetFlagInactive
  pred WidgetFlagOutput = WidgetFlagInvisible
  pred WidgetFlagNoBorder = WidgetFlagOutput
  pred WidgetFlagForcePosition = WidgetFlagNoBorder
  pred WidgetFlagNonModal = WidgetFlagForcePosition
  pred WidgetFlagShortcutLabel = WidgetFlagNonModal
  pred WidgetFlagChanged = WidgetFlagShortcutLabel
  pred WidgetFlagOverride = WidgetFlagChanged
  pred WidgetFlagVisibleFocus = WidgetFlagOverride
  pred WidgetFlagCopiedLabel = WidgetFlagVisibleFocus
  pred WidgetFlagClipChildren = WidgetFlagCopiedLabel
  pred WidgetFlagMenuWindow = WidgetFlagClipChildren
  pred WidgetFlagTooltipWindow = WidgetFlagMenuWindow
  pred WidgetFlagModal = WidgetFlagTooltipWindow
  pred WidgetFlagNoOverlay = WidgetFlagModal
  pred WidgetFlagGroupRelative = WidgetFlagNoOverlay
  pred WidgetFlagCopiedTooltip = WidgetFlagGroupRelative
  pred WidgetFlagFullscreen = WidgetFlagCopiedTooltip
  pred WidgetFlagMacUseAccentsMenu = WidgetFlagFullscreen
  pred WidgetFlagNeedsKeyboard = WidgetFlagMacUseAccentsMenu
  pred WidgetFlagUserFlag3 = WidgetFlagNeedsKeyboard
  pred WidgetFlagUserFlag2 = WidgetFlagUserFlag3
  pred WidgetFlagUserFlag1 = WidgetFlagUserFlag2
  pred WidgetFlagInactive = error "WidgetFlag.pred: WidgetFlagInactive has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from WidgetFlagUserFlag1

  fromEnum WidgetFlagInactive = 1
  fromEnum WidgetFlagInvisible = 2
  fromEnum WidgetFlagOutput = 4
  fromEnum WidgetFlagNoBorder = 8
  fromEnum WidgetFlagForcePosition = 16
  fromEnum WidgetFlagNonModal = 32
  fromEnum WidgetFlagShortcutLabel = 64
  fromEnum WidgetFlagChanged = 128
  fromEnum WidgetFlagOverride = 256
  fromEnum WidgetFlagVisibleFocus = 512
  fromEnum WidgetFlagCopiedLabel = 1024
  fromEnum WidgetFlagClipChildren = 2048
  fromEnum WidgetFlagMenuWindow = 4096
  fromEnum WidgetFlagTooltipWindow = 8192
  fromEnum WidgetFlagModal = 16384
  fromEnum WidgetFlagNoOverlay = 32768
  fromEnum WidgetFlagGroupRelative = 65536
  fromEnum WidgetFlagCopiedTooltip = 131072
  fromEnum WidgetFlagFullscreen = 262144
  fromEnum WidgetFlagMacUseAccentsMenu = 524288
  fromEnum WidgetFlagNeedsKeyboard = 1048576
  fromEnum WidgetFlagUserFlag3 = 536870912
  fromEnum WidgetFlagUserFlag2 = 1073741824
  fromEnum WidgetFlagUserFlag1 = 2147483648

  toEnum 1 = WidgetFlagInactive
  toEnum 2 = WidgetFlagInvisible
  toEnum 4 = WidgetFlagOutput
  toEnum 8 = WidgetFlagNoBorder
  toEnum 16 = WidgetFlagForcePosition
  toEnum 32 = WidgetFlagNonModal
  toEnum 64 = WidgetFlagShortcutLabel
  toEnum 128 = WidgetFlagChanged
  toEnum 256 = WidgetFlagOverride
  toEnum 512 = WidgetFlagVisibleFocus
  toEnum 1024 = WidgetFlagCopiedLabel
  toEnum 2048 = WidgetFlagClipChildren
  toEnum 4096 = WidgetFlagMenuWindow
  toEnum 8192 = WidgetFlagTooltipWindow
  toEnum 16384 = WidgetFlagModal
  toEnum 32768 = WidgetFlagNoOverlay
  toEnum 65536 = WidgetFlagGroupRelative
  toEnum 131072 = WidgetFlagCopiedTooltip
  toEnum 262144 = WidgetFlagFullscreen
  toEnum 524288 = WidgetFlagMacUseAccentsMenu
  toEnum 1048576 = WidgetFlagNeedsKeyboard
  toEnum 536870912 = WidgetFlagUserFlag3
  toEnum 1073741824 = WidgetFlagUserFlag2
  toEnum 2147483648 = WidgetFlagUserFlag1
  toEnum unmatched = error ("WidgetFlag.toEnum: Cannot match " ++ show unmatched)

{-# LINE 69 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

allWidgetFlags :: [WidgetFlag]
allWidgetFlags =
  [
    WidgetFlagInactive,
    WidgetFlagInvisible,
    WidgetFlagOutput,
    WidgetFlagNoBorder,
    WidgetFlagForcePosition,
    WidgetFlagNonModal,
    WidgetFlagShortcutLabel,
    WidgetFlagChanged,
    WidgetFlagOverride,
    WidgetFlagVisibleFocus,
    WidgetFlagCopiedLabel,
    WidgetFlagClipChildren,
    WidgetFlagMenuWindow,
    WidgetFlagTooltipWindow,
    WidgetFlagModal,
    WidgetFlagNoOverlay,
    WidgetFlagGroupRelative,
    WidgetFlagCopiedTooltip,
    WidgetFlagFullscreen,
    WidgetFlagMacUseAccentsMenu,
    WidgetFlagNeedsKeyboard,
    WidgetFlagUserFlag3,
    WidgetFlagUserFlag2,
    WidgetFlagUserFlag1
  ]

type RectangleFPrim              = Ptr () -> CInt -> CInt -> CInt -> CInt -> IO ()

foreign import ccall "wrapper"
        mkWidgetEventHandler :: (Ptr () -> CInt -> IO CInt) -> IO (FunPtr (Ptr () -> CInt -> IO CInt))
foreign import ccall "wrapper"
        mkRectanglePtr :: RectangleFPrim -> IO (FunPtr RectangleFPrim)

toRectangleFPrim ::  (Ref a -> Rectangle -> IO ()) ->
                     IO (FunPtr (Ptr () -> CInt -> CInt -> CInt -> CInt -> IO ()))
toRectangleFPrim f = mkRectanglePtr $ \wPtr x_pos y_pos width height ->
  let rectangle = toRectangle (fromIntegral x_pos,
                               fromIntegral y_pos,
                               fromIntegral width,
                               fromIntegral height)
  in do
  fptr <- wrapNonNull wPtr "Null Pointer. toRectangleFPrim"
  f (wrapInRef fptr) rectangle

toEventHandlerPrim :: (Ref a -> Event -> IO (Either UnknownEvent ())) ->
                      IO (FunPtr (Ptr () -> CInt -> IO CInt))
toEventHandlerPrim f = mkWidgetEventHandler $
                       \wPtr eventNumber ->
                            let event = cToEnum (eventNumber :: CInt)
                            in do
                            fptr <- wrapNonNull wPtr "Null Pointer: toEventHandlerPrim"
                            result <- f (wrapInRef fptr) event
                            return (either (\_ -> fromIntegral (0::CInt)) (const (fromIntegral (1::CInt))) result)

-- | Overrideable 'Widget' functions
-- | Do not create this directly. Instead use `defaultWidgetCustomFuncs`
data CustomWidgetFuncs a =
    CustomWidgetFuncs
    {
     -- | See <http://www.fltk.org/doc-1.3/classFl__Widget.html#a9cb17cc092697dfd05a3fab55856d218 Fl_Widget::handle>
    handleCustom :: Maybe (Ref a -> Event -> IO (Either UnknownEvent ()))
     -- | See <http://www.fltk.org/doc-1.3/classFl__Widget.html#aca98267e7a9b94f699ebd27d9f59e8bb Fl_Widget::resize>
    ,resizeCustom :: Maybe (Ref a -> Rectangle -> IO ())
     -- | See <http://www.fltk.org/doc-1.3/classFl__Widget.html#ab572c6fbc922bf3268b72cf9e2939606 Fl_Widget::show>
    ,showCustom   :: Maybe (Ref a -> IO ())
     -- | See <http://www.fltk.org/doc-1.3/classFl__Widget.html#a1fe8405b86da29d147dc3b5841cf181c Fl_Widget::hide>
    ,hideCustom   :: Maybe (Ref a -> IO ())
     -- | Free callbacks created on the Haskell side before a widget is destroyed.
    ,destroyCallbacksCustom :: Maybe (Ref a -> [Maybe (FunPtr (IO ()))] -> IO ())
    }

-- | Fill up a struct with pointers to functions on the Haskell side that will get called instead of the default ones.
--
-- Fill up the 'Widget' part the function pointer struct.
--
-- Only of interest to 'Widget' contributors
fillCustomWidgetFunctionStruct :: forall a. (Parent a WidgetBase) =>
                                  Ptr () ->
                                  Maybe (Ref a -> IO ()) ->
                                  CustomWidgetFuncs a ->
                                  IO ()
fillCustomWidgetFunctionStruct structPtr _draw' (CustomWidgetFuncs _handle' _resize' _show' _hide' _destroyCallbacks') = do
      toCallbackPrim `orNullFunPtr` _draw'       >>= (\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: (C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (IO ()))))}) structPtr
      toEventHandlerPrim `orNullFunPtr` _handle' >>= (\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: (C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))}) structPtr
      toRectangleFPrim `orNullFunPtr` _resize'   >>= (\ptr val -> do {C2HSImp.pokeByteOff ptr 16 (val :: (C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ()))))))))}) structPtr
      toCallbackPrim `orNullFunPtr` _show'       >>= (\ptr val -> do {C2HSImp.pokeByteOff ptr 24 (val :: (C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (IO ()))))}) structPtr
      toCallbackPrim `orNullFunPtr` _hide'       >>= (\ptr val -> do {C2HSImp.pokeByteOff ptr 32 (val :: (C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (IO ()))))}) structPtr
      toDestroyCallbacksPrim `orNullFunPtr` _destroyCallbacks' >>= (\ptr val -> do {C2HSImp.pokeByteOff ptr 64 (val :: (C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))))}) structPtr

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

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


-- | Given a record of functions, return a pointer to a struct with function pointers back to those functions.
--
-- Only of interest to 'Widget' contributors.
customWidgetFunctionStruct :: forall a. (Parent a WidgetBase) =>
                              Maybe (Ref a -> IO ()) ->
                              CustomWidgetFuncs a ->
                              IO (Ptr ())
customWidgetFunctionStruct draw' customWidgetFuncs' = do
  p <- virtualFuncs'
  fillCustomWidgetFunctionStruct p draw' customWidgetFuncs'
  return p

defaultDestroyCallbacks :: Ref a -> [Maybe (FunPtr (IO ()))] -> IO ()
defaultDestroyCallbacks _ = mapM_ freeHaskellFunPtr . catMaybes

defaultDestroyWidgetCallbacks :: (Parent a WidgetBase) => Ref a -> [Maybe (FunPtr (IO ()))] -> IO ()
defaultDestroyWidgetCallbacks = defaultDestroyCallbacks

-- | An empty set of functions to pass to 'widgetCustom'.
defaultCustomWidgetFuncs :: forall a. (Parent a WidgetBase) => CustomWidgetFuncs a
defaultCustomWidgetFuncs =
  CustomWidgetFuncs
    Nothing
    Nothing
    Nothing
    Nothing
    (Just defaultDestroyWidgetCallbacks)


-- | Lots of 'Widget' subclasses have the same constructor parameters. This function consolidates them.
--
-- Only of interest to 'Widget' contributors.
widgetMaker :: forall a. (Parent a WidgetBase) =>
               Rectangle                                                          -- ^ Position and size
               -> Maybe T.Text                                                    -- ^ Title
               -> Maybe (Ref a -> IO ())                                          -- ^ Custom drawing function
               -> Maybe (CustomWidgetFuncs a)                                     -- ^ Custom functions
               -> (Int -> Int -> Int -> Int -> Ptr () -> IO ( Ptr () ))           -- ^ Foreign constructor to call if only custom functions are given
               -> (Int -> Int -> Int -> Int -> CString -> Ptr () -> IO ( Ptr () )) -- ^ Foreign constructor to call if both title and custom functions are given
               -> IO (Ref a)                                                      -- ^ Reference to the widget
widgetMaker rectangle _label' draw' customFuncs' newWithCustomFuncs' newWithCustomFuncsLabel' =
  do
    let (x_pos, y_pos, width, height) = fromRectangle rectangle
    ptr <- customWidgetFunctionStruct draw' (maybe defaultCustomWidgetFuncs id customFuncs')
    widget <- maybe (newWithCustomFuncs' x_pos y_pos width height (castPtr ptr))
                    (\l -> copyTextToCString l >>= \l' -> newWithCustomFuncsLabel' x_pos y_pos width height l' (castPtr ptr))
                    _label'
    ref <- toRef widget
    setFlag (safeCast ref :: Ref WidgetBase) WidgetFlagCopiedLabel
    setFlag (safeCast ref :: Ref WidgetBase) WidgetFlagCopiedTooltip
    return ref

overriddenWidgetNewWithLabel' :: (Int) -> (Int) -> (Int) -> (Int) -> (CString) -> (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
  (flip ($)) a5 $ \a5' ->
  let {a6' = id a6} in
  overriddenWidgetNewWithLabel''_ a1' a2' a3' a4' a5' a6' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 216 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.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 217 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

-- | Widget constructor.
widgetCustom :: Rectangle                   -- ^ The bounds of this widget
                -> Maybe T.Text             -- ^ The widget label
                -> (Ref Widget -> IO ())    -- ^ Custom drawing function
                -> CustomWidgetFuncs Widget -- ^ Other custom functions
                -> IO (Ref Widget)
widgetCustom rectangle label' draw' funcs' = do
  ref <- widgetMaker
           rectangle
           label'
           (Just draw')
           (Just funcs')
           overriddenWidgetNew'
           overriddenWidgetNewWithLabel'
  setFlag ref WidgetFlagCopiedLabel
  setFlag ref WidgetFlagCopiedTooltip
  return ref

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

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

instance (impl ~  IO ()) => Op (Destroy ()) WidgetBase orig impl where
  runOp _ _ win = swapRef win $ \winPtr -> do
    widgetDestroy' winPtr
    return nullPtr

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

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

instance (impl ~  IO (Maybe (Ref GroupBase))) => Op (GetParent ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget widgetParent' >>= toMaybeRef

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

{-# LINE 246 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (Parent a GroupBase, impl ~ (Maybe (Ref a) -> IO ())) => Op (SetParent ()) WidgetBase orig impl where
  runOp _ _ widget group =
      withRef widget
      (\widgetPtr ->
        withMaybeRef group (\groupPtr ->
                        widgetSetParent' widgetPtr groupPtr
                      )
      )
type' :: (Ptr ()) -> IO ((Word8))
type' a1 =
  let {a1' = id a1} in
  type''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 255 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ IO (Word8)) => Op (GetType_ ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> type' widgetPtr
setType' :: (Ptr ()) -> (Word8) -> IO ((()))
setType' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setType''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

instance (impl ~ (Word8 ->  IO ())) => Op (SetType ()) WidgetBase orig impl where
  runOp _ _ widget t = withRef widget $ \widgetPtr -> setType' widgetPtr t
drawLabel' :: (Ptr ()) -> IO ((()))
drawLabel' a1 =
  let {a1' = id a1} in
  drawLabel''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 261 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

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

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

instance (impl ~ (Maybe (Rectangle,Alignments) ->  IO ())) => Op (DrawLabel ()) WidgetBase orig impl where
  runOp _ _ widget Nothing = withRef widget $ \widgetPtr -> drawLabel' widgetPtr
  runOp _ _ widget (Just (rectangle,align_)) = withRef widget $ \widgetPtr -> do
    let (x_pos,y_pos,w_pos,h_pos) = fromRectangle rectangle
    drawLabelWithXywhAlignment' widgetPtr x_pos y_pos w_pos h_pos (alignmentsToInt align_)

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

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

instance (impl ~ IO (X)) => Op (GetX ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> x' widgetPtr >>= return . X
y' :: (Ptr ()) -> IO ((Int))
y' a1 =
  let {a1' = id a1} in
  y''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

instance (impl ~ IO (Y)) => Op (GetY ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> y' widgetPtr >>= return . Y
w' :: (Ptr ()) -> IO ((Int))
w' a1 =
  let {a1' = id a1} in
  w''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

instance (impl ~ IO (Width)) => Op (GetW ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> w' widgetPtr >>= return . Width
h' :: (Ptr ()) -> IO ((Int))
h' a1 =
  let {a1' = id a1} in
  h''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

instance (impl ~ IO (Height)) => Op (GetH ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> h' widgetPtr >>= return . Height
instance (
         Match obj ~ FindOp orig orig (GetX ()),
         Match obj ~ FindOp orig orig (GetY ()),
         Match obj ~ FindOp orig orig (GetW ()),
         Match obj ~ FindOp orig orig (GetH ()),
         Op (GetX ()) obj orig (IO X),
         Op (GetY ()) obj orig (IO Y),
         Op (GetW ()) obj orig (IO Width),
         Op (GetH ()) obj orig (IO Height),
         impl ~ IO Rectangle
         )
         =>
         Op (GetRectangle ()) WidgetBase orig impl where
   runOp _ _ widget = do
     _x <- getX (castTo widget :: Ref orig)
     _y <- getY (castTo widget :: Ref orig)
     _w <- getW (castTo widget :: Ref orig)
     _h <- getH (castTo widget :: Ref orig)
     return (Rectangle (Position _x _y) (Size _w _h))
setAlign' :: (Ptr ()) -> (Int) -> IO ((()))
setAlign' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setAlign''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

instance (impl ~ (Alignments ->  IO ())) => Op (SetAlign ()) WidgetBase orig impl where
  runOp _ _ widget _align = withRef widget $ \widgetPtr -> setAlign' widgetPtr (alignmentsToInt _align)
align' :: (Ptr ()) -> IO ((CUInt))
align' a1 =
  let {a1' = id a1} in
  align''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

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

instance (impl ~ IO Alignments) => Op (GetAlign ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> align' widgetPtr >>= return . intToAlignments . fromIntegral
box' :: (Ptr ()) -> IO ((Boxtype))
box' a1 =
  let {a1' = id a1} in
  box''_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

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

instance (impl ~ IO (Boxtype)) => Op (GetBox ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> box' widgetPtr
setBox' :: (Ptr ()) -> (Boxtype) -> IO ((()))
setBox' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromEnum a2} in
  setBox''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

instance (impl ~ (Boxtype ->  IO ())) => Op (SetBox ()) WidgetBase orig impl where
  runOp _ _ widget new_box = withRef widget $ \widgetPtr -> setBox' widgetPtr new_box
color' :: (Ptr ()) -> IO ((Color))
color' a1 =
  let {a1' = id a1} in
  color''_ a1' >>= \res ->
  let {res' = cToColor res} in
  return (res')

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

instance (impl ~ IO (Color)) => Op (GetColor ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> color' widgetPtr
setColor' :: (Ptr ()) -> (Color) -> IO ((()))
setColor' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromColor a2} in
  setColor''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

instance (impl ~ (Color ->  IO ())) => Op (SetColor ()) WidgetBase orig impl where
  runOp _ _ widget bg = withRef widget $ \widgetPtr -> setColor' widgetPtr bg
setColorWithBgSel' :: (Ptr ()) -> (Color) -> (Color) -> IO ((()))
setColorWithBgSel' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = cFromColor a2} in
  let {a3' = cFromColor a3} in
  setColorWithBgSel''_ a1' a2' a3' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

instance (impl ~ (Color -> Color ->  IO ())) => Op (SetColorWithBgSel ()) WidgetBase orig impl where
  runOp _ _ widget bg a = withRef widget $ \widgetPtr -> setColorWithBgSel' widgetPtr bg a
selectionColor' :: (Ptr ()) -> IO ((Color))
selectionColor' a1 =
  let {a1' = id a1} in
  selectionColor''_ a1' >>= \res ->
  let {res' = cToColor res} in
  return (res')

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

instance (impl ~ IO (Color)) => Op (GetSelectionColor ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> selectionColor' widgetPtr
setSelectionColor' :: (Ptr ()) -> (Color) -> IO ((()))
setSelectionColor' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromColor a2} in
  setSelectionColor''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

instance (impl ~ (Color ->  IO ())) => Op (SetSelectionColor ()) WidgetBase orig impl where
  runOp _ _ widget a = withRef widget $ \widgetPtr -> setSelectionColor' widgetPtr a
label' :: (Ptr ()) -> IO ((CString))
label' a1 =
  let {a1' = id a1} in
  label''_ a1' >>= \res ->
  return res >>= \res' ->
  return (res')

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

instance (impl ~ IO T.Text) => Op (GetLabel ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> label' widgetPtr >>= cStringToText
copyLabel' :: (Ptr ()) -> (CString) -> IO ((()))
copyLabel' a1 a2 =
  let {a1' = id a1} in
  (flip ($)) a2 $ \a2' ->
  copyLabel''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

instance (impl ~ ( T.Text -> IO ())) => Op (SetLabel ()) WidgetBase orig impl where
  runOp _ _ widget text =
     withRef widget $ \widgetPtr -> withCString (T.unpack text) (\sPtr -> copyLabel' widgetPtr sPtr)
labeltype' :: (Ptr ()) -> IO ((Labeltype))
labeltype' a1 =
  let {a1' = id a1} in
  labeltype''_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

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

instance (impl ~ (IO (Labeltype))) => Op (GetLabeltype ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> labeltype' widgetPtr
setLabeltype' :: (Ptr ()) -> (Labeltype) -> IO ((()))
setLabeltype' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromEnum a2} in
  setLabeltype''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

instance (impl ~ ( Labeltype ->  ResolveImageLabelConflict -> IO ())) => Op (SetLabeltype ()) WidgetBase orig impl where
  runOp _ _ widget a resolve = withRef widget $ \widgetPtr -> do
    lt <- getLabeltype widget
    case (lt, resolve) of
      (ImageLabelType, ResolveImageLabelDoNothing) -> return ()
      (ImageLabelType, ResolveImageLabelOverwrite) -> do
         setLabeltype' widgetPtr a
         copyLabel' widgetPtr nullPtr
      (MultiLabelType, ResolveImageLabelDoNothing) -> return ()
      (MultiLabelType, ResolveImageLabelOverwrite) -> do
         setLabeltype' widgetPtr a
         copyLabel' widgetPtr nullPtr
      (_,_) -> setLabeltype' widgetPtr a
labelcolor' :: (Ptr ()) -> IO ((Color))
labelcolor' a1 =
  let {a1' = id a1} in
  labelcolor''_ a1' >>= \res ->
  let {res' = cToColor res} in
  return (res')

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

instance (impl ~ (IO (Color))) => Op (GetLabelcolor ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> labelcolor' widgetPtr
setLabelcolor' :: (Ptr ()) -> (Color) -> IO ((()))
setLabelcolor' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromColor a2} in
  setLabelcolor''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

instance (impl ~ ( Color ->  IO ())) => Op (SetLabelcolor ()) WidgetBase orig impl where
  runOp _ _ widget c = withRef widget $ \widgetPtr -> setLabelcolor' widgetPtr c
labelfont' :: (Ptr ()) -> IO ((Font))
labelfont' a1 =
  let {a1' = id a1} in
  labelfont''_ a1' >>= \res ->
  let {res' = cToFont res} in
  return (res')

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

instance (impl ~ (IO (Font))) => Op (GetLabelfont ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> labelfont' widgetPtr
setLabelfont' :: (Ptr ()) -> (Font) -> IO ((()))
setLabelfont' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromFont a2} in
  setLabelfont''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

instance (impl ~ ( Font ->  IO ())) => Op (SetLabelfont ()) WidgetBase orig impl where
  runOp _ _ widget c = withRef widget $ \widgetPtr -> setLabelfont' widgetPtr c
labelsize' :: (Ptr ()) -> IO ((CInt))
labelsize' a1 =
  let {a1' = id a1} in
  labelsize''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

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

instance (impl ~ (IO (FontSize))) => Op (GetLabelsize ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> labelsize' widgetPtr >>= return . FontSize
setLabelsize' :: (Ptr ()) -> (CInt) -> IO ((()))
setLabelsize' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  setLabelsize''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

instance (impl ~ ( FontSize ->  IO ())) => Op (SetLabelsize ()) WidgetBase orig impl where
  runOp _ _ widget (FontSize pix) = withRef widget $ \widgetPtr -> setLabelsize' widgetPtr pix
image' :: (Ptr ()) -> IO ((Ptr ()))
image' a1 =
  let {a1' = id a1} in
  image''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

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

instance (impl ~ (IO (Maybe (Ref Image)))) => Op (GetImage ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> image' widgetPtr >>= toMaybeRef
setImage' :: (Ptr ()) -> (Ptr ()) -> IO ((()))
setImage' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  setImage''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

instance (Parent a Image, impl ~ (Maybe( Ref a ) ->  IO ())) => Op (SetImage ()) WidgetBase orig impl where
  runOp _ _ widget pix = withRef widget $ \widgetPtr -> withMaybeRef pix $ \pixPtr -> setImage' widgetPtr pixPtr
deimage' :: (Ptr ()) -> IO ((Ptr ()))
deimage' a1 =
  let {a1' = id a1} in
  deimage''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

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

instance (impl ~ (IO (Maybe (Ref Image)))) => Op (GetDeimage ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> deimage' widgetPtr >>= toMaybeRef
setDeimage' :: (Ptr ()) -> (Ptr ()) -> IO ((()))
setDeimage' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  setDeimage''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

instance (Parent a Image, impl ~ (Maybe( Ref a ) ->  IO ())) => Op (SetDeimage ()) WidgetBase orig impl where
  runOp _ _ widget pix = withRef widget $ \widgetPtr -> withMaybeRef pix $ \pixPtr -> setDeimage' widgetPtr pixPtr
tooltip' :: (Ptr ()) -> IO ((CString))
tooltip' a1 =
  let {a1' = id a1} in
  tooltip''_ a1' >>= \res ->
  return res >>= \res' ->
  return (res')

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

instance (impl ~ (IO T.Text)) => Op (GetTooltip ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> tooltip' widgetPtr >>= cStringToText
copyTooltip' :: (Ptr ()) -> (CString) -> IO ((()))
copyTooltip' a1 a2 =
  let {a1' = id a1} in
  (flip ($)) a2 $ \a2' ->
  copyTooltip''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

instance (impl ~ ( T.Text ->  IO ())) => Op (CopyTooltip ()) WidgetBase orig impl where
  runOp _ _ widget text = withRef widget $ \widgetPtr -> withText text (\t -> copyTooltip' widgetPtr t)
setTooltip' :: (Ptr ()) -> (CString) -> IO ((()))
setTooltip' a1 a2 =
  let {a1' = id a1} in
  (flip ($)) a2 $ \a2' ->
  setTooltip''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

instance (impl ~ ( T.Text ->  IO ())) => Op (SetTooltip ()) WidgetBase orig impl where
  runOp _ _ widget text = withRef widget $ \widgetPtr -> withText text (copyTooltip' widgetPtr)
when' :: (Ptr ()) -> IO ((CInt))
when' a1 =
  let {a1' = id a1} in
  when''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

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

instance (impl ~ IO [When]) => Op (GetWhen ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr ->
      when' widgetPtr >>= return . extract allWhen
setWhen' :: (Ptr ()) -> (Word8) -> IO ((()))
setWhen' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  setWhen''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

instance (impl ~ ( [When] ->  IO ())) => Op (SetWhen ()) WidgetBase orig impl where
  runOp _ _ widget i = withRef widget $ \widgetPtr ->
    setWhen' widgetPtr (fromIntegral . combine $ i)
do_callback' :: (Ptr ()) -> IO ((()))
do_callback' a1 =
  let {a1' = id a1} in
  do_callback''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 398 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO ())) => Op (DoCallback ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> do_callback' widgetPtr
visible' :: (Ptr ()) -> IO ((Bool))
visible' a1 =
  let {a1' = id a1} in
  visible''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 401 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO Bool)) => Op (GetVisible ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> visible' widgetPtr
visibleR' :: (Ptr ()) -> IO ((Bool))
visibleR' a1 =
  let {a1' = id a1} in
  visibleR''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 404 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO Bool)) => Op (GetVisibleR ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> visibleR' widgetPtr
setVisible' :: (Ptr ()) -> IO ((()))
setVisible' a1 =
  let {a1' = id a1} in
  setVisible''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 407 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO ())) => Op (SetVisible ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> setVisible' widgetPtr
clearVisible' :: (Ptr ()) -> IO ((()))
clearVisible' a1 =
  let {a1' = id a1} in
  clearVisible''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 410 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO ())) => Op (ClearVisible ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> clearVisible' widgetPtr
active' :: (Ptr ()) -> IO ((Bool))
active' a1 =
  let {a1' = id a1} in
  active''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 413 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO (Bool))) => Op (Active ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> active' widgetPtr
activeR' :: (Ptr ()) -> IO ((Bool))
activeR' a1 =
  let {a1' = id a1} in
  activeR''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 416 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO (Bool))) => Op (ActiveR ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> activeR' widgetPtr
activate' :: (Ptr ()) -> IO ((()))
activate' a1 =
  let {a1' = id a1} in
  activate''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 419 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO ())) => Op (Activate ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> activate' widgetPtr
deactivate' :: (Ptr ()) -> IO ((()))
deactivate' a1 =
  let {a1' = id a1} in
  deactivate''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 422 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO ())) => Op (Deactivate ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> deactivate' widgetPtr
output' :: (Ptr ()) -> IO ((Int))
output' a1 =
  let {a1' = id a1} in
  output''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 425 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO (Bool))) => Op (GetOutput ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> ((==) 0) <$> output' widgetPtr
setOutput' :: (Ptr ()) -> IO ((()))
setOutput' a1 =
  let {a1' = id a1} in
  setOutput''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 428 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO ())) => Op (SetOutput ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> setOutput' widgetPtr
clearOutput' :: (Ptr ()) -> IO ((()))
clearOutput' a1 =
  let {a1' = id a1} in
  clearOutput''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 431 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO ())) => Op (ClearOutput ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> clearOutput' widgetPtr
takesevents' :: (Ptr ()) -> IO ((Bool))
takesevents' a1 =
  let {a1' = id a1} in
  takesevents''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 434 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO (Bool))) => Op (Takesevents ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> takesevents' widgetPtr
setActive' :: (Ptr ()) -> IO ((()))
setActive' a1 =
  let {a1' = id a1} in
  setActive''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 437 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO ())) => Op (SetActive ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> setActive' widgetPtr
clearActive' :: (Ptr ()) -> IO ((()))
clearActive' a1 =
  let {a1' = id a1} in
  clearActive''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 440 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO ())) => Op (ClearActive ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> clearActive' widgetPtr
setChanged' :: (Ptr ()) -> IO ((()))
setChanged' a1 =
  let {a1' = id a1} in
  setChanged''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 443 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO ())) => Op (SetChanged ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> setChanged' widgetPtr
clearChanged' :: (Ptr ()) -> IO ((()))
clearChanged' a1 =
  let {a1' = id a1} in
  clearChanged''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 446 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO ())) => Op (ClearChanged ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> clearChanged' widgetPtr
changed' :: (Ptr ()) -> IO ((Bool))
changed' a1 =
  let {a1' = id a1} in
  changed''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 449 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO (Bool))) => Op (Changed ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> changed' widgetPtr
takeFocus' :: (Ptr ()) -> IO ((Int))
takeFocus' a1 =
  let {a1' = id a1} in
  takeFocus''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 452 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO (Either NoChange ()))) => Op (TakeFocus ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> takeFocus' widgetPtr >>= return . successOrNoChange
setVisibleFocus' :: (Ptr ()) -> IO ((()))
setVisibleFocus' a1 =
  let {a1' = id a1} in
  setVisibleFocus''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 455 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO ())) => Op (SetVisibleFocus ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> setVisibleFocus' widgetPtr
clearVisibleFocus' :: (Ptr ()) -> IO ((()))
clearVisibleFocus' a1 =
  let {a1' = id a1} in
  clearVisibleFocus''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 458 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO ())) => Op (ClearVisibleFocus ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> clearVisibleFocus' widgetPtr
modifyVisibleFocus' :: (Ptr ()) -> (Bool) -> IO ((()))
modifyVisibleFocus' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromBool a2} in
  modifyVisibleFocus''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 461 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ ( Bool ->  IO ())) => Op (ModifyVisibleFocus ()) WidgetBase orig impl where
  runOp _ _ widget v = withRef widget $ \widgetPtr -> modifyVisibleFocus' widgetPtr v
visibleFocus' :: (Ptr ()) -> IO ((Bool))
visibleFocus' a1 =
  let {a1' = id a1} in
  visibleFocus''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 464 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO (Bool))) => Op (GetVisibleFocus ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> visibleFocus' widgetPtr
contains' :: (Ptr ()) -> (Ptr ()) -> IO ((Int))
contains' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  contains''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 467 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (Parent a WidgetBase, impl ~  (Ref a ->  IO Bool)) => Op (Contains ()) WidgetBase orig impl where
  runOp _ _ widget otherWidget = withRef widget $ \widgetPtr -> withRef otherWidget $ \otherWidgetPtr ->
    contains' widgetPtr otherWidgetPtr >>= return . cToBool
inside' :: (Ptr ()) -> (Ptr ()) -> IO ((Int))
inside' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  inside''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 471 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (Parent a WidgetBase, impl ~ (Ref a -> IO (Bool))) => Op (Inside ()) WidgetBase orig impl where
  runOp _ _ widget otherWidget = withRef widget $ \widgetPtr -> withRef otherWidget $ \otherWidgetPtr ->
    inside' widgetPtr otherWidgetPtr >>= return . cToBool
redraw' :: (Ptr ()) -> IO ((()))
redraw' a1 =
  let {a1' = id a1} in
  redraw''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 475 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO ())) => Op (Redraw ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> redraw' widgetPtr
redrawLabel' :: (Ptr ()) -> IO ((()))
redrawLabel' a1 =
  let {a1' = id a1} in
  redrawLabel''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 478 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO ())) => Op (RedrawLabel ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> redrawLabel' widgetPtr
damage' :: (Ptr ()) -> IO ((Word8))
damage' a1 =
  let {a1' = id a1} in
  damage''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 481 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO ([Damage]))) => Op (GetDamage ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> do
    d <- damage' widgetPtr
    return (extract allDamages (fromIntegral d))
clearDamageWithBitmask' :: (Ptr ()) -> (Word8) -> IO ((()))
clearDamageWithBitmask' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  clearDamageWithBitmask''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 486 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ ( [Damage] ->  IO ())) => Op (ClearDamageThenSet ()) WidgetBase orig impl where
  runOp _ _ widget damages = withRef widget $ \widgetPtr -> clearDamageWithBitmask' widgetPtr (fromIntegral (combine damages))
clearDamage' :: (Ptr ()) -> IO ((()))
clearDamage' a1 =
  let {a1' = id a1} in
  clearDamage''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 489 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO ())) => Op (ClearDamage ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> clearDamage' widgetPtr
damageWithText' :: (Ptr ()) -> (Word8) -> IO ((()))
damageWithText' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  damageWithText''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 492 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ ( [Damage] ->  IO ())) => Op (SetDamage ()) WidgetBase orig impl where
  runOp _ _ widget damages = withRef widget $ \widgetPtr -> damageWithText' widgetPtr (fromIntegral (combine damages))
damageInsideWidget' :: (Ptr ()) -> (Word8) -> (Int) -> (Int) -> (Int) -> (Int) -> IO ((()))
damageInsideWidget' a1 a2 a3 a4 a5 a6 =
  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' = fromIntegral a6} in
  damageInsideWidget''_ a1' a2' a3' a4' a5' a6' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 495 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ ( [Damage] -> Rectangle ->  IO ())) => Op (SetDamageInside ()) WidgetBase orig impl where
  runOp _ _ widget damages rectangle = withRef widget $ \widgetPtr -> do
    let (x_pos,y_pos,w_pos,h_pos) = fromRectangle rectangle
    damageInsideWidget' widgetPtr (fromIntegral (combine damages)) x_pos y_pos w_pos h_pos
measureLabel' :: (Ptr ()) -> (Ptr CInt) -> (Ptr CInt) -> IO ()
measureLabel' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = id a3} in
  measureLabel''_ a1' a2' a3' >>
  return ()

{-# LINE 500 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ ( Maybe Width -> IO (Size))) => Op (MeasureLabel ()) WidgetBase orig impl where
  runOp _ _ widget wrap =
    withRef widget
      $ \widgetPtr ->
      alloca $ \widthPtr ->
      alloca $ \heightPtr -> do
        poke widthPtr (maybe 0 (\(Width w) -> fromIntegral w) wrap)
        poke heightPtr 0
        measureLabel' widgetPtr widthPtr heightPtr
        w <- peekIntConv widthPtr
        h <- peekIntConv heightPtr
        return (Size (Width w) (Height h))
window' :: (Ptr ()) -> IO ((Ptr ()))
window' a1 =
  let {a1' = id a1} in
  window''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 513 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO (Maybe (Ref WindowBase)))) => Op (GetWindow ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> window' widgetPtr >>= toMaybeRef
topWindow' :: (Ptr ()) -> IO ((Ptr ()))
topWindow' a1 =
  let {a1' = id a1} in
  topWindow''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 516 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO (Maybe (Ref WindowBase)))) => Op (GetTopWindow ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> (topWindow' widgetPtr) >>= toMaybeRef
topWindowOffset' :: (Ptr ()) -> IO ((Int), (Int))
topWindowOffset' a1 =
  let {a1' = id a1} in
  alloca $ \a2' ->
  alloca $ \a3' ->
  topWindowOffset''_ a1' a2' a3' >>
  peekIntConv  a2'>>= \a2'' ->
  peekIntConv  a3'>>= \a3'' ->
  return (a2'', a3'')

{-# LINE 519 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ ( IO (Position))) => Op (GetTopWindowOffset ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> topWindowOffset' widgetPtr >>= \(x_pos,y_pos) -> return $ Position (X x_pos) (Y y_pos)

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

{-# LINE 523 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO (FunPtr CallbackWithUserDataPrim))) => Op (GetCallback ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> getCallback' widgetPtr

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 527 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ ((Ref orig -> IO ()) -> IO ())) => Op (SetCallback ()) WidgetBase orig impl where
  runOp _ _ widget callback = withRef widget $ \widgetPtr -> do
    ptr <- toCallbackPrimWithUserData callback
    oldCb <- setCallback' widgetPtr ptr
    if (oldCb == nullFunPtr)
    then return ()
    else freeHaskellFunPtr oldCb

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

{-# LINE 536 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO (Bool))) => Op (HasCallback ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> do
    res <- hasCallback' widgetPtr
    return $ if (res == 0) then False else True
widgetDrawBox' :: (Ptr ()) -> IO ((()))
widgetDrawBox' a1 =
  let {a1' = id a1} in
  widgetDrawBox''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 541 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

widgetDrawBoxWithTC' :: (Ptr ()) -> (Boxtype) -> (Color) -> IO ((()))
widgetDrawBoxWithTC' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = cFromEnum a2} in
  let {a3' = cFromColor a3} in
  widgetDrawBoxWithTC''_ a1' a2' a3' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 542 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

widgetDrawBoxWithTXywhC' :: (Ptr ()) -> (Boxtype) -> (Int) -> (Int) -> (Int) -> (Int) -> (Color) -> IO ((()))
widgetDrawBoxWithTXywhC' a1 a2 a3 a4 a5 a6 a7 =
  let {a1' = id a1} in
  let {a2' = cFromEnum a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = fromIntegral a5} in
  let {a6' = fromIntegral a6} in
  let {a7' = cFromColor a7} in
  widgetDrawBoxWithTXywhC''_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 543 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ ( IO ())) => Op (DrawBox ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> widgetDrawBox' widgetPtr
instance (impl ~ ( Boxtype -> Color -> Maybe Rectangle -> IO ())) => Op (DrawBoxWithBoxtype ()) WidgetBase orig impl where
  runOp _ _ widget bx c Nothing =
    withRef widget $ \widgetPtr -> widgetDrawBoxWithTC' widgetPtr bx c
  runOp _ _ widget bx c (Just r) =
              withRef widget $ \widgetPtr -> do
                let (x_pos,y_pos,w_pos,h_pos) = fromRectangle r
                widgetDrawBoxWithTXywhC' widgetPtr bx x_pos y_pos w_pos h_pos c
widgetDrawBackdrop' :: (Ptr ()) -> IO ((()))
widgetDrawBackdrop' a1 =
  let {a1' = id a1} in
  widgetDrawBackdrop''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 553 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ ( IO ())) => Op (DrawBackdrop ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> widgetDrawBackdrop' widgetPtr

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

{-# LINE 557 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

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

{-# LINE 558 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ ( Maybe (Boxtype, Rectangle) -> IO ())) => Op (DrawFocus ()) WidgetBase orig impl where
  runOp _ _ widget Nothing =
                withRef widget $ \ widgetPtr -> widgetDrawFocus' widgetPtr
  runOp _ _ widget (Just (bx, r)) =
                withRef widget $ \widgetPtr -> do
                  let (x_pos,y_pos,w_pos,h_pos) = fromRectangle r
                  widgetDrawFocusWithTXywh' widgetPtr bx x_pos y_pos w_pos h_pos

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

{-# LINE 567 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

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

{-# LINE 568 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

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

{-# LINE 569 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}


instance (impl ~ (WidgetFlag -> IO ())) => Op (SetFlag ()) WidgetBase orig impl where
  runOp _ _ widget flag = withRef widget (\widgetPtr -> setFlag' widgetPtr flag)

instance (impl ~ (WidgetFlag -> IO ())) => Op (ClearFlag ()) WidgetBase orig impl where
  runOp _ _ widget flag = withRef widget (\widgetPtr -> clearFlag' widgetPtr flag)

instance (impl ~ (IO [WidgetFlag])) => Op (Flags ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget (\widgetPtr -> do
                        flagsUInt <- flags' widgetPtr
                        return (extract allWidgetFlags (fromIntegral flagsUInt)))

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 582 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

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

{-# LINE 585 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

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

{-# LINE 590 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

hideWidgetBase ::  Ref WidgetBase -> IO ()
hideWidgetBase widget = withRef widget $ \widgetPtr -> hideSuper' widgetPtr
showSuper' :: (Ptr ()) -> IO ((()))
showSuper' a1 =
  let {a1' = id a1} in
  showSuper''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 593 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

showWidgetWidgetBase ::  Ref WidgetBase -> IO ()
showWidgetWidgetBase widget = withRef widget $ \widgetPtr -> showSuper' widgetPtr

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

{-# LINE 597 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO ())) => Op (Draw ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> draw' widgetPtr

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

{-# LINE 601 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (Event -> IO (Either UnknownEvent ()))) => Op (Handle ()) WidgetBase orig impl where
  runOp _ _ widget event = withRef widget (\p -> widgetHandle' p (fromIntegral . fromEnum $ event)) >>= return  . successOrUnknownEvent

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

{-# LINE 605 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO ())) => Op (ShowWidget ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> show' widgetPtr

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 609 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ ( Rectangle -> IO ())) => Op (Resize ()) WidgetBase orig impl where
  runOp _ _ widget rectangle = withRef widget $ \widgetPtr -> do
    let (x_pos,y_pos,w_pos,h_pos) = fromRectangle rectangle
    resize' widgetPtr x_pos y_pos w_pos h_pos

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

{-# LINE 615 "src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs" #-}

instance (impl ~ (IO ())) => Op (Hide ()) WidgetBase orig impl where
  runOp _ _ widget = withRef widget $ \widgetPtr -> hide' widgetPtr


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

-- $functions
-- @
-- activate :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- active :: 'Ref' 'WidgetBase' -> 'IO' ('Bool')
--
-- activeR :: 'Ref' 'WidgetBase' -> 'IO' ('Bool')
--
-- changed :: 'Ref' 'WidgetBase' -> 'IO' ('Bool')
--
-- clearActive :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- clearChanged :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- clearDamage :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- clearDamageThenSet :: 'Ref' 'WidgetBase' -> ['Damage'] -> 'IO' ()
--
-- clearFlag :: 'Ref' 'WidgetBase' -> 'WidgetFlag' -> 'IO' ()
--
-- clearOutput :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- clearVisible :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- clearVisibleFocus :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- contains:: ('Parent' a 'WidgetBase') => 'Ref' 'WidgetBase' -> 'Ref' a -> 'IO' 'Bool'
--
-- copyTooltip :: 'Ref' 'WidgetBase' -> 'T.Text' -> 'IO' ()
--
-- deactivate :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- destroy :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- doCallback :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- draw :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- drawBackdrop :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- drawBox :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- drawBoxWithBoxtype :: 'Ref' 'WidgetBase' -> 'Boxtype' -> 'Color' -> 'Maybe' 'Rectangle' -> 'IO' ()
--
-- drawFocus :: 'Ref' 'WidgetBase' -> 'Maybe' ('Boxtype', 'Rectangle') -> 'IO' ()
--
-- drawLabel :: 'Ref' 'WidgetBase' -> 'Maybe' ('Rectangle', 'Alignments') -> 'IO' ()
--
-- flags :: 'Ref' 'WidgetBase' -> 'IO' ['WidgetFlag']
--
-- getAlign :: 'Ref' 'WidgetBase' -> 'IO' 'Alignments'
--
-- getBox :: 'Ref' 'WidgetBase' -> 'IO' ('Boxtype')
--
-- getCallback :: 'Ref' 'WidgetBase' -> 'IO' ('FunPtr' 'CallbackWithUserDataPrim')
--
-- getColor :: 'Ref' 'WidgetBase' -> 'IO' ('Color')
--
-- getDamage :: 'Ref' 'WidgetBase' -> 'IO' (['Damage'])
--
-- getDeimage :: 'Ref' 'WidgetBase' -> 'IO' ('Maybe' ('Ref' 'Image'))
--
-- getH :: 'Ref' 'WidgetBase' -> 'IO' ('Height')
--
-- getImage :: 'Ref' 'WidgetBase' -> 'IO' ('Maybe' ('Ref' 'Image'))
--
-- getLabel :: 'Ref' 'WidgetBase' -> 'IO' 'T.Text'
--
-- getLabelcolor :: 'Ref' 'WidgetBase' -> 'IO' ('Color')
--
-- getLabelfont :: 'Ref' 'WidgetBase' -> 'IO' ('Font')
--
-- getLabelsize :: 'Ref' 'WidgetBase' -> 'IO' ('FontSize')
--
-- getLabeltype :: 'Ref' 'WidgetBase' -> 'IO' ('Labeltype')
--
-- getOutput :: 'Ref' 'WidgetBase' -> 'IO' ('Int')
--
-- getParent :: 'Ref' 'WidgetBase' -> 'IO' ('Maybe' ('Ref' 'GroupBase'))
--
-- getRectangle:: ('Match' obj ~ 'FindOp' orig orig ('GetX' ()), 'Match' obj ~ 'FindOp' orig orig ('GetY' ()), 'Match' obj ~ 'FindOp' orig orig ('GetW' ()), 'Match' obj ~ 'FindOp' orig orig ('GetH' ()), 'Op' ('GetX' ()) obj orig ('IO' 'X',) 'Op' ('GetY' ()) obj orig ('IO' 'Y',) 'Op' ('GetW' ()) obj orig ('IO' 'Width',) 'Op' ('GetH' ()) obj orig ('IO' 'Height',)) => 'Ref' 'WidgetBase' -> 'IO' 'Rectangle'
--
-- getSelectionColor :: 'Ref' 'WidgetBase' -> 'IO' ('Color')
--
-- getTooltip :: 'Ref' 'WidgetBase' -> 'IO' 'T.Text'
--
-- getTopWindow :: 'Ref' 'WidgetBase' -> 'IO' ('Maybe' ('Ref' 'WindowBase'))
--
-- getTopWindowOffset :: 'Ref' 'WidgetBase' -> 'IO' ('Position')
--
-- getType_ :: 'Ref' 'WidgetBase' -> 'IO' ('Word8')
--
-- getVisible :: 'Ref' 'WidgetBase' -> 'IO' 'Bool'
--
-- getVisibleFocus :: 'Ref' 'WidgetBase' -> 'IO' ('Bool')
--
-- getVisibleR :: 'Ref' 'WidgetBase' -> 'IO' 'Bool'
--
-- getW :: 'Ref' 'WidgetBase' -> 'IO' ('Width')
--
-- getWhen :: 'Ref' 'WidgetBase' -> 'IO' ['When']
--
-- getWindow :: 'Ref' 'WidgetBase' -> 'IO' ('Maybe' ('Ref' 'WindowBase'))
--
-- getX :: 'Ref' 'WidgetBase' -> 'IO' ('X')
--
-- getY :: 'Ref' 'WidgetBase' -> 'IO' ('Y')
--
-- handle :: 'Ref' 'WidgetBase' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ())
--
-- hasCallback :: 'Ref' 'WidgetBase' -> 'IO' ('Bool')
--
-- hide :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- inside:: ('Parent' a 'WidgetBase') => 'Ref' 'WidgetBase' -> 'Ref' a -> 'IO' ('Bool')
--
-- measureLabel :: 'Ref' 'WidgetBase' -> 'Maybe' 'Width' -> 'IO' ('Size')
--
-- modifyVisibleFocus :: 'Ref' 'WidgetBase' -> 'Bool' -> 'IO' ()
--
-- redraw :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- redrawLabel :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- resize :: 'Ref' 'WidgetBase' -> 'Rectangle' -> 'IO' ()
--
-- setActive :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- setAlign :: 'Ref' 'WidgetBase' -> 'Alignments' -> 'IO' ()
--
-- setBox :: 'Ref' 'WidgetBase' -> 'Boxtype' -> 'IO' ()
--
-- setCallback :: 'Ref' 'WidgetBase' -> ('Ref' orig -> 'IO' ()) -> 'IO' ()
--
-- setChanged :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- setColor :: 'Ref' 'WidgetBase' -> 'Color' -> 'IO' ()
--
-- setColorWithBgSel :: 'Ref' 'WidgetBase' -> 'Color' -> 'Color' -> 'IO' ()
--
-- setDamage :: 'Ref' 'WidgetBase' -> ['Damage'] -> 'IO' ()
--
-- setDamageInside :: 'Ref' 'WidgetBase' -> ['Damage'] -> 'Rectangle' -> 'IO' ()
--
-- setDeimage:: ('Parent' a 'Image') => 'Ref' 'WidgetBase' -> 'Maybe'( 'Ref' a ) -> 'IO' ()
--
-- setFlag :: 'Ref' 'WidgetBase' -> 'WidgetFlag' -> 'IO' ()
--
-- setImage:: ('Parent' a 'Image') => 'Ref' 'WidgetBase' -> 'Maybe'( 'Ref' a ) -> 'IO' ()
--
-- setLabel :: 'Ref' 'WidgetBase' -> 'T.Text' -> 'IO' ()
--
-- setLabelcolor :: 'Ref' 'WidgetBase' -> 'Color' -> 'IO' ()
--
-- setLabelfont :: 'Ref' 'WidgetBase' -> 'Font' -> 'IO' ()
--
-- setLabelsize :: 'Ref' 'WidgetBase' -> 'FontSize' -> 'IO' ()
--
-- setLabeltype :: 'Ref' 'WidgetBase' -> 'Labeltype' -> 'ResolveImageLabelConflict' -> 'IO' ()
--
-- setOutput :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- setParent:: ('Parent' a 'GroupBase') => 'Ref' 'WidgetBase' -> 'Maybe' ('Ref' a) -> 'IO' ()
--
-- setSelectionColor :: 'Ref' 'WidgetBase' -> 'Color' -> 'IO' ()
--
-- setTooltip :: 'Ref' 'WidgetBase' -> 'T.Text' -> 'IO' ()
--
-- setType :: 'Ref' 'WidgetBase' -> 'Word8' -> 'IO' ()
--
-- setVisible :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- setVisibleFocus :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- setWhen :: 'Ref' 'WidgetBase' -> ['When'] -> 'IO' ()
--
-- showWidget :: 'Ref' 'WidgetBase' -> 'IO' ()
--
-- takeFocus :: 'Ref' 'WidgetBase' -> 'IO' ('Either' 'NoChange' ())
--
-- takesevents :: 'Ref' 'WidgetBase' -> 'IO' ('Bool')
-- @

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Widget.chs.h Fl_OverriddenWidget_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/Base/Widget.chs.h Fl_OverriddenWidget_New"
  overriddenWidgetNew''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))))))

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Widget.chs.h Fl_Widget_type"
  type''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CUChar))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Widget.chs.h Fl_Widget_set_type"
  setType''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CUChar -> (IO ())))

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Widget.chs.h Fl_Widget_draw_label_with_xywh_alignment"
  drawLabelWithXywhAlignment''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CUInt -> (IO ())))))))

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Widget.chs.h Fl_Widget_set_when"
  setWhen''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CUChar -> (IO ())))

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Widget.chs.h Fl_Widget_damage"
  damage''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CUChar))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Widget.chs.h Fl_Widget_clear_damage_with_bitmask"
  clearDamageWithBitmask''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CUChar -> (IO ())))

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Widget.chs.h Fl_Widget_damage_with_text"
  damageWithText''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CUChar -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Widget.chs.h Fl_Widget_damage_inside_widget"
  damageInsideWidget''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CUChar -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))))))

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

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

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Widget.chs.h Fl_Widget_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/Widget.chs.h Fl_Widget_has_callback"
  hasCallback''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Widget.chs.h Fl_Widget_draw_box_with_tc"
  widgetDrawBoxWithTC''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CUInt -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Widget.chs.h Fl_Widget_draw_box_with_txywhc"
  widgetDrawBoxWithTXywhC''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CUInt -> (IO ()))))))))

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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