-- 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/ImageSurface.chs" #-}
{-# LANGUAGE CPP, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, ScopedTypeVariables, UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Graphics.UI.FLTK.LowLevel.ImageSurface
       (
         imageSurfaceNew,
         imageSurfaceRescale
         -- * Hierarchy
         --
         -- $hierarchy

         -- * Functions
         --
         -- $functions

       )
where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp





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

import Graphics.UI.FLTK.LowLevel.Fl_Types
import Graphics.UI.FLTK.LowLevel.Utils
import Graphics.UI.FLTK.LowLevel.Hierarchy
import Graphics.UI.FLTK.LowLevel.Dispatch

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

{-# LINE 27 "src/Graphics/UI/FLTK/LowLevel/ImageSurface.chs" #-}

imageSurfaceRescale :: (Parent a ImageSurface) => Ref a -> IO ()
imageSurfaceRescale is = withRef is $ \imageSurfacePtr -> imageSurfaceRescale' imageSurfacePtr

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

{-# LINE 31 "src/Graphics/UI/FLTK/LowLevel/ImageSurface.chs" #-}

imageSurfaceNew :: Size -> IO (Ref ImageSurface)
imageSurfaceNew (Size (Width w') (Height h')) = imageSurfaceNew' w' h' >>= toRef

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

{-# LINE 35 "src/Graphics/UI/FLTK/LowLevel/ImageSurface.chs" #-}

instance (impl ~ (IO ())) => Op (Destroy ()) ImageSurface orig impl where
  runOp _ _ image_surface = withRef image_surface $ \image_surfacePtr -> imageSurfaceDestroy' image_surfacePtr

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

{-# LINE 39 "src/Graphics/UI/FLTK/LowLevel/ImageSurface.chs" #-}

instance (impl ~ ( IO ())) => Op (SetCurrent ()) ImageSurface orig impl where
  runOp _ _ image_surface = withRef image_surface $ \image_surfacePtr -> setCurrent' image_surfacePtr

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

{-# LINE 43 "src/Graphics/UI/FLTK/LowLevel/ImageSurface.chs" #-}

instance (Parent a WidgetBase, impl ~ ( Ref a  -> Position -> IO ())) => Op (Draw ()) ImageSurface orig impl where
  runOp _ _ image_surface widget (Position (X delta_x) (Y delta_y)) = withRef image_surface $ \image_surfacePtr -> withRef widget $ \widgetPtr -> draw' image_surfacePtr widgetPtr delta_x delta_y

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

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

instance (impl ~ (IO (Position))) => Op (GetOrigin ()) ImageSurface orig impl where
  runOp _ _ image_surface =
    withRef image_surface (\ptr -> do
                             (x',y') <- getOrigin' ptr
                             return (Position (X (fromIntegral x')) (Y (fromIntegral y')))
                          )
printableRect' :: (Ptr()) -> IO ((Int), (CInt), (CInt))
printableRect' a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  printableRect''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peekIntConv  a2'>>= \a2'' -> 
  peekIntConv  a3'>>= \a3'' -> 
  return (res', a2'', a3'')

{-# LINE 54 "src/Graphics/UI/FLTK/LowLevel/ImageSurface.chs" #-}

instance (impl ~ (IO (Either UnknownError Size))) => Op (PrintableRect ()) ImageSurface orig impl where
  runOp _ _ image_surface =
    withRef image_surface (\ptr -> do
                             (status, w',h') <- printableRect' ptr
                             if (status == (0 :: Int))
                             then return (Right (Size (Width (fromIntegral w')) (Height (fromIntegral h'))))
                             else return (Left UnknownError)
                          )

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

{-# LINE 64 "src/Graphics/UI/FLTK/LowLevel/ImageSurface.chs" #-}

instance (impl ~ (Position -> IO ())) => Op (SetOrigin ()) ImageSurface orig impl where
  runOp _ _ image_surface (Position (X x') (Y y')) =
    withRef image_surface (\ptr -> setOrigin' ptr (fromIntegral x') (fromIntegral y'))

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

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

instance (impl ~ ( IO (FlOffscreen))) => Op (GetOffscreen ()) ImageSurface orig impl where
  runOp _ _ image_surface =
    withRef image_surface (\ptr -> offscreen' ptr  >>= return . FlOffscreen )

-- $hierarchy
-- @
-- "Graphics.UI.FLTK.LowLevel.ImageSurface"
-- @

-- $functions
-- @
-- destroy :: 'Ref' 'ImageSurface' -> 'IO' ()
--
-- draw:: ('Parent' a 'Widget') => 'Ref' 'ImageSurface' -> 'Ref' a -> 'Position' -> 'IO' ()
--
-- getOffscreen :: 'Ref' 'ImageSurface' -> 'IO' ('FlOffscreen')
--
-- getOrigin :: 'Ref' 'ImageSurface' -> 'IO' ('Position')
--
-- printableRect :: 'Ref' 'ImageSurface' -> 'IO' ('Either' 'UnknownError' 'Size')
--
-- setCurrent :: 'Ref' 'ImageSurface' -> 'IO' ()
--
-- setOrigin :: 'Ref' 'ImageSurface' -> 'Position' -> 'IO' ()
-- @

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/ImageSurface.chs.h Fl_Image_Surface_rescale"
  imageSurfaceRescale''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/ImageSurface.chs.h Fl_Image_Surface_Destroy"
  imageSurfaceDestroy''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/ImageSurface.chs.h Fl_Image_Surface_set_current"
  setCurrent''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

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

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

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

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

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