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


{-# LINE 1 "./GI/Cairo/Render/Internal/Fonts/FontOptions.chs" #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  GI.Cairo.Render.Internal.Fonts.FontOptions
-- Copyright   :  (c) Paolo Martini 2005
-- License     :  BSD-style (see doc/COPYRIGHT)
--
-- Maintainer  :  p.martini@neuralnoise.com
-- Stability   :  experimental
-- Portability :  portable
--
-- How a font should be rendered.
-----------------------------------------------------------------------------



module GI.Cairo.Render.Internal.Fonts.FontOptions where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp



import GI.Cairo.Render.Types
{-# LINE 18 "./GI/Cairo/Render/Internal/Fonts/FontOptions.chs" #-}


import Foreign
import Foreign.C
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp


{-# LINE 26 "./GI/Cairo/Render/Internal/Fonts/FontOptions.chs" #-}


fontOptionsCreate :: IO ((FontOptions))
fontOptionsCreate =
  fontOptionsCreate'_ >>= \res ->
  mkFontOptions res >>= \res' ->
  return (res')

{-# LINE 28 "./GI/Cairo/Render/Internal/Fonts/FontOptions.chs" #-}

fontOptionsCopy :: (FontOptions) -> IO ((FontOptions))
fontOptionsCopy a1 =
  withFontOptions a1 $ \a1' ->
  fontOptionsCopy'_ a1' >>= \res ->
  mkFontOptions res >>= \res' ->
  return (res')

{-# LINE 29 "./GI/Cairo/Render/Internal/Fonts/FontOptions.chs" #-}

fontOptionsDestroy :: (FontOptions) -> IO ()
fontOptionsDestroy a1 =
  withFontOptions a1 $ \a1' ->
  fontOptionsDestroy'_ a1' >>
  return ()

{-# LINE 30 "./GI/Cairo/Render/Internal/Fonts/FontOptions.chs" #-}

fontOptionsStatus :: (FontOptions) -> IO ((Status))
fontOptionsStatus a1 =
  withFontOptions a1 $ \a1' ->
  fontOptionsStatus'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 31 "./GI/Cairo/Render/Internal/Fonts/FontOptions.chs" #-}

fontOptionsMerge :: (FontOptions) -> (FontOptions) -> IO ()
fontOptionsMerge a1 a2 =
  withFontOptions a1 $ \a1' ->
  withFontOptions a2 $ \a2' ->
  fontOptionsMerge'_ a1' a2' >>
  return ()

{-# LINE 32 "./GI/Cairo/Render/Internal/Fonts/FontOptions.chs" #-}

fontOptionsHash :: (FontOptions) -> IO ((Int))
fontOptionsHash a1 =
  withFontOptions a1 $ \a1' ->
  fontOptionsHash'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 33 "./GI/Cairo/Render/Internal/Fonts/FontOptions.chs" #-}

fontOptionsEqual :: (FontOptions) -> (FontOptions) -> IO ((Bool))
fontOptionsEqual a1 a2 =
  withFontOptions a1 $ \a1' ->
  withFontOptions a2 $ \a2' ->
  fontOptionsEqual'_ a1' a2' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 34 "./GI/Cairo/Render/Internal/Fonts/FontOptions.chs" #-}

fontOptionsSetAntialias :: (FontOptions) -> (Antialias) -> IO ()
fontOptionsSetAntialias a1 a2 =
  withFontOptions a1 $ \a1' ->
  let {a2' = cFromEnum a2} in
  fontOptionsSetAntialias'_ a1' a2' >>
  return ()

{-# LINE 35 "./GI/Cairo/Render/Internal/Fonts/FontOptions.chs" #-}

fontOptionsGetAntialias :: (FontOptions) -> IO ((Antialias))
fontOptionsGetAntialias a1 =
  withFontOptions a1 $ \a1' ->
  fontOptionsGetAntialias'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 36 "./GI/Cairo/Render/Internal/Fonts/FontOptions.chs" #-}

fontOptionsSetSubpixelOrder :: (FontOptions) -> (SubpixelOrder) -> IO ()
fontOptionsSetSubpixelOrder a1 a2 =
  withFontOptions a1 $ \a1' ->
  let {a2' = cFromEnum a2} in
  fontOptionsSetSubpixelOrder'_ a1' a2' >>
  return ()

{-# LINE 37 "./GI/Cairo/Render/Internal/Fonts/FontOptions.chs" #-}

fontOptionsGetSubpixelOrder :: (FontOptions) -> IO ((SubpixelOrder))
fontOptionsGetSubpixelOrder a1 =
  withFontOptions a1 $ \a1' ->
  fontOptionsGetSubpixelOrder'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 38 "./GI/Cairo/Render/Internal/Fonts/FontOptions.chs" #-}

fontOptionsSetHintStyle :: (FontOptions) -> (HintStyle) -> IO ()
fontOptionsSetHintStyle a1 a2 =
  withFontOptions a1 $ \a1' ->
  let {a2' = cFromEnum a2} in
  fontOptionsSetHintStyle'_ a1' a2' >>
  return ()

{-# LINE 39 "./GI/Cairo/Render/Internal/Fonts/FontOptions.chs" #-}

fontOptionsGetHintStyle :: (FontOptions) -> IO ((HintStyle))
fontOptionsGetHintStyle a1 =
  withFontOptions a1 $ \a1' ->
  fontOptionsGetHintStyle'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 40 "./GI/Cairo/Render/Internal/Fonts/FontOptions.chs" #-}

fontOptionsSetHintMetrics :: (FontOptions) -> (HintMetrics) -> IO ()
fontOptionsSetHintMetrics a1 a2 =
  withFontOptions a1 $ \a1' ->
  let {a2' = cFromEnum a2} in
  fontOptionsSetHintMetrics'_ a1' a2' >>
  return ()

{-# LINE 41 "./GI/Cairo/Render/Internal/Fonts/FontOptions.chs" #-}

fontOptionsGetHintMetrics :: (FontOptions) -> IO ((HintMetrics))
fontOptionsGetHintMetrics a1 =
  withFontOptions a1 $ \a1' ->
  fontOptionsGetHintMetrics'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 42 "./GI/Cairo/Render/Internal/Fonts/FontOptions.chs" #-}


foreign import ccall safe "GI/Cairo/Render/Internal/Fonts/FontOptions.chs.h cairo_font_options_create"
  fontOptionsCreate'_ :: (IO (FontOptionsPtr))

foreign import ccall safe "GI/Cairo/Render/Internal/Fonts/FontOptions.chs.h cairo_font_options_copy"
  fontOptionsCopy'_ :: ((FontOptionsPtr) -> (IO (FontOptionsPtr)))

foreign import ccall safe "GI/Cairo/Render/Internal/Fonts/FontOptions.chs.h cairo_font_options_destroy"
  fontOptionsDestroy'_ :: ((FontOptionsPtr) -> (IO ()))

foreign import ccall safe "GI/Cairo/Render/Internal/Fonts/FontOptions.chs.h cairo_font_options_status"
  fontOptionsStatus'_ :: ((FontOptionsPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "GI/Cairo/Render/Internal/Fonts/FontOptions.chs.h cairo_font_options_merge"
  fontOptionsMerge'_ :: ((FontOptionsPtr) -> ((FontOptionsPtr) -> (IO ())))

foreign import ccall safe "GI/Cairo/Render/Internal/Fonts/FontOptions.chs.h cairo_font_options_hash"
  fontOptionsHash'_ :: ((FontOptionsPtr) -> (IO C2HSImp.CULong))

foreign import ccall safe "GI/Cairo/Render/Internal/Fonts/FontOptions.chs.h cairo_font_options_equal"
  fontOptionsEqual'_ :: ((FontOptionsPtr) -> ((FontOptionsPtr) -> (IO C2HSImp.CInt)))

foreign import ccall safe "GI/Cairo/Render/Internal/Fonts/FontOptions.chs.h cairo_font_options_set_antialias"
  fontOptionsSetAntialias'_ :: ((FontOptionsPtr) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "GI/Cairo/Render/Internal/Fonts/FontOptions.chs.h cairo_font_options_get_antialias"
  fontOptionsGetAntialias'_ :: ((FontOptionsPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "GI/Cairo/Render/Internal/Fonts/FontOptions.chs.h cairo_font_options_set_subpixel_order"
  fontOptionsSetSubpixelOrder'_ :: ((FontOptionsPtr) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "GI/Cairo/Render/Internal/Fonts/FontOptions.chs.h cairo_font_options_get_subpixel_order"
  fontOptionsGetSubpixelOrder'_ :: ((FontOptionsPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "GI/Cairo/Render/Internal/Fonts/FontOptions.chs.h cairo_font_options_set_hint_style"
  fontOptionsSetHintStyle'_ :: ((FontOptionsPtr) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "GI/Cairo/Render/Internal/Fonts/FontOptions.chs.h cairo_font_options_get_hint_style"
  fontOptionsGetHintStyle'_ :: ((FontOptionsPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "GI/Cairo/Render/Internal/Fonts/FontOptions.chs.h cairo_font_options_set_hint_metrics"
  fontOptionsSetHintMetrics'_ :: ((FontOptionsPtr) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "GI/Cairo/Render/Internal/Fonts/FontOptions.chs.h cairo_font_options_get_hint_metrics"
  fontOptionsGetHintMetrics'_ :: ((FontOptionsPtr) -> (IO C2HSImp.CInt))