-- GENERATED by C->Haskell Compiler, version 0.13.6 (gtk2hs branch) "Bin IO", 27 May 2012 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Graphics/Rendering/Cairo/Internal/Utilities.chs" #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Cairo.Internal.Utilities
-- Copyright   :  (c) Paolo Martini 2005
-- License     :  BSD-style (see cairo/COPYRIGHT)
--
-- Maintainer  :  p.martini@neuralnoise.com
-- Stability   :  experimental
-- Portability :  portable
--
-- http://cairographics.org/manual/Support.html
-----------------------------------------------------------------------------

module Graphics.Rendering.Cairo.Internal.Utilities where

import Graphics.Rendering.Cairo.Types
{-# LINE 16 "./Graphics/Rendering/Cairo/Internal/Utilities.chs" #-}

import Foreign
import Foreign.C

import Data.Char (ord, chr)


{-# LINE 23 "./Graphics/Rendering/Cairo/Internal/Utilities.chs" #-}

statusToString :: Status -> IO (String)
statusToString a1 =
  let {a1' = cFromEnum a1} in 
  statusToString'_ a1' >>= \res ->
  peekCString res >>= \res' ->
  return (res')
{-# LINE 25 "./Graphics/Rendering/Cairo/Internal/Utilities.chs" #-}
version :: Int
version =
  let {res = version'_} in
  let {res' = cIntConv res} in
  (res')
{-# LINE 26 "./Graphics/Rendering/Cairo/Internal/Utilities.chs" #-}
versionString :: String
versionString =
  unsafePerformIO $
  let {res = versionString'_} in
  peekCString res >>= \res' ->
  return (res')
{-# LINE 27 "./Graphics/Rendering/Cairo/Internal/Utilities.chs" #-}

-- These functions taken from System/Glib/UTFString.hs
-- Copyright (c) 1999..2002 Axel Simon

-- Define withUTFString to emit UTF-8.
--
withUTFString :: String -> (CString -> IO a) -> IO a
withUTFString hsStr = withCAString (toUTF hsStr)
 where
    -- Convert Unicode characters to UTF-8.
    --
    toUTF :: String -> String
    toUTF [] = []
    toUTF (x:xs) | ord x<=0x007F = x:toUTF xs
                 | ord x<=0x07FF = chr (0xC0 .|. ((ord x `shift` (-6)) .&. 0x1F)):
                                   chr (0x80 .|. (ord x .&. 0x3F)):
                                   toUTF xs
                 | otherwise     = chr (0xE0 .|. ((ord x `shift` (-12)) .&. 0x0F)):
                                   chr (0x80 .|. ((ord x `shift` (-6)) .&. 0x3F)):
                                   chr (0x80 .|. (ord x .&. 0x3F)):
                                   toUTF xs

foreign import ccall safe "cairo_status_to_string"
  statusToString'_ :: (CInt -> (IO (Ptr CChar)))

foreign import ccall safe "cairo_version"
  version'_ :: CInt

foreign import ccall safe "cairo_version_string"
  versionString'_ :: (Ptr CChar)