-- 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/FL.chs" #-}
{-# LANGUAGE CPP, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, ScopedTypeVariables #-}

module Graphics.UI.FLTK.LowLevel.FL
    (
     Option(..),
     ClipboardContents(..),
     scrollbarSize,
     setScrollbarSize,
     selectionOwner,
     setSelectionOwner,
     run,
     replRun,
     check,
     ready,
     option,
     setOption,
     lock,
     unlock,
     awake,
     awakeToHandler,
     addAwakeHandler_,
     getAwakeHandler_,
     display,
     ownColormap,
     getSystemColors,
     foreground,
     background,
     background2,
     setScheme,
     getScheme,
     reloadScheme,
     isScheme,
     setFirstWindow,
     nextWindow,
     setGrab,
     getMouse,
     eventStates,
     extract,
     extractEventStates,
     handle,
     handle_,
     belowmouse,
     setBelowmouse,
     setPushed,
     setFocus,
     setHandler,
     toRectangle,
     fromRectangle,
     screenBounds,
     screenDPI,
     screenWorkArea,
     setColorRgb,
     toAttribute,
     release,
     setVisibleFocus,
     visibleFocus,
     setDndTextOps,
     dndTextOps,
     deleteWidget,
     doWidgetDeletion,
     watchWidgetPointer,
     releaseWidgetPointer,
     clearWidgetPointer,
     version,
     help,
     visual,
     glVisual,
     glVisualWithAlist,
     wait,
     setWait,
     waitFor,
     readqueue,
     addTimeout,
     repeatTimeout,
     hasTimeout,
     removeTimeout,
     addCheck,
     hasCheck,
     removeCheck,
     addIdle,
     hasIdle,
     removeIdle,
     damage,
     redraw,
     flush,
     firstWindow,
     modal,
     grab,
     getKey,
     compose,
     composeReset,
     testShortcut,
     enableIm,
     disableIm,
     pushed,
     focus,
     copyToClipboard,
     copyToSelectionBuffer,
     copyLengthToClipboard,
     copyLengthToSelectionBuffer,
     pasteImageFromSelectionBuffer,
     pasteFromSelectionBuffer,
     pasteImageFromClipboard,
     pasteFromClipboard,
     dnd,
     x,
     y,
     w,
     h,
     screenCount,
     setColor,
     getColor,
     getColorRgb,
     removeFromColormap,
     -- * Box
     BoxtypeSpec(..),
     getBoxtype,
     setBoxtype,
     boxDx,
     boxDy,
     boxDw,
     boxDh,
     adjustBoundsByBoxtype,
     boxDifferences,
     drawBoxActive,
     -- * Fonts
     getFontName,
     getFont,
     getFontSizes,
     setFontToString,
     setFontToFont,
     setFonts,
     -- * File Descriptor Callbacks
     addFd,
     addFdWhen,
     removeFd,
     removeFdWhen,
     -- * Events
     event,
     eventShift,
     eventCtrl,
     eventCommand,
     eventAlt,
     eventButtons,
     eventButton1,
     eventButton2,
     eventButton3,
     eventX,
     eventY,
     eventPosition,
     eventXRoot,
     eventYRoot,
     eventRootPosition,
     eventDx,
     eventDy,
     eventClicks,
     setEventClicks,
     eventIsClick,
     setEventIsClick,
     eventButton,
     eventState,
     containsEventState,
     eventKey,
     eventOriginalKey,
     eventKeyPressed,
     eventInsideRegion,
     eventInsideWidget,
     eventDispatch,
     setEventDispatch,
     eventText,
     eventLength,
     eventClipboardContents,
     setBoxColor,
     boxColor,
     abiVersion,
     apiVersion,
     abiCheck,
     localCtrl,
     localMeta,
     localAlt,
     localShift
     , useHighResGL
     , setUseHighResGL
     , insertionPointLocation
     , resetMarkedText
     , runChecks
     , screenDriver
     , systemDriver
     , screenXYWH
     , setProgramShouldQuit
     , getProgramShouldQuit
    )
where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified System.IO.Unsafe as C2HSImp



import C2HS hiding (cFromEnum, cToBool,cToEnum,cFromBool)
import Data.IORef

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 hiding (
                                                   setVisibleFocus,
                                                   handle,
                                                   redraw,
                                                   flush,
                                                   testShortcut,
                                                   copy,
                                                   setColor,
                                                   getColor,
                                                   focus,
                                                   display,
                                                   setScrollbarSize
                                                  )
import Graphics.UI.FLTK.LowLevel.Dispatch
import qualified Data.Text as T
import qualified Data.Text.Foreign as TF
import qualified System.IO.Unsafe as Unsafe (unsafePerformIO)
import Control.Exception(catch, throw, AsyncException(UserInterrupt))
import Control.Monad(forever)
data Option = OptionArrowFocus
            | OptionVisibleFocus
            | OptionDndText
            | OptionShowTooltips
            | OptionLast
  deriving (Show)
instance Enum Option where
  succ OptionArrowFocus = OptionVisibleFocus
  succ OptionVisibleFocus = OptionDndText
  succ OptionDndText = OptionShowTooltips
  succ OptionShowTooltips = OptionLast
  succ OptionLast = error "Option.succ: OptionLast has no successor"

  pred OptionVisibleFocus = OptionArrowFocus
  pred OptionDndText = OptionVisibleFocus
  pred OptionShowTooltips = OptionDndText
  pred OptionLast = OptionShowTooltips
  pred OptionArrowFocus = error "Option.pred: OptionArrowFocus 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 OptionLast

  fromEnum OptionArrowFocus = 0
  fromEnum OptionVisibleFocus = 1
  fromEnum OptionDndText = 2
  fromEnum OptionShowTooltips = 3
  fromEnum OptionLast = 4

  toEnum 0 = OptionArrowFocus
  toEnum 1 = OptionVisibleFocus
  toEnum 2 = OptionDndText
  toEnum 3 = OptionShowTooltips
  toEnum 4 = OptionLast
  toEnum unmatched = error ("Option.toEnum: Cannot match " ++ show unmatched)

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


ptrToGlobalEventHandler :: IORef (FunPtr GlobalEventHandlerPrim)
ptrToGlobalEventHandler = Unsafe.unsafePerformIO $ do
                            initialHandler <- toGlobalEventHandlerPrim (\_ -> return (-1))
                            newIORef initialHandler

-- | Contents of the clipboard following a copy or cut. Can be either an <./Graphics-UI-FLTK-LowLevel-Image.html Image> or plain 'T.Text'.
data ClipboardContents =
  ClipboardContentsImage (Maybe (Ref Image))
  | ClipboardContentsPlainText (Maybe T.Text)

type EventDispatchPrim = (CInt ->
                          Ptr () ->
                          IO CInt)
foreign import ccall "wrapper"
        wrapEventDispatchPrim :: EventDispatchPrim ->
                                 IO (FunPtr EventDispatchPrim)
foreign import ccall "dynamic"
        unwrapEventDispatchPrim :: FunPtr EventDispatchPrim -> EventDispatchPrim

run :: IO Int
run = fl_run >>= return . fromIntegral

check :: IO Int
check = fl_check >>= return . fromIntegral

ready :: IO Int
ready = fl_ready >>= return . fromIntegral


option :: Option -> IO Bool
option o = fl_option (cFromEnum o) >>= \(c::CInt) -> return $ cToBool $ ((fromIntegral c) :: Int)

setOption :: Option -> Bool -> IO ()
setOption o t = fl_set_option (cFromEnum o) (Graphics.UI.FLTK.LowLevel.Utils.cFromBool t)

lock :: IO Bool
lock = fl_lock >>= return . cToBool

unlock :: IO ()
unlock = fl_unlock
{-# LINE 276 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}


awake :: IO ()
awake = fl_awake
{-# LINE 279 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}


awakeToHandler :: IO ()
awakeToHandler = fl_awake_to_handler
{-# LINE 282 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}


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

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

addAwakeHandler_ :: GlobalCallback -> IO (Either AwakeRingFull ())
addAwakeHandler_ awakeHandler =
    do
      callbackPtr <-  toGlobalCallbackPrim awakeHandler
      res <- addAwakeHandler' callbackPtr nullPtr
      return (successOrAwakeRingFull res)

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

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

getAwakeHandler_ :: IO GlobalCallback
getAwakeHandler_ =
    alloca $ \ptrToFunPtr ->
        alloca $ \ptrToUD -> do
          _ <- getAwakeHandler_' ptrToFunPtr ptrToUD
          funPtr <- peek ptrToFunPtr
          return $ unwrapGlobalCallbackPtr $ castFunPtr funPtr

version :: IO ((Double))
version =
  version'_ >>= \res ->
  let {res' = realToFrac res} in
  return (res')

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

help' :: IO ((CString))
help' =
  help''_ >>= \res ->
  return res >>= \res' ->
  return (res')

{-# LINE 305 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

help :: IO T.Text
help = help' >>= cStringToText

display :: T.Text -> IO ()
display text = TF.withCStringLen text $ \(str,_) -> fl_display str
visual :: (Mode) -> IO ((Bool))
visual a1 =
  let {a1' = cFromEnum a1} in
  visual'_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 313 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

-- | Only available if on a non OSX platform and if the 'opengl' flag is set (stack build --flag fltkhs:opengl).
glVisual :: (Mode) -> IO ((Bool))
glVisual a1 =
  let {a1' = cFromEnum a1} in
  glVisual'_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

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

-- | Only available if on a non OSX platform and if the 'opengl' flag is set (stack build --flag fltkhs:opengl).
glVisualWithAlist :: (Mode) -> (Ptr CInt) -> IO ((Bool))
glVisualWithAlist a1 a2 =
  let {a1' = cFromEnum a1} in
  let {a2' = id a2} in
  glVisualWithAlist'_ a1' a2' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 320 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}


ownColormap :: IO ()
ownColormap = fl_own_colormap
{-# LINE 323 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}


getSystemColors :: IO ()
getSystemColors = fl_get_system_colors
{-# LINE 326 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}


foreground :: RGB -> IO ()
foreground (r,g,b) = fl_foreground
{-# LINE 329 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

                    (fromIntegral r)
                    (fromIntegral g)
                    (fromIntegral b)
background :: RGB -> IO ()
background (r,g,b) = fl_background
{-# LINE 334 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

                    (fromIntegral r)
                    (fromIntegral g)
                    (fromIntegral b)
background2 :: RGB -> IO ()
background2 (r,g,b) = fl_background2
{-# LINE 339 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

                    (fromIntegral r)
                    (fromIntegral g)
                    (fromIntegral b)

getScheme' :: (CString)
getScheme' =
  C2HSImp.unsafePerformIO $
  getScheme''_ >>= \res ->
  return res >>= \res' ->
  return (res')

{-# LINE 344 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

getScheme :: IO T.Text
getScheme = cStringToText getScheme'

setScheme :: T.Text -> IO Int
setScheme sch = TF.withCStringLen sch $ \(str,_) -> fl_set_scheme str >>= return . fromIntegral
reloadScheme :: (Int)
reloadScheme =
  C2HSImp.unsafePerformIO $
  reloadScheme'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 350 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

isScheme :: T.Text -> IO Bool
isScheme sch = TF.withCStringLen sch $ \(str,_) -> fl_is_scheme str >>= return . toBool
wait :: IO ((Int))
wait =
  wait'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

waitFor :: (Double) -> IO ((Double))
waitFor a1 =
  let {a1' = realToFrac a1} in
  waitFor'_ a1' >>= \res ->
  let {res' = realToFrac res} in
  return (res')

{-# LINE 356 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}


setWait :: Double -> IO Double
setWait = waitFor
scrollbarSize :: IO ((Int))
scrollbarSize =
  scrollbarSize'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 361 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

setScrollbarSize :: (Int) -> IO ()
setScrollbarSize a1 =
  let {a1' = fromIntegral a1} in
  setScrollbarSize'_ a1' >>
  return ()

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


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

{-# LINE 365 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

readqueue :: IO (Maybe (Ref Widget))
readqueue = readqueue' >>= toMaybeRef
addTimeout' :: (Double) -> (FunPtr CallbackPrim) -> IO ((()))
addTimeout' a1 a2 =
  let {a1' = realToFrac a1} in
  let {a2' = id a2} in
  addTimeout''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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


-- | Returns a function pointer so it can be freed with `freeHaskellFunPtr`, please don't invoke it.
addTimeout :: Double -> GlobalCallback -> IO (FunPtr CallbackPrim)
addTimeout t cb = do
  fp <- toGlobalCallbackPrim cb
  addTimeout' t fp
  return fp

repeatTimeout' :: (Double) -> (FunPtr CallbackPrim) -> IO ((()))
repeatTimeout' a1 a2 =
  let {a1' = realToFrac a1} in
  let {a2' = id a2} in
  repeatTimeout''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

-- | Returns a function pointer so it can be freed with `freeHaskellFunPtr`, please don't invoke it.
repeatTimeout :: Double -> GlobalCallback -> IO (FunPtr CallbackPrim)
repeatTimeout t cb = do
  fp <- toGlobalCallbackPrim cb
  repeatTimeout' t fp
  return fp

hasTimeout :: (FunPtr CallbackPrim) -> IO ((Bool))
hasTimeout a1 =
  let {a1' = id a1} in
  hasTimeout'_ a1' >>= \res ->
  let {res' = toBool res} in
  return (res')

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


removeTimeout :: (FunPtr CallbackPrim) -> IO ((()))
removeTimeout a1 =
  let {a1' = id a1} in
  removeTimeout'_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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


addCheck' :: (FunPtr CallbackPrim) -> IO ((()))
addCheck' a1 =
  let {a1' = id a1} in
  addCheck''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

-- | Returns a function pointer so it can be freed with `freeHaskellFunPtr`, please don't invoke it.
addCheck :: GlobalCallback -> IO (FunPtr CallbackPrim)
addCheck cb = do
  fp <- toGlobalCallbackPrim cb
  addCheck' fp
  return fp

hasCheck :: (FunPtr CallbackPrim) -> IO ((Bool))
hasCheck a1 =
  let {a1' = id a1} in
  hasCheck'_ a1' >>= \res ->
  let {res' = toBool res} in
  return (res')

{-# LINE 403 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

removeCheck :: (FunPtr CallbackPrim) -> IO ((()))
removeCheck a1 =
  let {a1' = id a1} in
  removeCheck'_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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


addIdle' :: (FunPtr CallbackPrim) -> IO ((()))
addIdle' a1 =
  let {a1' = id a1} in
  addIdle''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

-- | Returns a function pointer so it can be freed with `freeHaskellFunPtr`, please don't invoke it.
addIdle :: GlobalCallback -> IO (FunPtr CallbackPrim)
addIdle cb = do
  fp <- toGlobalCallbackPrim cb
  addIdle' fp
  return fp

hasIdle :: (FunPtr CallbackPrim) -> IO ((Bool))
hasIdle a1 =
  let {a1' = id a1} in
  hasIdle'_ a1' >>= \res ->
  let {res' = toBool res} in
  return (res')

{-# LINE 417 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}


removeIdle :: (FunPtr CallbackPrim) -> IO ((()))
removeIdle a1 =
  let {a1' = id a1} in
  removeIdle'_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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


damage :: IO ((Int))
damage =
  damage'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

redraw :: IO ((()))
redraw =
  redraw'_ >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

flush :: IO ((()))
flush =
  flush'_ >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 427 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

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

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

firstWindow :: IO (Maybe (Ref Window))
firstWindow = firstWindow' >>= toMaybeRef

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

{-# LINE 433 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

setFirstWindow :: (Parent a WindowBase) => Ref a -> IO ()
setFirstWindow wp =
    withRef wp setFirstWindow'
nextWindow' :: (Ptr ()) -> IO ((Ptr ()))
nextWindow' a1 =
  let {a1' = id a1} in
  nextWindow''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

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

nextWindow :: Ref a -> IO (Maybe (Ref Window))
nextWindow currWindow = withRef currWindow (\ptr -> nextWindow' ptr >>= toMaybeRef)

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

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

modal  :: IO (Maybe (Ref Widget))
modal = modal' >>= toMaybeRef

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

{-# LINE 445 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

grab  :: IO (Maybe (Ref Widget))
grab = grab' >>= toMaybeRef

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

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

setGrab :: (Parent a WindowBase) => Ref a -> IO ()
setGrab wp = withRef wp setGrab'
event :: IO ((Event))
event =
  event'_ >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 454 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

eventX' :: IO ((Int))
eventX' =
  eventX''_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

eventX :: IO X
eventX = eventX' >>= return . X
eventY' :: IO ((Int))
eventY' =
  eventY''_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 460 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

eventY :: IO Y
eventY = eventY' >>= return . Y
eventXRoot' :: IO ((Int))
eventXRoot' =
  eventXRoot''_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

eventPosition :: IO Position
eventPosition = do
  x' <- eventX
  y' <- eventY
  return (Position x' y')

eventXRoot :: IO X
eventXRoot = eventXRoot' >>= return . X
eventYRoot' :: IO ((Int))
eventYRoot' =
  eventYRoot''_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

eventYRoot :: IO Y
eventYRoot = eventYRoot' >>= return . Y

eventRootPosition :: IO Position
eventRootPosition = do
  x' <- eventXRoot
  y' <- eventYRoot
  return (Position x' y')
eventDx :: IO ((Int))
eventDx =
  eventDx'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

eventDy :: IO ((Int))
eventDy =
  eventDy'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

getMouse' :: IO ((Int), (Int))
getMouse' =
  alloca $ \a1' ->
  alloca $ \a2' ->
  getMouse''_ a1' a2' >>
  peekIntConv  a1'>>= \a1'' ->
  peekIntConv  a2'>>= \a2'' ->
  return (a1'', a2'')

{-# LINE 491 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

getMouse :: IO Position
getMouse = do
  (x_pos,y_pos) <- getMouse'
  return $ (Position (X x_pos) (Y y_pos))
eventClicks :: IO ((Int))
eventClicks =
  eventClicks'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 497 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

setEventClicks :: (Int) -> IO ((()))
setEventClicks a1 =
  let {a1' = fromIntegral a1} in
  setEventClicks'_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

eventIsClick :: IO ((Bool))
eventIsClick =
  eventIsClick'_ >>= \res ->
  let {res' = toBool res} in
  return (res')

{-# LINE 501 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

setEventIsClick :: (Int) -> IO ((()))
setEventIsClick a1 =
  let {a1' = fromIntegral a1} in
  setEventIsClick'_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 503 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}


eventButton' :: IO ((Int))
eventButton' =
  eventButton''_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 506 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

eventButton :: IO (Maybe MouseButton)
eventButton = do
  mb <- eventButton'
  case mb of
    mb' | mb' == (fromEnum Mouse_Left) -> return (Just Mouse_Left)
    mb' | mb' == (fromEnum Mouse_Middle) -> return (Just Mouse_Right)
    mb' | mb' == (fromEnum Mouse_Right) -> return (Just Mouse_Middle)
    _ -> return Nothing

eventStates :: [EventState]
eventStates = [
               Kb_ShiftState,
               Kb_CapsLockState,
               Kb_CtrlState,
               Kb_AltState,
               Kb_NumLockState,
               Kb_MetaState,
               Kb_ScrollLockState,
               Mouse_Button1State,
               Mouse_Button2State,
               Mouse_Button3State
              ]
extractEventStates :: CInt -> [EventState]
extractEventStates = extract eventStates

eventState :: IO (([EventState]))
eventState =
  eventState'_ >>= \res ->
  let {res' = extractEventStates res} in
  return (res')

{-# LINE 533 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

containsEventState :: (EventState) -> IO ((Bool))
containsEventState a1 =
  let {a1' = cFromEnum a1} in
  containsEventState'_ a1' >>= \res ->
  let {res' = toBool res} in
  return (res')

{-# LINE 535 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

eventKey :: IO ((KeyType))
eventKey =
  eventKey'_ >>= \res ->
  let {res' = cToKeyType res} in
  return (res')

{-# LINE 537 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

eventOriginalKey :: IO ((KeyType))
eventOriginalKey =
  eventOriginalKey'_ >>= \res ->
  let {res' = cToKeyType res} in
  return (res')

{-# LINE 539 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

eventKeyPressed :: (KeyType) -> IO ((Bool))
eventKeyPressed a1 =
  let {a1' = cFromKeyType a1} in
  eventKeyPressed'_ a1' >>= \res ->
  let {res' = toBool res} in
  return (res')

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

getKey :: (KeyType) -> IO ((Bool))
getKey a1 =
  let {a1' = cFromKeyType a1} in
  getKey'_ a1' >>= \res ->
  let {res' = toBool res} in
  return (res')

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

eventText' :: IO ((CString))
eventText' =
  eventText''_ >>= \res ->
  return res >>= \res' ->
  return (res')

{-# LINE 544 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

eventText :: IO T.Text
eventText = eventText' >>= cStringToText
eventLength :: IO ((Int))
eventLength =
  eventLength'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 548 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}


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

{-# LINE 550 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

flEventClipboardType' :: IO ((CString))
flEventClipboardType' =
  flEventClipboardType''_ >>= \res ->
  return res >>= \res' ->
  return (res')

{-# LINE 551 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

eventClipboardContents :: IO (Maybe ClipboardContents)
eventClipboardContents = do
  typeString <- flEventClipboardType' >>= cStringToText
  if (T.length typeString == 0)
  then return Nothing
  else case typeString of
         s | (T.unpack s == "Fl::clipboard_image") -> do
             stringContents <- flEventClipboard' >>= cStringToText . castPtr
             return (if (T.length stringContents == 0)
                     then (Just (ClipboardContentsPlainText Nothing))
                     else (Just (ClipboardContentsPlainText (Just stringContents))))
         s | (T.unpack s == "Fl::clipboard_plain_text") -> do
             imageRef <- flEventClipboard' >>= toMaybeRef
             return (Just (ClipboardContentsImage imageRef))
         _ -> error "eventClipboardContents :: The type of the clipboard contents must be either the string \"Fl::clipboard_image\" or \"Fl::clipboard_plain_image\"."

compose :: IO ((Bool), (Int))
compose =
  alloca $ \a1' ->
  compose'_ a1' >>= \res ->
  let {res' = toBool res} in
  peekIntConv  a1'>>= \a1'' ->
  return (res', a1'')

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

composeReset :: IO ((()))
composeReset =
  composeReset'_ >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 571 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

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

{-# LINE 573 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

eventInsideRegion :: Rectangle -> IO Event
eventInsideRegion (Rectangle
                   (Position
                    (X x_pos)
                    (Y y_pos))
                   (Size
                    (Width width)
                    (Height height))) =
    do
      eventNum <- eventInsideRegion' x_pos y_pos width height
      return $ toEnum eventNum
eventInsideWidget' :: (Ptr ()) -> IO ((Int))
eventInsideWidget' a1 =
  let {a1' = id a1} in
  eventInsideWidget''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 586 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

eventInsideWidget :: (Parent a WidgetBase) => Ref a -> IO Event
eventInsideWidget wp =
    withRef wp  (\ptr -> do
                      eventNum <- eventInsideWidget' (castPtr ptr)
                      return $ toEnum eventNum)
testShortcut :: (FlShortcut) -> IO ((Bool))
testShortcut a1 =
  let {a1' = id a1} in
  testShortcut'_ a1' >>= \res ->
  let {res' = toBool res} in
  return (res')

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

enableIm :: IO ((()))
enableIm =
  enableIm'_ >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 595 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

disableIm :: IO ((()))
disableIm =
  disableIm'_ >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

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

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

{-# LINE 599 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

handle :: (Parent a WindowBase) =>  Event -> Ref a -> IO (Either UnknownEvent ())
handle e wp =
    withRef wp (handle' (cFromEnum e)) >>= return . successOrUnknownEvent
handle_' :: (Int) -> (Ptr ()) -> IO ((Int))
handle_' a1 a2 =
  let {a1' = fromIntegral a1} in
  let {a2' = id a2} in
  handle_''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 604 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

handle_ :: (Parent a WindowBase) =>  Event -> Ref a -> IO (Either UnknownEvent ())
handle_ e wp =
    withRef wp (handle_' (cFromEnum e)) >>= return . successOrUnknownEvent
belowmouse' :: IO ((Ptr ()))
belowmouse' =
  belowmouse''_ >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 608 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

belowmouse  :: IO (Maybe (Ref Widget))
belowmouse = belowmouse' >>= toMaybeRef
setBelowmouse' :: (Ptr ()) -> IO ((()))
setBelowmouse' a1 =
  let {a1' = id a1} in
  setBelowmouse''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 612 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

setBelowmouse :: (Parent a WidgetBase) => Ref a -> IO ()
setBelowmouse wp = withRef wp setBelowmouse'
pushed' :: IO ((Ptr ()))
pushed' =
  pushed''_ >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 616 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

pushed :: IO (Maybe (Ref Widget))
pushed = pushed' >>= toMaybeRef
setPushed' :: (Ptr ()) -> IO ((()))
setPushed' a1 =
  let {a1' = id a1} in
  setPushed''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 620 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

setPushed :: (Parent a WidgetBase) => Ref a -> IO ()
setPushed wp = withRef wp setPushed'
focus' :: IO ((Ptr ()))
focus' =
  focus''_ >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 623 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

focus :: IO (Maybe (Ref Widget))
focus = focus' >>= toMaybeRef
setFocus' :: (Ptr ()) -> IO ((()))
setFocus' a1 =
  let {a1' = id a1} in
  setFocus''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 627 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

setFocus :: (Parent a WidgetBase) => Ref a -> IO ()
setFocus wp = withRef wp setFocus'
selectionOwner' :: IO ((Ptr ()))
selectionOwner' =
  selectionOwner''_ >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 630 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

selectionOwner :: IO (Maybe (Ref Widget))
selectionOwner = selectionOwner' >>= toMaybeRef
setSelection_Owner' :: (Ptr ()) -> IO ((()))
setSelection_Owner' a1 =
  let {a1' = id a1} in
  setSelection_Owner''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 634 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

setSelectionOwner :: (Parent a WidgetBase) => Ref a -> IO ()
setSelectionOwner wp = withRef wp setSelection_Owner'
addHandler' :: (FunPtr GlobalEventHandlerPrim) -> IO ((()))
addHandler' a1 =
  let {a1' = id a1} in
  addHandler''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 638 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

removeHandler' :: (FunPtr GlobalEventHandlerPrim) -> IO ((()))
removeHandler' a1 =
  let {a1' = id a1} in
  removeHandler''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 640 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

setHandler :: GlobalEventHandlerF -> IO ()
setHandler eh = do
  newGlobalEventHandler <- toGlobalEventHandlerPrim eh
  curr <- do
    old <- readIORef ptrToGlobalEventHandler
    writeIORef ptrToGlobalEventHandler newGlobalEventHandler
    return old
  freeHaskellFunPtr curr
  removeHandler' curr
  addHandler' newGlobalEventHandler

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

{-# LINE 653 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

eventDispatch' :: IO ((FunPtr EventDispatchPrim))
eventDispatch' =
  eventDispatch''_ >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 655 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

eventDispatch :: (Parent a WidgetBase) =>
   IO (Event -> Ref a -> IO (Either UnknownEvent ()))
eventDispatch =
    do
      funPtr <- eventDispatch'
      return (\e window ->
                  withRef
                   window
                    (\ptr ->
                         let eventNum = fromIntegral (fromEnum e)
                             fun = unwrapEventDispatchPrim funPtr
                         in fun eventNum (castPtr ptr) >>=
                            return . successOrUnknownEvent . fromIntegral
                    )
             )

setEventDispatch ::
    (Parent a WidgetBase) =>
    (Event -> Ref a -> IO (Either UnknownEvent ())) -> IO ()
setEventDispatch ed = do
    do
      let toPrim = (\e ptr ->
                      let eventEnum = toEnum $ fromIntegral e
                      in do
                      obj <- toRef ptr
                      result <- ed eventEnum obj
                      case result of
                        Left _ -> return 0
                        _ -> return 1
                    )
      callbackPtr <-  wrapEventDispatchPrim toPrim
      ptrToCallbackPtr <- new callbackPtr
      poke ptrToCallbackPtr callbackPtr
      setEventDispatch' ptrToCallbackPtr

copy' :: (CString) -> (Int) -> IO ((()))
copy' a1 a2 =
  (flip ($)) a1 $ \a1' ->
  let {a2' = fromIntegral a2} in
  copy''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 691 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

copyToClipboard :: T.Text -> IO ()
copyToClipboard t = withText t (\s' -> copy' s' 0)

copyToSelectionBuffer :: T.Text -> IO ()
copyToSelectionBuffer t = withText t (\s' -> copy' s' 1)

copyWithDestination :: (CString) -> (Int) -> (Int) -> IO ((()))
copyWithDestination a1 a2 a3 =
  (flip ($)) a1 $ \a1' ->
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  copyWithDestination'_ a1' a2' a3' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 698 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}


copyLengthToClipboard :: T.Text -> Int -> IO ()
copyLengthToClipboard t l = withText t (\s' -> copyWithDestination s' l 0)

copyLengthToSelectionBuffer :: T.Text -> Int -> IO ()
copyLengthToSelectionBuffer t l = withText t (\s' -> copyWithDestination s' l 1)

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

{-# LINE 706 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}


pasteImageFromSelectionBuffer :: (Parent a WidgetBase) => Ref a -> IO ()
pasteImageFromSelectionBuffer widget = withRef widget (\widgetPtr -> withText (T.pack "Fl::clipboard_image") (\t -> pasteWithSourceType widgetPtr 0 t))

pasteFromSelectionBuffer :: (Parent a WidgetBase) => Ref a -> IO ()
pasteFromSelectionBuffer widget = withRef widget (\widgetPtr -> withText (T.pack "Fl::clipboard_plain_text") (\t -> pasteWithSourceType widgetPtr 0 t))

pasteImageFromClipboard :: (Parent a WidgetBase) => Ref a -> IO ()
pasteImageFromClipboard widget = withRef widget (\widgetPtr -> withText (T.pack "Fl::clipboard_image") (\t -> pasteWithSourceType widgetPtr 1 t))

pasteFromClipboard :: (Parent a WidgetBase) => Ref a -> IO ()
pasteFromClipboard widget = withRef widget (\widgetPtr -> withText (T.pack "Fl::clipboard_plain_text") (\t -> pasteWithSourceType widgetPtr 1 t))

dnd :: IO ((Int))
dnd =
  dnd'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 721 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

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

{-# LINE 723 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

y :: IO ((Int))
y =
  y'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 725 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

w :: IO ((Int))
w =
  w'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 727 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

h :: IO ((Int))
h =
  h'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 729 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

screenCount :: IO ((Int))
screenCount =
  screenCount'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 731 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}


screenXYWH :: IO ((Int), (Int), (Int), (Int))
screenXYWH =
  alloca $ \a1' ->
  alloca $ \a2' ->
  alloca $ \a3' ->
  alloca $ \a4' ->
  screenXYWH'_ a1' a2' a3' a4' >>
  peekIntConv  a1'>>= \a1'' ->
  peekIntConv  a2'>>= \a2'' ->
  peekIntConv  a3'>>= \a3'' ->
  peekIntConv  a4'>>= \a4'' ->
  return (a1'', a2'', a3'', a4'')

{-# LINE 739 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

screenXYWYWithMXMY :: (Int) -> (Int) -> IO ((Int), (Int), (Int), (Int))
screenXYWYWithMXMY a5 a6 =
  alloca $ \a1' ->
  alloca $ \a2' ->
  alloca $ \a3' ->
  alloca $ \a4' ->
  let {a5' = fromIntegral a5} in
  let {a6' = fromIntegral a6} in
  screenXYWYWithMXMY'_ a1' a2' a3' a4' a5' a6' >>
  peekIntConv  a1'>>= \a1'' ->
  peekIntConv  a2'>>= \a2'' ->
  peekIntConv  a3'>>= \a3'' ->
  peekIntConv  a4'>>= \a4'' ->
  return (a1'', a2'', a3'', a4'')

{-# LINE 748 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

screenXYWNWithN :: (Int) -> IO ((Int), (Int), (Int), (Int))
screenXYWNWithN a5 =
  alloca $ \a1' ->
  alloca $ \a2' ->
  alloca $ \a3' ->
  alloca $ \a4' ->
  let {a5' = fromIntegral a5} in
  screenXYWNWithN'_ a1' a2' a3' a4' a5' >>
  peekIntConv  a1'>>= \a1'' ->
  peekIntConv  a2'>>= \a2'' ->
  peekIntConv  a3'>>= \a3'' ->
  peekIntConv  a4'>>= \a4'' ->
  return (a1'', a2'', a3'', a4'')

{-# LINE 756 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

screenXYWHWithNMXMYMWMH :: (Int) -> (Int) -> (Int) -> (Int) -> IO ((Int), (Int), (Int), (Int))
screenXYWHWithNMXMYMWMH a5 a6 a7 a8 =
  alloca $ \a1' ->
  alloca $ \a2' ->
  alloca $ \a3' ->
  alloca $ \a4' ->
  let {a5' = fromIntegral a5} in
  let {a6' = fromIntegral a6} in
  let {a7' = fromIntegral a7} in
  let {a8' = fromIntegral a8} in
  screenXYWHWithNMXMYMWMH'_ a1' a2' a3' a4' a5' a6' a7' a8' >>
  peekIntConv  a1'>>= \a1'' ->
  peekIntConv  a2'>>= \a2'' ->
  peekIntConv  a3'>>= \a3'' ->
  peekIntConv  a4'>>= \a4'' ->
  return (a1'', a2'', a3'', a4'')

{-# LINE 767 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}


screenBounds :: Maybe ScreenLocation -> IO Rectangle
screenBounds location =
    case location of
      (Just (Intersect (Rectangle (Position (X x_pos) (Y y_pos)) (Size (Width width) (Height height))))) ->
          screenXYWHWithNMXMYMWMH x_pos y_pos width height >>= return . toRectangle
      (Just (ScreenPosition (Position (X x_pos) (Y y_pos)))) ->
          screenXYWYWithMXMY x_pos y_pos >>= return . toRectangle
      (Just (ScreenNumber n)) ->
          screenXYWNWithN n >>= return . toRectangle
      Nothing ->
          screenXYWH >>= return . toRectangle

screenDpi' :: IO ((Float), (Float))
screenDpi' =
  alloca $ \a1' ->
  alloca $ \a2' ->
  screenDpi''_ a1' a2' >>
  peekFloatConv  a1'>>= \a1'' ->
  peekFloatConv  a2'>>= \a2'' ->
  return (a1'', a2'')

{-# LINE 784 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

screenDpiWithN' :: (Int) -> IO ((Float), (Float))
screenDpiWithN' a3 =
  alloca $ \a1' ->
  alloca $ \a2' ->
  let {a3' = fromIntegral a3} in
  screenDpiWithN''_ a1' a2' a3' >>
  peekFloatConv  a1'>>= \a1'' ->
  peekFloatConv  a2'>>= \a2'' ->
  return (a1'', a2'')

{-# LINE 789 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}


screenDPI :: Maybe Int -> IO DPI
screenDPI (Just n) = do
  (dpiX, dpiY) <- screenDpiWithN' n
  return $ DPI dpiX dpiY
screenDPI Nothing = do
  (dpiX, dpiY) <- screenDpi'
  return $ DPI dpiX dpiY

screenWorkAreaWithMXMY' :: (Int) -> (Int) -> IO ((Int), (Int), (Int), (Int))
screenWorkAreaWithMXMY' a5 a6 =
  alloca $ \a1' ->
  alloca $ \a2' ->
  alloca $ \a3' ->
  alloca $ \a4' ->
  let {a5' = fromIntegral a5} in
  let {a6' = fromIntegral a6} in
  screenWorkAreaWithMXMY''_ a1' a2' a3' a4' a5' a6' >>
  peekIntConv  a1'>>= \a1'' ->
  peekIntConv  a2'>>= \a2'' ->
  peekIntConv  a3'>>= \a3'' ->
  peekIntConv  a4'>>= \a4'' ->
  return (a1'', a2'', a3'', a4'')

{-# LINE 808 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

screenWorkAreaWithN' :: (Int) -> IO ((Int), (Int), (Int), (Int))
screenWorkAreaWithN' a5 =
  alloca $ \a1' ->
  alloca $ \a2' ->
  alloca $ \a3' ->
  alloca $ \a4' ->
  let {a5' = fromIntegral a5} in
  screenWorkAreaWithN''_ a1' a2' a3' a4' a5' >>
  peekIntConv  a1'>>= \a1'' ->
  peekIntConv  a2'>>= \a2'' ->
  peekIntConv  a3'>>= \a3'' ->
  peekIntConv  a4'>>= \a4'' ->
  return (a1'', a2'', a3'', a4'')

{-# LINE 817 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

screenWorkArea' :: IO ((Int), (Int), (Int), (Int))
screenWorkArea' =
  alloca $ \a1' ->
  alloca $ \a2' ->
  alloca $ \a3' ->
  alloca $ \a4' ->
  screenWorkArea''_ a1' a2' a3' a4' >>= \res ->
  peekIntConv  a1'>>= \a1'' ->
  peekIntConv  a2'>>= \a2'' ->
  peekIntConv  a3'>>= \a3'' ->
  peekIntConv  a4'>>= \a4'' ->
  return (a1'', a2'', a3'', a4'')

{-# LINE 825 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

screenWorkArea :: Maybe ScreenLocation -> IO Rectangle
screenWorkArea location =
    case location of
      (Just (Intersect (Rectangle (Position (X x_pos) (Y y_pos)) _))) ->
          screenWorkAreaWithMXMY' x_pos y_pos >>= return . toRectangle
      (Just (ScreenPosition (Position (X x_pos) (Y y_pos)))) ->
          screenWorkAreaWithMXMY' x_pos y_pos >>= return . toRectangle
      (Just (ScreenNumber n)) ->
          screenWorkAreaWithN' n >>= return . toRectangle
      Nothing ->
          screenWorkArea' >>= return . toRectangle

setColorRgb :: Color -> Word8 -> Word8 -> Word8 -> IO ()
setColorRgb c r g b = fl_set_color_rgb
{-# LINE 839 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

                        (cFromColor c)
                        (fromIntegral r)
                        (fromIntegral g)
                        (fromIntegral b)
setColor :: (Color) -> (Color) -> IO ((()))
setColor a1 a2 =
  let {a1' = cFromColor a1} in
  let {a2' = cFromColor a2} in
  setColor'_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 845 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

getColor :: (Color) -> IO ((Color))
getColor a1 =
  let {a1' = cFromColor a1} in
  getColor'_ a1' >>= \res ->
  let {res' = cToColor res} in
  return (res')

{-# LINE 847 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

getColorRgb' :: (Color) -> IO ((()), (CUChar), (CUChar), (CUChar))
getColorRgb' a1 =
  let {a1' = cFromColor a1} in
  alloca $ \a2' ->
  alloca $ \a3' ->
  alloca $ \a4' ->
  getColorRgb''_ a1' a2' a3' a4' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  peekIntConv  a2'>>= \a2'' ->
  peekIntConv  a3'>>= \a3'' ->
  peekIntConv  a4'>>= \a4'' ->
  return (res', a2'', a3'', a4'')

{-# LINE 854 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

getColorRgb :: Color -> IO RGB
getColorRgb c = do
   (_,r,g,b) <- getColorRgb' c
   return (r,g,b)

freeColor' :: (Color) -> IO ((()))
freeColor' a1 =
  let {a1' = cFromColor a1} in
  freeColor''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 862 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

freeColorWithOverlay' :: (Color) -> (Int) -> IO ((()))
freeColorWithOverlay' a1 a2 =
  let {a1' = cFromColor a1} in
  let {a2' = fromIntegral a2} in
  freeColorWithOverlay''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 864 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

removeFromColormap :: Maybe Color -> Color -> IO ()
removeFromColormap (Just (Color overlay)) c = freeColorWithOverlay' c (fromIntegral overlay)
removeFromColormap Nothing c = freeColor' c
getFont' :: (Font) -> IO ((CString))
getFont' a1 =
  let {a1' = cFromFont a1} in
  getFont''_ a1' >>= \res ->
  return res >>= \res' ->
  return (res')

{-# LINE 869 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

getFont :: Font -> IO T.Text
getFont f = getFont' f >>= cStringToText

getFontNameWithAttributes' :: (Font) -> IO ((CString), (Maybe FontAttribute))
getFontNameWithAttributes' a1 =
  let {a1' = cFromFont a1} in
  alloca $ \a2' ->
  getFontNameWithAttributes''_ a1' a2' >>= \res ->
  return res >>= \res' ->
  toAttribute  a2'>>= \a2'' ->
  return (res', a2'')

{-# LINE 873 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

getFontName :: Font -> IO (T.Text, Maybe FontAttribute)
getFontName f = do
  (str, fa) <- getFontNameWithAttributes' f
  t <- cStringToText str
  return (t, fa)

toAttribute :: Ptr CInt -> IO (Maybe FontAttribute)
toAttribute ptr =
        do
          attributeCode <- peekIntConv ptr
          return $ cToFontAttribute attributeCode
getFontSizes' :: (Font) -> (Ptr (Ptr CInt)) -> IO ((CInt))
getFontSizes' a1 a2 =
  let {a1' = cFromFont a1} in
  let {a2' = id a2} in
  getFontSizes''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 886 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

getFontSizes :: Font -> IO [FontSize]
getFontSizes font = do
   arrPtr <- (newArray [] :: IO (Ptr (Ptr CInt)))
   arrLength <- getFontSizes' font arrPtr
   zeroth <- peekElemOff arrPtr 0
   if (arrLength == 0) then return []
   else do
     (sizes :: [CInt]) <-
         mapM
           (
            \offset -> do
               size <- peek (advancePtr zeroth offset)
               return size
           )
           [0 .. ((fromIntegral arrLength) - 1)]
     return (map FontSize sizes)

setFontToString' :: (Font) -> (CString) -> IO ((()))
setFontToString' a1 a2 =
  let {a1' = cFromFont a1} in
  (flip ($)) a2 $ \a2' ->
  setFontToString''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 905 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

setFontToString :: Font -> T.Text -> IO ()
setFontToString f t = withText t (\t' -> setFontToString' f t')
setFontToFont :: (Font) -> (Font) -> IO ((()))
setFontToFont a1 a2 =
  let {a1' = cFromFont a1} in
  let {a2' = cFromFont a2} in
  setFontToFont'_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 909 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

setFonts' :: IO ((Int))
setFonts' =
  setFonts''_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 911 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

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

{-# LINE 913 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

setFonts :: Maybe T.Text -> IO Int
setFonts (Just xstarName) = withText xstarName (\starNamePtr -> setFontsWithString' starNamePtr)
setFonts Nothing = setFonts'

addFdWhen' :: (CInt) -> (CInt) -> (FunPtr FDHandlerPrim) -> IO ()
addFdWhen' a1 a2 a3 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = id a3} in
  addFdWhen''_ a1' a2' a3' >>
  return ()

{-# LINE 923 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}


addFdWhen :: CInt -> [FdWhen] -> FDHandler -> IO ()
addFdWhen fd fdWhens handler = do
  fPtr <- toFDHandlerPrim handler
  addFdWhen' fd (fromIntegral . combine $ fdWhens) fPtr

addFd' :: (CInt) -> (FunPtr FDHandlerPrim) -> IO ()
addFd' a1 a2 =
  let {a1' = fromIntegral a1} in
  let {a2' = id a2} in
  addFd''_ a1' a2' >>
  return ()

{-# LINE 934 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}


addFd :: CInt -> FDHandler -> IO ()
addFd fd handler = do
  fPtr <- toFDHandlerPrim handler
  addFd' fd fPtr

removeFdWhen' :: (CInt) -> (CInt) -> IO ()
removeFdWhen' a1 a2 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  removeFdWhen''_ a1' a2' >>
  return ()

{-# LINE 941 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

removeFdWhen :: CInt -> [FdWhen] -> IO ()
removeFdWhen fd fdWhens =
  removeFdWhen' fd (fromIntegral . combine $ fdWhens)

removeFd' :: (CInt) -> IO ()
removeFd' a1 =
  let {a1' = fromIntegral a1} in
  removeFd''_ a1' >>
  return ()

{-# LINE 946 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

removeFd :: CInt -> IO ()
removeFd fd = removeFd' fd

getBoxtype :: (Boxtype) -> IO ((FunPtr BoxDrawFPrim))
getBoxtype a1 =
  let {a1' = cFromEnum a1} in
  getBoxtype'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 951 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}


setBoxtype' :: (Boxtype) -> (FunPtr BoxDrawFPrim) -> (Word8) -> (Word8) -> (Word8) -> (Word8) -> IO ((()))
setBoxtype' a1 a2 a3 a4 a5 a6 =
  let {a1' = cFromEnum a1} in
  let {a2' = id a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = fromIntegral a5} in
  let {a6' = fromIntegral a6} in
  setBoxtype''_ a1' a2' a3' a4' a5' a6' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 961 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

setBoxtypeByBoxtype' :: (Boxtype) -> (Boxtype) -> IO ((()))
setBoxtypeByBoxtype' a1 a2 =
  let {a1' = cFromEnum a1} in
  let {a2' = cFromEnum a2} in
  setBoxtypeByBoxtype''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 966 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}


data BoxtypeSpec = FromSpec BoxDrawF Word8 Word8 Word8 Word8
                 | FromBoxtype Boxtype
                 | FromFunPtr (FunPtr BoxDrawFPrim) Word8 Word8 Word8 Word8
setBoxtype :: Boxtype -> BoxtypeSpec -> IO ()
setBoxtype bt (FromSpec f dx dy dw dh) =
    do
      funPtr <- wrapBoxDrawFPrim (toBoxDrawFPrim f)
      setBoxtype' bt funPtr dx dy dw dh
setBoxtype bt (FromBoxtype template) =
    setBoxtypeByBoxtype' bt template
setBoxtype bt (FromFunPtr funPtr dx dy dw dh) =
    setBoxtype' bt funPtr dx dy dw dh

boxDx :: (Boxtype) -> IO ((Int))
boxDx a1 =
  let {a1' = cFromEnum a1} in
  boxDx'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 982 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

boxDy :: (Boxtype) -> IO ((Int))
boxDy a1 =
  let {a1' = cFromEnum a1} in
  boxDy'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 984 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

boxDw :: (Boxtype) -> IO ((Int))
boxDw a1 =
  let {a1' = cFromEnum a1} in
  boxDw'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 986 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

boxDh :: (Boxtype) -> IO ((Int))
boxDh a1 =
  let {a1' = cFromEnum a1} in
  boxDh'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 988 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}


adjustBoundsByBoxtype :: Rectangle -> Boxtype -> IO Rectangle
adjustBoundsByBoxtype rect bt =
  let (x',y',w',h') = fromRectangle rect
  in do
  dx <- boxDx bt
  dy <- boxDy bt
  dw <- boxDw bt
  dh <- boxDh bt
  return (toRectangle (x'+dx,y'+dy,w'-dw,h'-dh))

boxDifferences :: Rectangle -> Rectangle -> (Int, Int, Int, Int)
boxDifferences r1 r2 =
  let (r1x,r1y,r1w,r1h) = fromRectangle r1
      (r2x,r2y,r2w,r2h) = fromRectangle r2
  in (r2x-r1x,r2y-r1y,r1w-r2w,r1h-r2h)

drawBoxActive :: IO ((Bool))
drawBoxActive =
  drawBoxActive'_ >>= \res ->
  let {res' = toBool res} in
  return (res')

{-# LINE 1007 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

eventShift :: IO ((Bool))
eventShift =
  eventShift'_ >>= \res ->
  let {res' = toBool res} in
  return (res')

{-# LINE 1009 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

eventCtrl :: IO ((Bool))
eventCtrl =
  eventCtrl'_ >>= \res ->
  let {res' = toBool res} in
  return (res')

{-# LINE 1011 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

eventCommand :: IO ((Bool))
eventCommand =
  eventCommand'_ >>= \res ->
  let {res' = toBool res} in
  return (res')

{-# LINE 1013 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

eventAlt :: IO ((Bool))
eventAlt =
  eventAlt'_ >>= \res ->
  let {res' = toBool res} in
  return (res')

{-# LINE 1015 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

eventButtons :: IO ((Bool))
eventButtons =
  eventButtons'_ >>= \res ->
  let {res' = toBool res} in
  return (res')

{-# LINE 1017 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

eventButton1 :: IO ((Bool))
eventButton1 =
  eventButton1'_ >>= \res ->
  let {res' = toBool res} in
  return (res')

{-# LINE 1019 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

eventButton2 :: IO ((Bool))
eventButton2 =
  eventButton2'_ >>= \res ->
  let {res' = toBool res} in
  return (res')

{-# LINE 1021 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

eventButton3 :: IO ((Bool))
eventButton3 =
  eventButton3'_ >>= \res ->
  let {res' = toBool res} in
  return (res')

{-# LINE 1023 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

release :: IO ()
release = fl_release
{-# LINE 1025 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

setVisibleFocus :: Bool -> IO ()
setVisibleFocus = fl_set_visible_focus . cFromBool
visibleFocus :: IO Bool
visibleFocus = fl_visible_focus >>= return . cToBool
setDndTextOps :: Bool -> IO ()
setDndTextOps =  fl_set_dnd_text_ops . fromBool
dndTextOps :: IO Option
dndTextOps = fl_dnd_text_ops >>= return . cToEnum
deleteWidget :: (Parent a WidgetBase) => Ref a -> IO ()
deleteWidget wptr =
  swapRef wptr $ \ptr -> do
    fl_delete_widget ptr
    return nullPtr
doWidgetDeletion :: IO ()
doWidgetDeletion = fl_do_widget_deletion
{-# LINE 1040 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

watchWidgetPointer :: (Parent a WidgetBase) => Ref a -> IO ()
watchWidgetPointer wp = withRef wp fl_Watch_widget_Pointer
{-# LINE 1042 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

releaseWidgetPointer :: (Parent a WidgetBase) => Ref a -> IO ()
releaseWidgetPointer wp = withRef wp fl_release_widget_pointer
{-# LINE 1044 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

clearWidgetPointer :: (Parent a WidgetBase) => Ref a -> IO ()
clearWidgetPointer wp = withRef wp fl_Clear_Widget_Pointer
{-# LINE 1046 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

-- | Only available on FLTK version 1.3.4 and above.
setBoxColor :: Color -> IO ()
setBoxColor c = fl_set_box_color (cFromColor c)
-- | Only available on FLTK version 1.3.4 and above.
boxColor :: Color -> IO Color
boxColor c = fl_box_color (cFromColor c) >>= return . cToColor
-- | Only available on FLTK version 1.3.4 and above.
abiVersion :: IO Int
abiVersion = fl_abi_version >>= return . fromIntegral
-- | Only available on FLTK version 1.3.4 and above.
abiCheck :: Int -> IO Int
abiCheck v = fl_abi_check (fromIntegral v) >>= return . fromIntegral
-- | Only available on FLTK version 1.3.4 and above.
apiVersion :: IO Int
apiVersion = fl_abi_version >>= return . fromIntegral
-- | Only available on FLTK version 1.3.4 and above.
localCtrl :: IO T.Text
localCtrl = fl_local_ctrl >>= cStringToText
-- | Only available on FLTK version 1.3.4 and above.
localAlt :: IO T.Text
localAlt = fl_local_alt >>= cStringToText
-- | Only available on FLTK version 1.3.4 and above.
localMeta :: IO T.Text
localMeta = fl_local_meta >>= cStringToText
-- | Only available on FLTK version 1.3.4 and above.
localShift :: IO T.Text
localShift = fl_local_shift >>= cStringToText
-- | Only available on FLTK version 1.3.4 and above if GL is enabled with 'stack build --flag fltkhs:opengl'
useHighResGL :: IO Bool
useHighResGL = fl_use_high_res_GL >>= return . cToBool
-- | Only available on FLTK version 1.3.4 and above if GL is enabled with 'stack build --flag fltkhs:opengl'
setUseHighResGL :: Bool -> IO ()
setUseHighResGL use' = fl_set_use_high_res_GL (cFromBool use')
insertionPointLocation :: Position -> Height -> IO ()
insertionPointLocation (Position (X x') (Y y')) (Height h')
  = fl_insertion_point_location (fromIntegral x') (fromIntegral y') (fromIntegral h')
resetMarkedText :: IO ()
resetMarkedText = fl_reset_marked_text
{-# LINE 1086 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

runChecks :: IO ()
runChecks = fl_run_checks
{-# LINE 1088 "src/Graphics/UI/FLTK/LowLevel/FL.chs" #-}

screenDriver :: IO (Maybe (Ref ScreenDriver))
screenDriver = fl_screen_driver >>= toMaybeRef
systemDriver :: IO (Maybe (Ref SystemDriver))
systemDriver = fl_system_driver >>= toMaybeRef
setProgramShouldQuit :: Bool -> IO ()
setProgramShouldQuit = fl_set_program_should_quit . cFromBool
getProgramShouldQuit :: IO Bool
getProgramShouldQuit = fl_get_program_should_quit >>= return . cToBool


-- | Use this function to run a GUI in GHCi.
replRun :: IO ()
replRun = do
  flush
  w <- firstWindow
  case w of
    Just _ ->
      catch (forever (waitFor 0.01))
            (\e -> if (e == UserInterrupt)
                   then do
                     wM <- firstWindow
                     case wM of
                       Just w' -> allToplevelWindows [] (Just w') >>= mapM_ deleteWidget
                       Nothing -> return ()
                     flush
                   else throw e)
    Nothing -> return ()
  where
    allToplevelWindows :: [Ref Window] -> Maybe (Ref Window) -> IO [Ref Window]
    allToplevelWindows ws (Just w) = nextWindow w >>= allToplevelWindows (w:ws)
    allToplevelWindows ws Nothing = return ws

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_run"
  fl_run :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_check"
  fl_check :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_ready"
  fl_ready :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_option"
  fl_option :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_option"
  fl_set_option :: (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_lock"
  fl_lock :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_unlock"
  fl_unlock :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_awake"
  fl_awake :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_awake_to_handler"
  fl_awake_to_handler :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_add_awake_handler_"
  addAwakeHandler''_ :: ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (IO ()))) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_get_awake_handler_"
  getAwakeHandler_''_ :: ((C2HSImp.Ptr (C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (IO ())))) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_version"
  version'_ :: (IO C2HSImp.CDouble)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_help"
  help''_ :: (IO (C2HSImp.Ptr C2HSImp.CChar))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_display"
  fl_display :: ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_visual"
  visual'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_gl_visual"
  glVisual'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_own_colormap"
  fl_own_colormap :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_get_system_colors"
  fl_get_system_colors :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_foreground"
  fl_foreground :: (C2HSImp.CUChar -> (C2HSImp.CUChar -> (C2HSImp.CUChar -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_background"
  fl_background :: (C2HSImp.CUChar -> (C2HSImp.CUChar -> (C2HSImp.CUChar -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_background2"
  fl_background2 :: (C2HSImp.CUChar -> (C2HSImp.CUChar -> (C2HSImp.CUChar -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_scheme"
  getScheme''_ :: (IO (C2HSImp.Ptr C2HSImp.CChar))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_scheme"
  fl_set_scheme :: ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_reload_scheme"
  reloadScheme'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_is_scheme"
  fl_is_scheme :: ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_wait"
  wait'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_wait"
  waitFor'_ :: (C2HSImp.CDouble -> (IO C2HSImp.CDouble))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_scrollbar_size"
  scrollbarSize'_ :: (IO C2HSImp.CInt)

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_readqueue"
  readqueue''_ :: (IO (C2HSImp.Ptr ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_add_timeout"
  addTimeout''_ :: (C2HSImp.CDouble -> ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (IO ()))) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_repeat_timeout"
  repeatTimeout''_ :: (C2HSImp.CDouble -> ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (IO ()))) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_has_timeout"
  hasTimeout'_ :: ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (IO ()))) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_remove_timeout"
  removeTimeout'_ :: ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (IO ()))) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_add_check"
  addCheck''_ :: ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (IO ()))) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_has_check"
  hasCheck'_ :: ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (IO ()))) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_remove_check"
  removeCheck'_ :: ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (IO ()))) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_add_idle"
  addIdle''_ :: ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (IO ()))) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_has_idle"
  hasIdle'_ :: ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (IO ()))) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_remove_idle"
  removeIdle'_ :: ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (IO ()))) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_damage"
  damage'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_redraw"
  redraw'_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_flush"
  flush'_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_first_window"
  firstWindow''_ :: (IO (C2HSImp.Ptr ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_first_window"
  setFirstWindow''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_next_window"
  nextWindow''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_modal"
  modal''_ :: (IO (C2HSImp.Ptr ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_grab"
  grab''_ :: (IO (C2HSImp.Ptr ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_grab"
  setGrab''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event"
  event'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_x"
  eventX''_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_y"
  eventY''_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_x_root"
  eventXRoot''_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_y_root"
  eventYRoot''_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_dx"
  eventDx'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_dy"
  eventDy'_ :: (IO C2HSImp.CInt)

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_clicks"
  eventClicks'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_event_clicks"
  setEventClicks'_ :: (C2HSImp.CInt -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_is_click"
  eventIsClick'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_event_is_click"
  setEventIsClick'_ :: (C2HSImp.CInt -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_button"
  eventButton''_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_state"
  eventState'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_contains_event_state"
  containsEventState'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_key"
  eventKey'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_original_key"
  eventOriginalKey'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_key_pressed"
  eventKeyPressed'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_get_key"
  getKey'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_text"
  eventText''_ :: (IO (C2HSImp.Ptr C2HSImp.CChar))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_length"
  eventLength'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_clipboard"
  flEventClipboard''_ :: (IO (C2HSImp.Ptr ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_clipboard_type"
  flEventClipboardType''_ :: (IO (C2HSImp.Ptr C2HSImp.CChar))

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_compose_reset"
  composeReset'_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_inside_region"
  eventInsideRegion''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_test_shortcut"
  testShortcut'_ :: (C2HSImp.CUInt -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_enable_im"
  enableIm'_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_disable_im"
  disableIm'_ :: (IO ())

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_belowmouse"
  belowmouse''_ :: (IO (C2HSImp.Ptr ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_belowmouse"
  setBelowmouse''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_pushed"
  pushed''_ :: (IO (C2HSImp.Ptr ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_pushed"
  setPushed''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_focus"
  focus''_ :: (IO (C2HSImp.Ptr ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_focus"
  setFocus''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_selection_owner"
  selectionOwner''_ :: (IO (C2HSImp.Ptr ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_selection_owner"
  setSelection_Owner''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_add_handler"
  addHandler''_ :: ((C2HSImp.FunPtr (C2HSImp.CInt -> (IO C2HSImp.CInt))) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_remove_handler"
  removeHandler''_ :: ((C2HSImp.FunPtr (C2HSImp.CInt -> (IO C2HSImp.CInt))) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_event_dispatch"
  setEventDispatch''_ :: ((C2HSImp.Ptr (C2HSImp.FunPtr (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_dispatch"
  eventDispatch''_ :: (IO (C2HSImp.FunPtr (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))))

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_dnd"
  dnd'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_x"
  x'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_y"
  y'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_w"
  w'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_h"
  h'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_screen_count"
  screenCount'_ :: (IO C2HSImp.CInt)

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

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_screen_dpi"
  screenDpi''_ :: ((C2HSImp.Ptr C2HSImp.CFloat) -> ((C2HSImp.Ptr C2HSImp.CFloat) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_screen_dpi_with_n"
  screenDpiWithN''_ :: ((C2HSImp.Ptr C2HSImp.CFloat) -> ((C2HSImp.Ptr C2HSImp.CFloat) -> (C2HSImp.CInt -> (IO ()))))

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_color_rgb"
  fl_set_color_rgb :: (C2HSImp.CUInt -> (C2HSImp.CUChar -> (C2HSImp.CUChar -> (C2HSImp.CUChar -> (IO ())))))

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_get_color"
  getColor'_ :: (C2HSImp.CUInt -> (IO C2HSImp.CUInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_get_color_rgb"
  getColorRgb''_ :: (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CUChar) -> ((C2HSImp.Ptr C2HSImp.CUChar) -> ((C2HSImp.Ptr C2HSImp.CUChar) -> (IO ())))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_free_color"
  freeColor''_ :: (C2HSImp.CUInt -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_free_color_with_overlay"
  freeColorWithOverlay''_ :: (C2HSImp.CUInt -> (C2HSImp.CInt -> (IO ())))

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

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_font_by_font"
  setFontToFont'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_fonts"
  setFonts''_ :: (IO C2HSImp.CInt)

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_add_fd_with_when"
  addFdWhen''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.FunPtr (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO ())))) -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_add_fd"
  addFd''_ :: (C2HSImp.CInt -> ((C2HSImp.FunPtr (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO ())))) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_remove_fd_with_when"
  removeFdWhen''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_remove_fd"
  removeFd''_ :: (C2HSImp.CInt -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_get_boxtype"
  getBoxtype'_ :: (C2HSImp.CInt -> (IO (C2HSImp.FunPtr (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CUInt -> (IO ())))))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_boxtype"
  setBoxtype''_ :: (C2HSImp.CInt -> ((C2HSImp.FunPtr (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CUInt -> (IO ()))))))) -> (C2HSImp.CUChar -> (C2HSImp.CUChar -> (C2HSImp.CUChar -> (C2HSImp.CUChar -> (IO ())))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_boxtype_by_boxtype"
  setBoxtypeByBoxtype''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_box_dx"
  boxDx'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_box_dy"
  boxDy'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_box_dw"
  boxDw'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_box_dh"
  boxDh'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_draw_box_active"
  drawBoxActive'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_shift"
  eventShift'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_ctrl"
  eventCtrl'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_command"
  eventCommand'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_alt"
  eventAlt'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_buttons"
  eventButtons'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_button1"
  eventButton1'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_button2"
  eventButton2'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_event_button3"
  eventButton3'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_release"
  fl_release :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_visible_focus"
  fl_set_visible_focus :: (C2HSImp.CInt -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_visible_focus"
  fl_visible_focus :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_dnd_text_ops"
  fl_set_dnd_text_ops :: (C2HSImp.CInt -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_dnd_text_ops"
  fl_dnd_text_ops :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_delete_widget"
  fl_delete_widget :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_do_widget_deletion"
  fl_do_widget_deletion :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_watch_widget_pointer"
  fl_Watch_widget_Pointer :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_release_widget_pointer"
  fl_release_widget_pointer :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_clear_widget_pointer"
  fl_Clear_Widget_Pointer :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_box_color"
  fl_set_box_color :: (C2HSImp.CUInt -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_box_color"
  fl_box_color :: (C2HSImp.CUInt -> (IO C2HSImp.CUInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_abi_version"
  fl_abi_version :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_abi_check"
  fl_abi_check :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_local_ctrl"
  fl_local_ctrl :: (IO (C2HSImp.Ptr C2HSImp.CChar))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_local_alt"
  fl_local_alt :: (IO (C2HSImp.Ptr C2HSImp.CChar))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_local_meta"
  fl_local_meta :: (IO (C2HSImp.Ptr C2HSImp.CChar))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_local_shift"
  fl_local_shift :: (IO (C2HSImp.Ptr C2HSImp.CChar))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_use_high_res_GL"
  fl_use_high_res_GL :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_use_high_res_GL"
  fl_set_use_high_res_GL :: (C2HSImp.CInt -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_insertion_point_location"
  fl_insertion_point_location :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_reset_marked_text"
  fl_reset_marked_text :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_run_checks"
  fl_run_checks :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_screen_driver"
  fl_screen_driver :: (IO (C2HSImp.Ptr ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_system_driver"
  fl_system_driver :: (IO (C2HSImp.Ptr ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_set_program_should_quit"
  fl_set_program_should_quit :: (C2HSImp.CInt -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/FL.chs.h Fl_get_program_should_quit"
  fl_get_program_should_quit :: (IO C2HSImp.CInt)