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


{-# LINE 1 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}
{-# LANGUAGE CPP, FlexibleContexts #-}
module Graphics.UI.FLTK.LowLevel.Draw
       (
       LineStyle(..),
       CapStyle(..),
       JoinStyle(..),
       LineDrawStyle(..),
       flcSetColor,
       flcSetColorWithRgb,
       flcColor,
       flcPushClip,
       flcPushNoClip,
       flcPopClip,
       flcNotClipped,
       flcClipBox,
       flcRestoreClip,
       flcSetClipRegion,
       flcClipRegion,
       flcPoint,
       flcLineStyle,
       flcRect,
       flcRectWithColor,
       flcRectf,
       flcRectfWithColor,
       flcRectfWithRgb,
       flcLine,
       flcLineWith2Edges,
       flcLoop,
       flcLoopWith4Sides,
       flcPolygon,
       flcPolygonWith4Sides,
       flcXyline,
       flcXylineDownByY,
       flcXylineDownByYAcrossByX,
       flcYxline,
       flcYxlineAcrossByX,
       flcYxlineAcrossByXDownByY,
       flcArcByWidthHeight,
       flcPie,
       flcPushMatrix,
       flcPopMatrix,
       flcScaleWithY,
       flcScale,
       flcTranslate,
       flcRotate,
       flcMultMatrix,
       flcBeginPoints,
       flcBeginLine,
       flcBeginLoop,
       flcBeginPolygon,
       flcVertex,
       flcCurve,
       flcArcByRadius,
       flcCircle,
       flcEndPoints,
       flcEndLine,
       flcEndLoop,
       flcEndPolygon,
       flcBeginComplexPolygon,
       flcGap,
       flcEndComplexPolygon,
       flcTransformX,
       flcTransformY,
       flcTransformDx,
       flcTransformDy,
       flcTransformedVertex,
       flcSetFont,
       flcFont,
       flcSize,
       flcHeight,
       flcHeightOfFont,
       flcDescent,
       flcWidth,
       flcWidthOfChar,
       flcTextExtents,
       flcLatin1ToLocal,
       flcLocalToLatin1,
       flcMacRomanToLocal,
       flcLocalToMacRoman,
       flcDraw,
       flcDrawWithAngle,
       flcRtlDraw,
       flcMeasure,
       flcDrawInBoxWithImageReference,
       flcDrawInBox,
       flcFrame,
       flcFrame2,
       flcDrawBox,
       flcDrawImageBuf,
       flcDrawImageMonoBuf,
       flcCanDoAlphaBlending,
       flcReadImage,
       flcDrawPixmapWithColor,
       flcDrawPixmap,
       flcDrawPixmapWithCdataColor,
       flcDrawPixmapWithCdata,
       flcMeasurePixmap,
       flcMeasurePixmapWithCdata,
       flcShortcutLabel,
       flcOldShortcut,
       flcOverlayRect,
       flcOverlayClear,
       flcCursorWithFgBg,
       flcCursorWithFg,
       flcCursorWithBg,
       flcCursor,
       flcSetStatus,
       flcSetSpotWithWin,
       flcSetSpot,
       flcResetSpot,
       flcDrawSymbol,
       flcDrawShortcut,
       flcSetDrawShortcut,
       flcCreateOffscreen
     , flcBeginOffscreen
     , flcEndOffscreen
     , flcDeleteOffscreen
     , flcRescaleOffscreen
     , flcCopyOffscreen
    )
where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp




import C2HS hiding (cFromEnum, cFromBool, cToBool,cToEnum)
import Graphics.UI.FLTK.LowLevel.Fl_Types
import Graphics.UI.FLTK.LowLevel.Fl_Enumerations
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.ByteString
import Foreign.Marshal.Utils

data LineStyle = LineStyleSolid
               | LineStyleDash
               | LineStyleDot
               | LineStyleDashDot
               | LineStyleDashDotDot
  deriving (Show,Eq,Ord)
instance Enum LineStyle where
  succ LineStyleSolid = LineStyleDash
  succ LineStyleDash = LineStyleDot
  succ LineStyleDot = LineStyleDashDot
  succ LineStyleDashDot = LineStyleDashDotDot
  succ LineStyleDashDotDot = error "LineStyle.succ: LineStyleDashDotDot has no successor"

  pred LineStyleDash = LineStyleSolid
  pred LineStyleDot = LineStyleDash
  pred LineStyleDashDot = LineStyleDot
  pred LineStyleDashDotDot = LineStyleDashDot
  pred LineStyleSolid = error "LineStyle.pred: LineStyleSolid 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 LineStyleDashDotDot

  fromEnum LineStyleSolid = 0
  fromEnum LineStyleDash = 1
  fromEnum LineStyleDot = 2
  fromEnum LineStyleDashDot = 3
  fromEnum LineStyleDashDotDot = 4

  toEnum 0 = LineStyleSolid
  toEnum 1 = LineStyleDash
  toEnum 2 = LineStyleDot
  toEnum 3 = LineStyleDashDot
  toEnum 4 = LineStyleDashDotDot
  toEnum unmatched = error ("LineStyle.toEnum: Cannot match " ++ show unmatched)

{-# LINE 152 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

data CapStyle = CapStyleFlat
              | CapStyleRound
              | CapStyleSquare
  deriving (Show,Eq,Ord)
instance Enum CapStyle where
  succ CapStyleFlat = CapStyleRound
  succ CapStyleRound = CapStyleSquare
  succ CapStyleSquare = error "CapStyle.succ: CapStyleSquare has no successor"

  pred CapStyleRound = CapStyleFlat
  pred CapStyleSquare = CapStyleRound
  pred CapStyleFlat = error "CapStyle.pred: CapStyleFlat 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 CapStyleSquare

  fromEnum CapStyleFlat = 256
  fromEnum CapStyleRound = 512
  fromEnum CapStyleSquare = 768

  toEnum 256 = CapStyleFlat
  toEnum 512 = CapStyleRound
  toEnum 768 = CapStyleSquare
  toEnum unmatched = error ("CapStyle.toEnum: Cannot match " ++ show unmatched)

{-# LINE 153 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

data JoinStyle = JoinStyleMiter
               | JoinStyleRound
               | JoinStyleBevel
  deriving (Show,Eq,Ord)
instance Enum JoinStyle where
  succ JoinStyleMiter = JoinStyleRound
  succ JoinStyleRound = JoinStyleBevel
  succ JoinStyleBevel = error "JoinStyle.succ: JoinStyleBevel has no successor"

  pred JoinStyleRound = JoinStyleMiter
  pred JoinStyleBevel = JoinStyleRound
  pred JoinStyleMiter = error "JoinStyle.pred: JoinStyleMiter 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 JoinStyleBevel

  fromEnum JoinStyleMiter = 4096
  fromEnum JoinStyleRound = 8192
  fromEnum JoinStyleBevel = 12288

  toEnum 4096 = JoinStyleMiter
  toEnum 8192 = JoinStyleRound
  toEnum 12288 = JoinStyleBevel
  toEnum unmatched = error ("JoinStyle.toEnum: Cannot match " ++ show unmatched)

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


data LineDrawStyle = LineDrawStyle (Maybe LineStyle) (Maybe CapStyle) (Maybe JoinStyle)

flcSetColor' :: (Color) -> IO ()
flcSetColor' a1 =
  let {a1' = cFromColor a1} in
  flcSetColor''_ a1' >>
  return ()

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

flcSetColor :: Color ->  IO ()
flcSetColor c = flcSetColor' c

flcSetColorWithRgb' :: (CUChar) -> (CUChar) -> (CUChar) -> IO ()
flcSetColorWithRgb' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = id a3} in
  flcSetColorWithRgb''_ a1' a2' a3' >>
  return ()

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

flcSetColorWithRgb :: RGB ->  IO ()
flcSetColorWithRgb (r', g' , b') = flcSetColorWithRgb' r' g' b'

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

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

flcColor ::  IO (Color)
flcColor  = flcColor'

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

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

flcPushClip :: Rectangle ->  IO ()
flcPushClip rectangle = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcPushClip' x_pos' y_pos' width' height'

flcPushNoClip' :: IO ()
flcPushNoClip' =
  flcPushNoClip''_ >>
  return ()

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

flcPushNoClip ::  IO ()
flcPushNoClip  = flcPushNoClip'

flcPopClip' :: IO ()
flcPopClip' =
  flcPopClip''_ >>
  return ()

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

flcPopClip ::  IO ()
flcPopClip  = flcPopClip'

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

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

flcNotClipped :: Rectangle ->  IO (Bool)
flcNotClipped rectangle = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcNotClipped' x_pos' y_pos' width' height'

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

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

flcClipBox :: Rectangle ->  IO (Either UnknownError Rectangle)
flcClipBox rectangle  =
    let (x_pos', y_pos', width', height') = fromRectangle rectangle
    in
      (alloca (\_xPtr' ->
      (alloca (\_yPtr' ->
      (alloca (\_wPtr' ->
      (alloca (\_hPtr' -> do
         res <- flcClipBox' x_pos' y_pos' width' height' _xPtr' _yPtr' _wPtr' _hPtr'
         _x' <- peekIntConv _xPtr'
         _y' <- peekIntConv _yPtr'
         _w' <- peekIntConv _wPtr'
         _h' <- peekIntConv _hPtr'
         if (res == 0) then return (Left UnknownError)
         else return (Right (toRectangle (fromIntegral _x', fromIntegral _y', fromIntegral _w', fromIntegral _h')))))))))))

flcRestoreClip' :: IO ()
flcRestoreClip' =
  flcRestoreClip''_ >>
  return ()

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

flcRestoreClip ::  IO ()
flcRestoreClip  = flcRestoreClip'

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

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

flcSetClipRegion :: Ref FlRegion ->  IO ()
flcSetClipRegion r = withRef r $ \rPtr -> flcSetClipRegion' rPtr

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

{-# LINE 211 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcClipRegion ::  IO (Maybe (Ref FlRegion))
flcClipRegion  = flcClipRegion' >>= toMaybeRef

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

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

flcPoint :: Position ->  IO ()
flcPoint (Position (X x_pos') (Y y_pos')) = flcPoint' x_pos' y_pos'

flcLineStyleWithWidthDashes' :: (Int) -> (Int) -> (Ptr CChar) -> IO ()
flcLineStyleWithWidthDashes' a1 a2 a3 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = id a3} in
  flcLineStyleWithWidthDashes''_ a1' a2' a3' >>
  return ()

{-# LINE 219 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcLineStyle :: LineDrawStyle -> Maybe Width -> Maybe T.Text -> IO ()
flcLineStyle style width' dashes' =
  let lineStyleMask = case style of { LineDrawStyle (Just s) _ _ -> fromEnum s; LineDrawStyle Nothing _ _ -> 0}
      capStyleMask = case style of { LineDrawStyle _ (Just s) _  -> fromEnum s; LineDrawStyle _ Nothing _ -> 0}
      joinStyleMask = case style of { LineDrawStyle _ _ (Just s) -> fromEnum s; LineDrawStyle _ _ Nothing -> 0}
      styleMask = lineStyleMask + capStyleMask + joinStyleMask
      _width = case width' of { Just (Width w) -> w ; _ -> 0 }
      cCall = flcLineStyleWithWidthDashes' styleMask _width
  in maybe (cCall nullPtr) (\t -> withText t cCall) dashes'

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

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

flcRect :: Rectangle ->  IO ()
flcRect rectangle = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcRect' x_pos' y_pos' width' height'

flcRectWithColor' :: (Int) -> (Int) -> (Int) -> (Int) -> (Color) -> IO ()
flcRectWithColor' 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' = cFromColor a5} in
  flcRectWithColor''_ a1' a2' a3' a4' a5' >>
  return ()

{-# LINE 234 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcRectWithColor :: Rectangle -> Color ->  IO ()
flcRectWithColor rectangle c = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcRectWithColor' x_pos' y_pos' width' height' c

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

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

flcRectf :: Rectangle ->  IO ()
flcRectf rectangle = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcRectf' x_pos' y_pos' width' height'

flcRectfWithColor' :: (Int) -> (Int) -> (Int) -> (Int) -> (Color) -> IO ()
flcRectfWithColor' 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' = cFromColor a5} in
  flcRectfWithColor''_ a1' a2' a3' a4' a5' >>
  return ()

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

flcRectfWithColor :: Rectangle -> Color ->  IO ()
flcRectfWithColor rectangle c = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcRectfWithColor' x_pos' y_pos' width' height' c

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

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

flcRectfWithRgb :: Rectangle -> RGB ->  IO ()
flcRectfWithRgb rectangle (r', g' , b') = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcRectfWithRgb' x_pos' y_pos' width' height' r' g' b'

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

{-# LINE 250 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcLine :: Position -> Position ->  IO ()
flcLine (Position (X x_pos') (Y y_pos'))(Position (X x_pos'') (Y y_pos''))  = flcLine' x_pos' y_pos' x_pos'' y_pos''

flcLineWithX2Y2' :: (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> IO ()
flcLineWithX2Y2' a1 a2 a3 a4 a5 a6 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = fromIntegral a5} in
  let {a6' = fromIntegral a6} in
  flcLineWithX2Y2''_ a1' a2' a3' a4' a5' a6' >>
  return ()

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

flcLineWith2Edges :: Position -> Position -> Position -> IO ()
flcLineWith2Edges (Position (X x_pos') (Y y_pos')) (Position (X x1_pos') (Y y1_pos')) (Position (X x2_pos') (Y y2_pos')) =
  flcLineWithX2Y2' x_pos' y_pos' x1_pos' y1_pos' x2_pos' y2_pos'

flcLoop' :: (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> IO ()
flcLoop' a1 a2 a3 a4 a5 a6 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = fromIntegral a5} in
  let {a6' = fromIntegral a6} in
  flcLoop''_ a1' a2' a3' a4' a5' a6' >>
  return ()

{-# LINE 259 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcLoop :: Position -> Position -> Position ->  IO ()
flcLoop (Position (X x_pos') (Y y_pos')) (Position (X x1) (Y y1)) (Position (X x2) (Y y2)) =
   flcLoop' x_pos' y_pos' x1 y1 x2 y2

flcLoopWithX3Y3' :: (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> IO ()
flcLoopWithX3Y3' a1 a2 a3 a4 a5 a6 a7 a8 =
  let {a1' = fromIntegral 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
  let {a7' = fromIntegral a7} in
  let {a8' = fromIntegral a8} in
  flcLoopWithX3Y3''_ a1' a2' a3' a4' a5' a6' a7' a8' >>
  return ()

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

flcLoopWith4Sides :: Position -> Position -> Position -> Position ->  IO ()
flcLoopWith4Sides (Position (X x_pos') (Y y_pos')) (Position (X x1) (Y y1)) (Position (X x2) (Y y2)) (Position (X x3) (Y y3)) =
  flcLoopWithX3Y3' x_pos' y_pos' x1 y1 x2 y2 x3 y3

flcPolygon' :: (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> IO ()
flcPolygon' a1 a2 a3 a4 a5 a6 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = fromIntegral a5} in
  let {a6' = fromIntegral a6} in
  flcPolygon''_ a1' a2' a3' a4' a5' a6' >>
  return ()

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

flcPolygon :: Position -> Position -> Position ->  IO ()
flcPolygon (Position (X x_pos') (Y y_pos')) (Position (X x1) (Y y1)) (Position (X x2) (Y y2)) =
  flcPolygon' x_pos' y_pos' x1 y1 x2 y2

flcPolygonWithX3Y3' :: (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> IO ()
flcPolygonWithX3Y3' a1 a2 a3 a4 a5 a6 a7 a8 =
  let {a1' = fromIntegral 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
  let {a7' = fromIntegral a7} in
  let {a8' = fromIntegral a8} in
  flcPolygonWithX3Y3''_ a1' a2' a3' a4' a5' a6' a7' a8' >>
  return ()

{-# LINE 274 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcPolygonWith4Sides :: Position -> Position -> Position -> Position ->  IO ()
flcPolygonWith4Sides (Position (X x_pos') (Y y_pos')) (Position (X x1) (Y y1)) (Position (X x2) (Y y2)) (Position (X x3) (Y y3)) =
   flcPolygonWithX3Y3' x_pos' y_pos' x1 y1 x2 y2 x3 y3

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

{-# LINE 279 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcXyline :: Position -> X ->  IO ()
flcXyline (Position (X x_pos') (Y y_pos')) (X x1) = flcXyline' x_pos' y_pos' x1

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

{-# LINE 283 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcXylineDownByY :: Position -> X -> Y ->  IO ()
flcXylineDownByY (Position (X x_pos') (Y y_pos')) (X x1) (Y y2) = flcXylineWithX2' x_pos' y_pos' x1 y2

flcXylineWithY2X3' :: (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> IO ()
flcXylineWithY2X3' 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' = fromIntegral a5} in
  flcXylineWithY2X3''_ a1' a2' a3' a4' a5' >>
  return ()

{-# LINE 287 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcXylineDownByYAcrossByX :: Position -> X -> Y -> X ->  IO ()
flcXylineDownByYAcrossByX (Position (X x_pos') (Y y_pos')) (X x1) (Y y2) (X x3) = flcXylineWithY2X3' x_pos' y_pos' x1 y2 x3

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

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

flcYxline :: Position -> Y ->  IO ()
flcYxline (Position (X x_pos') (Y y_pos')) (Y y1) = flcYxlineWithY1' x_pos' y_pos' y1

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

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

flcYxlineAcrossByX :: Position -> Y -> X ->  IO ()
flcYxlineAcrossByX (Position (X x_pos') (Y y_pos')) (Y y1) (X x2) = flcYxlineWithY2X2' x_pos' y_pos' y1 x2

flcYxlineWithY2X3' :: (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> IO ()
flcYxlineWithY2X3' 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' = fromIntegral a5} in
  flcYxlineWithY2X3''_ a1' a2' a3' a4' a5' >>
  return ()

{-# LINE 299 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcYxlineAcrossByXDownByY :: Position -> Y -> X -> Y ->  IO ()
flcYxlineAcrossByXDownByY (Position (X x_pos') (Y y_pos')) (Y y1) (X x2) (Y y3) = flcYxlineWithY2X3' x_pos' y_pos' y1 x2 y3

flcArcByWidthHeight' :: (Int) -> (Int) -> (Int) -> (Int) -> (Double) -> (Double) -> IO ()
flcArcByWidthHeight' a1 a2 a3 a4 a5 a6 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = realToFrac a5} in
  let {a6' = realToFrac a6} in
  flcArcByWidthHeight''_ a1' a2' a3' a4' a5' a6' >>
  return ()

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

flcArcByWidthHeight :: Rectangle -> PreciseAngle -> PreciseAngle ->  IO ()
flcArcByWidthHeight rectangle (PreciseAngle a1) (PreciseAngle  a2) = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcArcByWidthHeight' x_pos' y_pos' width' height' a1 a2

flcPie' :: (Int) -> (Int) -> (Int) -> (Int) -> (Double) -> (Double) -> IO ()
flcPie' a1 a2 a3 a4 a5 a6 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = realToFrac a5} in
  let {a6' = realToFrac a6} in
  flcPie''_ a1' a2' a3' a4' a5' a6' >>
  return ()

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

flcPie :: Rectangle -> PreciseAngle -> PreciseAngle ->  IO ()
flcPie rectangle (PreciseAngle a1) (PreciseAngle a2) = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcPie' x_pos' y_pos' width' height' a1 a2

flcPushMatrix' :: IO ()
flcPushMatrix' =
  flcPushMatrix''_ >>
  return ()

{-# LINE 311 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcPushMatrix ::  IO ()
flcPushMatrix  = flcPushMatrix'

flcPopMatrix' :: IO ()
flcPopMatrix' =
  flcPopMatrix''_ >>
  return ()

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

flcPopMatrix ::  IO ()
flcPopMatrix  = flcPopMatrix'

flcScaleWithY' :: (Double) -> (Double) -> IO ()
flcScaleWithY' a1 a2 =
  let {a1' = realToFrac a1} in
  let {a2' = realToFrac a2} in
  flcScaleWithY''_ a1' a2' >>
  return ()

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

flcScaleWithY :: ByXY ->  IO ()
flcScaleWithY (ByXY (ByX by_x') (ByY by_y')) = flcScaleWithY' by_x' by_y'

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

{-# LINE 323 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcScale :: ByX ->  IO ()
flcScale (ByX by_x') = flcScale' by_x'

flcTranslate' :: (Double) -> (Double) -> IO ()
flcTranslate' a1 a2 =
  let {a1' = realToFrac a1} in
  let {a2' = realToFrac a2} in
  flcTranslate''_ a1' a2' >>
  return ()

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

flcTranslate :: ByXY ->  IO ()
flcTranslate (ByXY (ByX by_x') (ByY by_y')) = flcTranslate' by_x' by_y'

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

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

flcRotate :: PreciseAngle ->  IO ()
flcRotate (PreciseAngle d) = flcRotate' d

flcMultMatrix' :: (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> IO ()
flcMultMatrix' a1 a2 a3 a4 a5 a6 =
  let {a1' = realToFrac a1} in
  let {a2' = realToFrac a2} in
  let {a3' = realToFrac a3} in
  let {a4' = realToFrac a4} in
  let {a5' = realToFrac a5} in
  let {a6' = realToFrac a6} in
  flcMultMatrix''_ a1' a2' a3' a4' a5' a6' >>
  return ()

{-# LINE 335 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcMultMatrix :: Double -> Double -> Double -> Double -> ByXY ->  IO ()
flcMultMatrix a b c d (ByXY (ByX by_x') (ByY by_y')) = flcMultMatrix' a b c d by_x' by_y'

flcBeginPoints' :: IO ()
flcBeginPoints' =
  flcBeginPoints''_ >>
  return ()

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

flcBeginPoints ::  IO ()
flcBeginPoints  = flcBeginPoints'

flcBeginLine' :: IO ()
flcBeginLine' =
  flcBeginLine''_ >>
  return ()

{-# LINE 343 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcBeginLine ::  IO ()
flcBeginLine  = flcBeginLine'

flcBeginLoop' :: IO ()
flcBeginLoop' =
  flcBeginLoop''_ >>
  return ()

{-# LINE 347 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcBeginLoop ::  IO ()
flcBeginLoop  = flcBeginLoop'

flcBeginPolygon' :: IO ()
flcBeginPolygon' =
  flcBeginPolygon''_ >>
  return ()

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

flcBeginPolygon ::  IO ()
flcBeginPolygon  = flcBeginPolygon'

flcVertex' :: (Double) -> (Double) -> IO ()
flcVertex' a1 a2 =
  let {a1' = realToFrac a1} in
  let {a2' = realToFrac a2} in
  flcVertex''_ a1' a2' >>
  return ()

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

flcVertex :: PrecisePosition ->  IO ()
flcVertex (PrecisePosition (PreciseX x') (PreciseY y')) = flcVertex' x' y'

flcCurve' :: (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> IO ()
flcCurve' a1 a2 a3 a4 a5 a6 a7 a8 =
  let {a1' = realToFrac a1} in
  let {a2' = realToFrac a2} in
  let {a3' = realToFrac a3} in
  let {a4' = realToFrac a4} in
  let {a5' = realToFrac a5} in
  let {a6' = realToFrac a6} in
  let {a7' = realToFrac a7} in
  let {a8' = realToFrac a8} in
  flcCurve''_ a1' a2' a3' a4' a5' a6' a7' a8' >>
  return ()

{-# LINE 359 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcCurve :: PrecisePosition -> PrecisePosition -> PrecisePosition -> PrecisePosition ->  IO ()
flcCurve (PrecisePosition (PreciseX x0) (PreciseY  y0)) (PrecisePosition (PreciseX x1) (PreciseY  y1)) (PrecisePosition (PreciseX x2) (PreciseY  y2)) (PrecisePosition (PreciseX x3) (PreciseY  y3)) = flcCurve' x0 y0 x1 y1 x2 y2 x3 y3

flcArcByRadius' :: (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> IO ()
flcArcByRadius' a1 a2 a3 a4 a5 =
  let {a1' = realToFrac a1} in
  let {a2' = realToFrac a2} in
  let {a3' = realToFrac a3} in
  let {a4' = realToFrac a4} in
  let {a5' = realToFrac a5} in
  flcArcByRadius''_ a1' a2' a3' a4' a5' >>
  return ()

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

flcArcByRadius :: PrecisePosition -> Double -> PreciseAngle -> PreciseAngle ->  IO ()
flcArcByRadius (PrecisePosition (PreciseX x') (PreciseY y')) r (PreciseAngle start') (PreciseAngle end') = flcArcByRadius' x' y' r start' end'

flcCircle' :: (Double) -> (Double) -> (Double) -> IO ()
flcCircle' a1 a2 a3 =
  let {a1' = realToFrac a1} in
  let {a2' = realToFrac a2} in
  let {a3' = realToFrac a3} in
  flcCircle''_ a1' a2' a3' >>
  return ()

{-# LINE 367 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcCircle :: PrecisePosition -> Double ->  IO ()
flcCircle (PrecisePosition (PreciseX x') (PreciseY y')) r = flcCircle' x' y' r

flcEndPoints' :: IO ()
flcEndPoints' =
  flcEndPoints''_ >>
  return ()

{-# LINE 371 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcEndPoints ::  IO ()
flcEndPoints  = flcEndPoints'

flcEndLine' :: IO ()
flcEndLine' =
  flcEndLine''_ >>
  return ()

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

flcEndLine ::  IO ()
flcEndLine  = flcEndLine'

flcEndLoop' :: IO ()
flcEndLoop' =
  flcEndLoop''_ >>
  return ()

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

flcEndLoop ::  IO ()
flcEndLoop  = flcEndLoop'

flcEndPolygon' :: IO ()
flcEndPolygon' =
  flcEndPolygon''_ >>
  return ()

{-# LINE 383 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcEndPolygon ::  IO ()
flcEndPolygon  = flcEndPolygon'

flcBeginComplexPolygon' :: IO ()
flcBeginComplexPolygon' =
  flcBeginComplexPolygon''_ >>
  return ()

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

flcBeginComplexPolygon ::  IO ()
flcBeginComplexPolygon  = flcBeginComplexPolygon'

flcGap' :: IO ()
flcGap' =
  flcGap''_ >>
  return ()

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

flcGap ::  IO ()
flcGap  = flcGap'

flcEndComplexPolygon' :: IO ()
flcEndComplexPolygon' =
  flcEndComplexPolygon''_ >>
  return ()

{-# LINE 395 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcEndComplexPolygon ::  IO ()
flcEndComplexPolygon  = flcEndComplexPolygon'

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

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

flcTransformX :: ByXY ->  IO (Double)
flcTransformX (ByXY (ByX by_x') (ByY by_y')) = flcTransformX' by_x' by_y'

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

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

flcTransformY :: ByXY ->  IO (Double)
flcTransformY (ByXY (ByX by_x') (ByY by_y')) = flcTransformY' by_x' by_y'

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

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

flcTransformDx :: ByXY ->  IO (Double)
flcTransformDx (ByXY (ByX by_x') (ByY by_y')) = flcTransformDx' by_x' by_y'

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

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

flcTransformDy :: ByXY ->  IO (Double)
flcTransformDy (ByXY (ByX by_x') (ByY by_y')) = flcTransformDy' by_x' by_y'

flcTransformedVertex' :: (Double) -> (Double) -> IO ()
flcTransformedVertex' a1 a2 =
  let {a1' = realToFrac a1} in
  let {a2' = realToFrac a2} in
  flcTransformedVertex''_ a1' a2' >>
  return ()

{-# LINE 415 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcTransformedVertex :: PrecisePosition ->  IO ()
flcTransformedVertex (PrecisePosition (PreciseX xf) (PreciseY yf)) = flcTransformedVertex' xf yf

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

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

flcSetFont :: Font -> FontSize ->  IO ()
flcSetFont face (FontSize fsize) = flcSetFont' face fsize

flcFont' :: IO ((Font))
flcFont' =
  flcFont''_ >>= \res ->
  let {res' = cToFont res} in
  return (res')

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

flcFont ::  IO (Font)
flcFont  = flcFont'

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

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

flcSize ::  IO (FontSize)
flcSize  = flcSize' >>= return . FontSize

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

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

flcHeight ::  IO (Height)
flcHeight  = flcHeight' >>=  return . Height

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

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

flcHeightOfFont :: Font -> FontSize ->  IO (Height)
flcHeightOfFont (Font font') (FontSize size') = flcSetHeight' font' size' >>= return . Height

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

{-# LINE 439 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcDescent ::  IO (Int)
flcDescent  = flcDescent'

flcWidth' :: (CString) -> IO ((Double))
flcWidth' a1 =
  (flip ($)) a1 $ \a1' ->
  flcWidth''_ a1' >>= \res ->
  let {res' = realToFrac res} in
  return (res')

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

flcWidth :: T.Text ->  IO (PreciseWidth)
flcWidth txt = withText txt ( \t -> flcWidth' t >>= return . PreciseWidth)

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

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

flcWidthOfChar :: Int ->  IO (PreciseWidth)
flcWidthOfChar c = flcWidthWithC' c >>= return . PreciseWidth

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

{-# LINE 451 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcTextExtents :: T.Text -> IO (Rectangle)
flcTextExtents s  = withText s flcTextExtents' >>= \(rectangle') -> return $ (toRectangle rectangle')

flcLatin1ToLocal' :: (CString) -> IO ((CString))
flcLatin1ToLocal' a1 =
  (flip ($)) a1 $ \a1' ->
  flcLatin1ToLocal''_ a1' >>= \res ->
  return res >>= \res' ->
  return (res')

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

flcLatin1ToLocal :: T.Text ->  IO  T.Text
flcLatin1ToLocal t = withText t flcLatin1ToLocal' >>= cStringToText

flcLocalToLatin1' :: (CString) -> IO ((CString))
flcLocalToLatin1' a1 =
  (flip ($)) a1 $ \a1' ->
  flcLocalToLatin1''_ a1' >>= \res ->
  return res >>= \res' ->
  return (res')

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

flcLocalToLatin1 :: T.Text ->  IO  T.Text
flcLocalToLatin1 t = withText t flcLocalToLatin1' >>= cStringToText

flcMacRomanToLocal' :: (CString) -> IO ((CString))
flcMacRomanToLocal' a1 =
  (flip ($)) a1 $ \a1' ->
  flcMacRomanToLocal''_ a1' >>= \res ->
  return res >>= \res' ->
  return (res')

{-# LINE 463 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcMacRomanToLocal :: T.Text ->  IO  T.Text
flcMacRomanToLocal t = withText t flcMacRomanToLocal' >>= cStringToText

flcLocalToMacRoman' :: (CString) -> IO ((CString))
flcLocalToMacRoman' a1 =
  (flip ($)) a1 $ \a1' ->
  flcLocalToMacRoman''_ a1' >>= \res ->
  return res >>= \res' ->
  return (res')

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

flcLocalToMacRoman :: T.Text ->  IO  T.Text
flcLocalToMacRoman t = withText t flcLocalToMacRoman' >>= cStringToText

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

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

flcDraw :: T.Text -> Position ->  IO ()
flcDraw str (Position (X x_pos') (Y y_pos')) = withText str (\s -> flcDraw' s x_pos' y_pos')

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

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

flcDrawWithAngle :: Int -> T.Text -> Position ->  IO ()
flcDrawWithAngle angle str (Position (X x_pos') (Y y_pos')) = withText str ( \s -> flcDrawWithAngle' angle s x_pos' y_pos')

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

{-# LINE 479 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcRtlDraw :: T.Text -> Int -> Position ->  IO ()
flcRtlDraw str n (Position (X x_pos') (Y y_pos')) = withText str (\s -> flcRtlDraw' s n x_pos' y_pos')

flcMeasureWithDrawSymbols' :: (CString) -> (Ptr CInt) -> (Ptr CInt) -> (CInt) -> IO ()
flcMeasureWithDrawSymbols' a1 a2 a3 a4 =
  (flip ($)) a1 $ \a1' ->
  let {a2' = id a2} in
  let {a3' = id a3} in
  let {a4' = fromIntegral a4} in
  flcMeasureWithDrawSymbols''_ a1' a2' a3' a4' >>
  return ()

{-# LINE 483 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcMeasure :: T.Text -> Maybe Width -> Bool -> IO (Size)
flcMeasure str word_wrap draw_symbols =
  alloca $ \widthPtr' ->
  alloca $ \heightPtr' ->
  let doit = do
       withText str (\s -> flcMeasureWithDrawSymbols' s widthPtr' heightPtr' (fromBool draw_symbols))
       w' <- peekIntConv widthPtr'
       h' <- peekIntConv heightPtr'
       return $ toSize (w',h')
  in do
    poke widthPtr' (maybe 0 (\(Width w) -> fromIntegral w) word_wrap)
    doit

flcDrawWithImgDrawSymbols' :: (CString) -> (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> (Ptr ()) -> (Bool) -> IO ()
flcDrawWithImgDrawSymbols' a1 a2 a3 a4 a5 a6 a7 a8 =
  (flip ($)) a1 $ \a1' ->
  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
  let {a7' = id a7} in
  let {a8' = C2HSImp.fromBool a8} in
  flcDrawWithImgDrawSymbols''_ a1' a2' a3' a4' a5' a6' a7' a8' >>
  return ()

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

flcDrawWithCallthisImgDrawSymbols' :: (CString) -> (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> (FunPtr DrawCallbackPrim) -> (Ptr ()) -> (Bool) -> IO ()
flcDrawWithCallthisImgDrawSymbols' a1 a2 a3 a4 a5 a6 a7 a8 a9 =
  (flip ($)) a1 $ \a1' ->
  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
  let {a7' = id a7} in
  let {a8' = id a8} in
  let {a9' = C2HSImp.fromBool a9} in
  flcDrawWithCallthisImgDrawSymbols''_ a1' a2' a3' a4' a5' a6' a7' a8' a9' >>
  return ()

{-# LINE 498 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcDrawInBoxWithImageReference' ::  T.Text -> Rectangle -> Alignments -> Maybe DrawCallback -> Ptr () -> Maybe Bool -> IO ()
flcDrawInBoxWithImageReference' string' rectangle' align' draw_callback' image_ptr draw_flags' =
  let (x_pos', y_pos', width', height') = fromRectangle rectangle' in
  case draw_callback' of
  Nothing -> withText string' (\s -> flcDrawWithImgDrawSymbols' s x_pos' y_pos' width' height' (alignmentsToInt align') image_ptr (maybe False id draw_flags'))
  Just c' -> do
             fptr <- toDrawCallback c'
             withText string' (\s -> flcDrawWithCallthisImgDrawSymbols' s x_pos' y_pos' width' height' (alignmentsToInt align') fptr image_ptr (maybe False id draw_flags'))
flcDrawInBoxWithImageReference :: (Parent a Image) => T.Text -> Rectangle -> Alignments -> Maybe DrawCallback -> Ref a -> Maybe Bool -> IO ()
flcDrawInBoxWithImageReference string' rectangle' align' draw_callback' image' draw_flags'
  = withRef image' $ \imagePtr' -> flcDrawInBoxWithImageReference' string' rectangle' align' draw_callback' imagePtr' draw_flags'

flcDrawInBox :: T.Text -> Rectangle -> Alignments -> Maybe DrawCallback -> Maybe Bool -> IO ()
flcDrawInBox string' rectangle' align' draw_callback' draw_flags'
  = flcDrawInBoxWithImageReference' string' rectangle' align' draw_callback' (castPtr nullPtr) draw_flags'

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

{-# LINE 515 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcFrame :: T.Text -> Rectangle ->  IO ()
flcFrame s rectangle = let (x_pos', y_pos', width', height') = fromRectangle rectangle in withText s ( \s' -> flcFrame' s' x_pos' y_pos' width' height')

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

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

flcFrame2 :: T.Text -> Rectangle ->  IO ()
flcFrame2 s rectangle = let (x_pos', y_pos', width', height') = fromRectangle rectangle in withText s ( \s' -> flcFrame2' s' x_pos' y_pos' width' height')

flcDrawBox' :: (Boxtype) -> (Int) -> (Int) -> (Int) -> (Int) -> (Color) -> IO ()
flcDrawBox' a1 a2 a3 a4 a5 a6 =
  let {a1' = cFromEnum a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = fromIntegral a5} in
  let {a6' = cFromColor a6} in
  flcDrawBox''_ a1' a2' a3' a4' a5' a6' >>
  return ()

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

flcDrawBox :: Boxtype -> Rectangle -> Color ->  IO ()
flcDrawBox boxtype rectangle color' = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcDrawBox' boxtype x_pos' y_pos' width' height' color'

flcDrawImageBufWithDL' :: (Ptr CUChar) -> (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> IO ()
flcDrawImageBufWithDL' a1 a2 a3 a4 a5 a6 a7 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = fromIntegral a5} in
  let {a6' = fromIntegral a6} in
  let {a7' = fromIntegral a7} in
  flcDrawImageBufWithDL''_ a1' a2' a3' a4' a5' a6' a7' >>
  return ()

{-# LINE 527 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcDrawImageBuf :: ByteString -> Rectangle -> Delta -> LineDelta -> IO ()
flcDrawImageBuf buf rectangle d l =
  let (x_pos', y_pos', width', height') = fromRectangle rectangle
  in useAsCString
       buf
       (\cs ->
         case (d,l) of
           (Just d', Nothing) -> flcDrawImageBufWithDL' (castPtr cs) x_pos' y_pos' width' height' d' 0
           (Nothing, Just l') -> flcDrawImageBufWithDL' (castPtr cs) x_pos' y_pos' width' height' 0 l'
           (Nothing, Nothing) -> flcDrawImageBufWithDL' (castPtr cs) x_pos' y_pos' width' height' 0 0
           (Just d', Just l') -> flcDrawImageBufWithDL' (castPtr cs) x_pos' y_pos' width' height' d' l')

flcDrawImageMonoBufWithDL' :: (Ptr CUChar) -> (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> IO ()
flcDrawImageMonoBufWithDL' a1 a2 a3 a4 a5 a6 a7 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = fromIntegral a5} in
  let {a6' = fromIntegral a6} in
  let {a7' = fromIntegral a7} in
  flcDrawImageMonoBufWithDL''_ a1' a2' a3' a4' a5' a6' a7' >>
  return ()

{-# LINE 540 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcDrawImageMonoBuf :: ByteString -> Rectangle -> Delta -> LineDelta ->  IO ()
flcDrawImageMonoBuf buf rectangle d l =
  let (x_pos', y_pos', width', height') = fromRectangle rectangle
  in useAsCString
       buf
       (\cs ->
         case (d,l) of
           (Just d', Nothing) -> flcDrawImageMonoBufWithDL' (castPtr cs) x_pos' y_pos' width' height' d' 0
           (Nothing, Just l') -> flcDrawImageMonoBufWithDL' (castPtr cs) x_pos' y_pos' width' height' 0 l'
           (Nothing, Nothing) -> flcDrawImageMonoBufWithDL' (castPtr cs) x_pos' y_pos' width' height' 0 0
           (Just d', Just l') -> flcDrawImageMonoBufWithDL' (castPtr cs) x_pos' y_pos' width' height' d' l')

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

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

flcCanDoAlphaBlending ::  IO (Bool)
flcCanDoAlphaBlending  = flcCanDoAlphaBlending'

flcReadImageWithAlpha' :: (Ptr CUChar) -> (Int) -> (Int) -> (Int) -> (Int) -> (Bool) -> IO ((Ptr CUChar))
flcReadImageWithAlpha' 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' = C2HSImp.fromBool a6} in
  flcReadImageWithAlpha''_ a1' a2' a3' a4' a5' a6' >>= \res ->
  let {res' = id res} in
  return (res')

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

flcReadImage :: Rectangle -> Bool -> IO (ByteString)
flcReadImage rectangle alpha =
  let (x_pos', y_pos', width', height') = fromRectangle rectangle
      buffer_size = width' * height' * (if alpha then 4 else 3)
  in
    do
      buffer <- flcReadImageWithAlpha' nullPtr x_pos' y_pos' width' height' alpha
      bs <- packCStringLen ((castPtr buffer), buffer_size)
      free buffer
      return bs

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

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

flcDrawPixmapWithColor :: PixmapHs -> Position -> Color ->  IO (Either UnknownError ())
flcDrawPixmapWithColor pixmap (Position (X x_pos') (Y y_pos')) color' =
    (withPixmap pixmap (\pptr -> flcDrawPixmapWithColor' pptr x_pos' y_pos' color'>>= return . successOrUnknownError ()))

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

{-# LINE 574 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcDrawPixmap :: PixmapHs -> Position ->  IO (Either UnknownError ())
flcDrawPixmap pixmap (Position (X x_pos') (Y y_pos')) =
    withPixmap pixmap $ \pptr -> flcDrawPixmap' pptr x_pos' y_pos' >>= return . successOrUnknownError ()

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

{-# LINE 579 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcDrawPixmapWithCdataColor :: PixmapHs -> Position -> Color ->  IO (Either UnknownError ())
flcDrawPixmapWithCdataColor pixmap (Position (X x_pos') (Y y_pos')) color' =
    withPixmap pixmap ( \pptr -> flcDrawPixmapWithCdataColor' pptr x_pos' y_pos' color' >>= return . successOrUnknownError ())

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

{-# LINE 584 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcDrawPixmapWithCdata :: PixmapHs -> Position ->  IO (Either UnknownError ())
flcDrawPixmapWithCdata pixmap (Position (X x_pos') (Y y_pos')) =
    withPixmap pixmap $ \pptr -> flcDrawPixmapWithCdata' pptr x_pos' y_pos' >>= return . successOrUnknownError ()

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

{-# LINE 589 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcMeasurePixmap :: PixmapHs ->  IO (Either UnknownError Size)
flcMeasurePixmap pixmap =
  withPixmap pixmap
    (\pptr ->
       alloca (\wPtr ->
       alloca (\hPtr -> do
         res <- flcMeasurePixmap' pptr wPtr hPtr
         if (res == 0) then return (Left UnknownError)
         else do
          w' <- peekIntConv wPtr
          h' <- peekIntConv hPtr
          return (Right (Size (Width (fromIntegral w')) (Height (fromIntegral h'))))
       ))
    )

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

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

flcMeasurePixmapWithCdata :: PixmapHs ->  IO (Either UnknownError Size)
flcMeasurePixmapWithCdata pixmap  =
  withPixmap pixmap
    (\pptr ->
       alloca (\wPtr ->
       alloca (\hPtr -> do
         res <- flcMeasurePixmapWithCdata' pptr wPtr hPtr
         if (res == 0) then return (Left UnknownError)
         else do
          w' <- peekIntConv wPtr
          h' <- peekIntConv hPtr
          return (Right (Size (Width (fromIntegral w')) (Height (fromIntegral h'))))
       ))
    )

flcShortcutLabel' :: (CInt) -> IO ((CString))
flcShortcutLabel' a1 =
  let {a1' = fromIntegral a1} in
  flcShortcutLabel''_ a1' >>= \res ->
  return res >>= \res' ->
  return (res')

{-# LINE 621 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcShortcutLabel :: ShortcutKeySequence ->  IO  T.Text
flcShortcutLabel (ShortcutKeySequence eventstates keytype) =
   flcShortcutLabel' (keySequenceToCInt eventstates keytype) >>= cStringToText

flcOldShortcut' :: (CString) -> IO ((CInt))
flcOldShortcut' a1 =
  (flip ($)) a1 $ \a1' ->
  flcOldShortcut''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 626 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcOldShortcut :: T.Text -> IO (Maybe ShortcutKeySequence)
flcOldShortcut s = withText s flcOldShortcut' >>= return . cIntToKeySequence

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

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

flcOverlayRect :: Rectangle ->  IO ()
flcOverlayRect rectangle = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcOverlayRect' x_pos' y_pos' width' height'

flcOverlayClear' :: IO ()
flcOverlayClear' =
  flcOverlayClear''_ >>
  return ()

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

flcOverlayClear ::  IO ()
flcOverlayClear  = flcOverlayClear'

flcCursorWithFgBg' :: (Cursor) -> (Color) -> (Color) -> IO ()
flcCursorWithFgBg' a1 a2 a3 =
  let {a1' = cFromEnum a1} in
  let {a2' = cFromColor a2} in
  let {a3' = cFromColor a3} in
  flcCursorWithFgBg''_ a1' a2' a3' >>
  return ()

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

flcCursorWithFgBg :: Cursor -> Color -> Color ->  IO ()
flcCursorWithFgBg cursore fg bg = flcCursorWithFgBg' cursore fg bg

flcCursorWithFg' :: (Cursor) -> (Color) -> IO ()
flcCursorWithFg' a1 a2 =
  let {a1' = cFromEnum a1} in
  let {a2' = cFromColor a2} in
  flcCursorWithFg''_ a1' a2' >>
  return ()

{-# LINE 642 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcCursorWithFg :: Cursor -> Color ->  IO ()
flcCursorWithFg cursor fg = flcCursorWithFg' cursor fg

flcCursorWithBg' :: (Cursor) -> (Color) -> IO ()
flcCursorWithBg' a1 a2 =
  let {a1' = cFromEnum a1} in
  let {a2' = cFromColor a2} in
  flcCursorWithBg''_ a1' a2' >>
  return ()

{-# LINE 646 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcCursorWithBg :: Cursor -> Color ->  IO ()
flcCursorWithBg cursor bg = flcCursorWithBg' cursor bg

flcCursor' :: (Cursor) -> IO ()
flcCursor' a1 =
  let {a1' = cFromEnum a1} in
  flcCursor''_ a1' >>
  return ()

{-# LINE 650 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcCursor :: Cursor ->  IO ()
flcCursor cursor = flcCursor' cursor

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

{-# LINE 654 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcSetStatus :: Rectangle ->  IO ()
flcSetStatus rectangle = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcSetStatus' x_pos' y_pos' width' height'

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

{-# LINE 658 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcSetSpotWithWin :: (Parent a WindowBase) => Font -> FontSize -> Rectangle -> Ref a -> IO ()
flcSetSpotWithWin (Font font') (FontSize size') rectangle win = let (x_pos', y_pos', width', height') = fromRectangle rectangle in withRef win $ \winPtr -> flcSetSpotWithWin' font' size' x_pos' y_pos' width' height' winPtr

flcSetSpot' :: (Int) -> (CInt) -> (Int) -> (Int) -> (Int) -> (Int) -> IO ()
flcSetSpot' a1 a2 a3 a4 a5 a6 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = fromIntegral a5} in
  let {a6' = fromIntegral a6} in
  flcSetSpot''_ a1' a2' a3' a4' a5' a6' >>
  return ()

{-# LINE 662 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcSetSpot :: Font -> FontSize -> Rectangle ->  IO ()
flcSetSpot (Font font') (FontSize size') rectangle = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcSetSpot' font' size' x_pos' y_pos' width' height'

flcResetSpot' :: IO ()
flcResetSpot' =
  flcResetSpot''_ >>
  return ()

{-# LINE 666 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcResetSpot ::  IO ()
flcResetSpot  = flcResetSpot'

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

{-# LINE 670 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcDrawSymbol :: T.Text -> Rectangle -> Color ->  IO (Either UnknownError ())
flcDrawSymbol label rectangle color' =
  let (x_pos', y_pos', width', height') = fromRectangle rectangle
  in do
  res <- withText label (\l -> flcDrawSymbol' l x_pos' y_pos' width' height' color')
  if (res == 0)
  then return (Right ())
  else return (Left UnknownError)

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

{-# LINE 680 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcDrawShortcut :: IO (Maybe DrawShortcut)
flcDrawShortcut = do
  res <- flcDrawShortcut'
  return (drawShortcutFromC res)

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

{-# LINE 686 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcSetDrawShortcut :: Maybe DrawShortcut -> IO ()
flcSetDrawShortcut sh = flcSetDrawShortcut' (drawShortcutToC sh)

-- | Only available on FLTK version 1.4.0 and above.
flcCreateOffscreen :: Size -> IO FlOffscreen
flcCreateOffscreen (Size (Width w') (Height h')) =
  flcCreateOffscreen' (fromIntegral w') (fromIntegral h') >>= return . FlOffscreen
flcBeginOffscreen' :: (Fl_Offscreen) -> IO ()
flcBeginOffscreen' a1 =
  let {a1' = id a1} in
  flcBeginOffscreen''_ a1' >>
  return ()

{-# LINE 694 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

-- | Only available on FLTK version 1.4.0 and above.
flcBeginOffscreen :: FlOffscreen -> IO ()
flcBeginOffscreen (FlOffscreen o) = flcBeginOffscreen' o
-- | Only available on FLTK version 1.4.0 and above.
flcEndOffscreen :: IO ()
flcEndOffscreen =  flcEndOffscreen'
{-# LINE 700 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

-- | Only available on FLTK version 1.4.0 and above.
flcDeleteOffscreen' :: (Fl_Offscreen) -> IO ()
flcDeleteOffscreen' a1 =
  let {a1' = id a1} in
  flcDeleteOffscreen''_ a1' >>
  return ()

{-# LINE 702 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcDeleteOffscreen :: FlOffscreen -> IO ()
flcDeleteOffscreen (FlOffscreen o) = flcDeleteOffscreen' o
flcRescaleOffscreen' :: (Ptr Fl_Offscreen) -> IO ()
flcRescaleOffscreen' a1 =
  let {a1' = id a1} in
  flcRescaleOffscreen''_ a1' >>
  return ()

{-# LINE 705 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcRescaleOffscreen :: FlOffscreen -> IO ()
flcRescaleOffscreen (FlOffscreen o) = with o flcRescaleOffscreen'
flcCopyOffscreen' :: (Int) -> (Int) -> (Int) -> (Int) -> (Fl_Offscreen) -> (Int) -> (Int) -> IO ()
flcCopyOffscreen' a1 a2 a3 a4 a5 a6 a7 =
  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
  let {a6' = fromIntegral a6} in
  let {a7' = fromIntegral a7} in
  flcCopyOffscreen''_ a1' a2' a3' a4' a5' a6' a7' >>
  return ()

{-# LINE 708 "src/Graphics/UI/FLTK/LowLevel/Draw.chs" #-}

flcCopyOffscreen :: Position -> Size -> FlOffscreen -> Position -> IO ()
flcCopyOffscreen (Position (X x') (Y y')) (Size (Width w') (Height h')) (FlOffscreen o) (Position (X srcx) (Y srcy)) =
  flcCopyOffscreen' x' y' w' h' o srcx srcy

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_set_color"
  flcSetColor''_ :: (C2HSImp.CUInt -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_set_color_with_rgb"
  flcSetColorWithRgb''_ :: (C2HSImp.CUChar -> (C2HSImp.CUChar -> (C2HSImp.CUChar -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_color"
  flcColor''_ :: (IO C2HSImp.CUInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_push_clip"
  flcPushClip''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_push_no_clip"
  flcPushNoClip''_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_pop_clip"
  flcPopClip''_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_not_clipped"
  flcNotClipped''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_restore_clip"
  flcRestoreClip''_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_set_clip_region"
  flcSetClipRegion''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_clip_region"
  flcClipRegion''_ :: (IO (C2HSImp.Ptr ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_point"
  flcPoint''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_rect"
  flcRect''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))))

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_rectf"
  flcRectf''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))))

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_rectf_with_rgb"
  flcRectfWithRgb''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CUChar -> (C2HSImp.CUChar -> (C2HSImp.CUChar -> (IO ()))))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_line"
  flcLine''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_line_with_x2_y2"
  flcLineWithX2Y2''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_loop"
  flcLoop''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_loop_with_x3_y3"
  flcLoopWithX3Y3''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_polygon"
  flcPolygon''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_polygon_with_x3_y3"
  flcPolygonWithX3Y3''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_xyline"
  flcXyline''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_xyline_with_x2"
  flcXylineWithX2''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_xyline_with_y2_x3"
  flcXylineWithY2X3''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ()))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_yxline_with_y1"
  flcYxlineWithY1''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_yxline_with_y2_x2"
  flcYxlineWithY2X2''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_yxline_with_y2_x3"
  flcYxlineWithY2X3''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ()))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_arc_by_width_height"
  flcArcByWidthHeight''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (IO ())))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_pie"
  flcPie''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (IO ())))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_push_matrix"
  flcPushMatrix''_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_pop_matrix"
  flcPopMatrix''_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_scale_with_y"
  flcScaleWithY''_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_scale"
  flcScale''_ :: (C2HSImp.CDouble -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_translate"
  flcTranslate''_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_rotate"
  flcRotate''_ :: (C2HSImp.CDouble -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_mult_matrix"
  flcMultMatrix''_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (IO ())))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_begin_points"
  flcBeginPoints''_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_begin_line"
  flcBeginLine''_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_begin_loop"
  flcBeginLoop''_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_begin_polygon"
  flcBeginPolygon''_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_vertex"
  flcVertex''_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_curve"
  flcCurve''_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (IO ())))))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_arc_by_radius"
  flcArcByRadius''_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (IO ()))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_circle"
  flcCircle''_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_end_points"
  flcEndPoints''_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_end_line"
  flcEndLine''_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_end_loop"
  flcEndLoop''_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_end_polygon"
  flcEndPolygon''_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_begin_complex_polygon"
  flcBeginComplexPolygon''_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_gap"
  flcGap''_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_end_complex_polygon"
  flcEndComplexPolygon''_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_transform_x"
  flcTransformX''_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> (IO C2HSImp.CDouble)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_transform_y"
  flcTransformY''_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> (IO C2HSImp.CDouble)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_transform_dx"
  flcTransformDx''_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> (IO C2HSImp.CDouble)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_transform_dy"
  flcTransformDy''_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> (IO C2HSImp.CDouble)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_transformed_vertex"
  flcTransformedVertex''_ :: (C2HSImp.CDouble -> (C2HSImp.CDouble -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_set_font"
  flcSetFont''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_set_height"
  flcSetHeight''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_width"
  flcWidth''_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CDouble))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_width_with_c"
  flcWidthWithC''_ :: (C2HSImp.CUInt -> (IO C2HSImp.CDouble))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_text_extents"
  flcTextExtents''_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((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/Draw.chs.h flc_latin1_to_local"
  flcLatin1ToLocal''_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

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

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

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

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

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_draw_with_img_draw_symbols"
  flcDrawWithImgDrawSymbols''_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CUInt -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_draw_with_callthis_img_draw_symbols"
  flcDrawWithCallthisImgDrawSymbols''_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CUInt -> ((C2HSImp.FunPtr ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))))) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ()))))))))))

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_draw_image_buf_with_d_l"
  flcDrawImageBufWithDL''_ :: ((C2HSImp.Ptr C2HSImp.CUChar) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ()))))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_draw_image_mono_buf_with_d_l"
  flcDrawImageMonoBufWithDL''_ :: ((C2HSImp.Ptr C2HSImp.CUChar) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ()))))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_can_do_alpha_blending"
  flcCanDoAlphaBlending''_ :: (IO C2HSImp.CChar)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_read_image_with_alpha"
  flcReadImageWithAlpha''_ :: ((C2HSImp.Ptr C2HSImp.CUChar) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr C2HSImp.CUChar))))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_draw_pixmap_with_color"
  flcDrawPixmapWithColor''_ :: ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))))

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_draw_pixmap_with_cdata_color"
  flcDrawPixmapWithCdataColor''_ :: ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))))

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_shortcut_label"
  flcShortcutLabel''_ :: (C2HSImp.CUInt -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_old_shortcut"
  flcOldShortcut''_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CUInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_overlay_rect"
  flcOverlayRect''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_overlay_clear"
  flcOverlayClear''_ :: (IO ())

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

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

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_cursor"
  flcCursor''_ :: (C2HSImp.CInt -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_set_status"
  flcSetStatus''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))))

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_set_spot"
  flcSetSpot''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_reset_spot"
  flcResetSpot''_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_draw_symbol"
  flcDrawSymbol''_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_get_draw_shortcut"
  flcDrawShortcut''_ :: (IO C2HSImp.CChar)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_set_draw_shortcut"
  flcSetDrawShortcut''_ :: (C2HSImp.CChar -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_create_offscreen"
  flcCreateOffscreen' :: (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CULong)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_begin_offscreen"
  flcBeginOffscreen''_ :: (C2HSImp.CULong -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_end_offscreen"
  flcEndOffscreen' :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_delete_offscreen"
  flcDeleteOffscreen''_ :: (C2HSImp.CULong -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_rescale_offscreen"
  flcRescaleOffscreen''_ :: ((C2HSImp.Ptr C2HSImp.CULong) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Draw.chs.h flc_copy_offscreen"
  flcCopyOffscreen''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CULong -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ()))))))))