-- 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/Drawing/Transformations.chs" #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  GI.Cairo.Render.Internal.Drawing.Tranformations
-- Copyright   :  (c) Paolo Martini 2005
-- License     :  BSD-style (see cairo/COPYRIGHT)
--
-- Maintainer  :  p.martini@neuralnoise.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Manipulating the current transformation matrix.
-----------------------------------------------------------------------------



module GI.Cairo.Render.Internal.Drawing.Transformations where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp



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


import Data.GI.Base(wrapBoxed, withManagedPtr)
import Foreign hiding (rotate)
import Foreign.C


{-# LINE 24 "./GI/Cairo/Render/Internal/Drawing/Transformations.chs" #-}


translate :: (Cairo) -> (Double) -> (Double) -> IO ()
translate a1 a2 a3 =
  withManagedPtr a1 $ \a1' ->
  let {a2' = realToFrac a2} in
  let {a3' = realToFrac a3} in
  translate'_ a1' a2' a3' >>
  return ()

{-# LINE 26 "./GI/Cairo/Render/Internal/Drawing/Transformations.chs" #-}

scale :: (Cairo) -> (Double) -> (Double) -> IO ()
scale a1 a2 a3 =
  withManagedPtr a1 $ \a1' ->
  let {a2' = realToFrac a2} in
  let {a3' = realToFrac a3} in
  scale'_ a1' a2' a3' >>
  return ()

{-# LINE 27 "./GI/Cairo/Render/Internal/Drawing/Transformations.chs" #-}

rotate :: (Cairo) -> (Double) -> IO ()
rotate a1 a2 =
  withManagedPtr a1 $ \a1' ->
  let {a2' = realToFrac a2} in
  rotate'_ a1' a2' >>
  return ()

{-# LINE 28 "./GI/Cairo/Render/Internal/Drawing/Transformations.chs" #-}

transform :: (Cairo) -> (Matrix) -> IO ()
transform a1 a2 =
  withManagedPtr a1 $ \a1' ->
  with a2 $ \a2' ->
  transform'_ a1' a2' >>
  return ()

{-# LINE 29 "./GI/Cairo/Render/Internal/Drawing/Transformations.chs" #-}

setMatrix :: (Cairo) -> (Matrix) -> IO ()
setMatrix a1 a2 =
  withManagedPtr a1 $ \a1' ->
  with a2 $ \a2' ->
  setMatrix'_ a1' a2' >>
  return ()

{-# LINE 30 "./GI/Cairo/Render/Internal/Drawing/Transformations.chs" #-}

getMatrix :: (Cairo) -> IO ((Matrix))
getMatrix a1 =
  withManagedPtr a1 $ \a1' ->
  alloca $ \a2' ->
  getMatrix'_ a1' a2' >>
  peek  a2'>>= \a2'' ->
  return (a2'')

{-# LINE 31 "./GI/Cairo/Render/Internal/Drawing/Transformations.chs" #-}

identityMatrix :: (Cairo) -> IO ()
identityMatrix a1 =
  withManagedPtr a1 $ \a1' ->
  identityMatrix'_ a1' >>
  return ()

{-# LINE 32 "./GI/Cairo/Render/Internal/Drawing/Transformations.chs" #-}

userToDevice :: (Cairo) -> (Double) -> (Double) -> IO ((Double), (Double))
userToDevice a1 a2 a3 =
  withManagedPtr a1 $ \a1' ->
  withFloatConv a2 $ \a2' ->
  withFloatConv a3 $ \a3' ->
  userToDevice'_ a1' a2' a3' >>
  peekFloatConv  a2'>>= \a2'' ->
  peekFloatConv  a3'>>= \a3'' ->
  return (a2'', a3'')

{-# LINE 33 "./GI/Cairo/Render/Internal/Drawing/Transformations.chs" #-}

userToDeviceDistance :: (Cairo) -> (Double) -> (Double) -> IO ((Double), (Double))
userToDeviceDistance a1 a2 a3 =
  withManagedPtr a1 $ \a1' ->
  withFloatConv a2 $ \a2' ->
  withFloatConv a3 $ \a3' ->
  userToDeviceDistance'_ a1' a2' a3' >>
  peekFloatConv  a2'>>= \a2'' ->
  peekFloatConv  a3'>>= \a3'' ->
  return (a2'', a3'')

{-# LINE 34 "./GI/Cairo/Render/Internal/Drawing/Transformations.chs" #-}

deviceToUser :: (Cairo) -> (Double) -> (Double) -> IO ((Double), (Double))
deviceToUser a1 a2 a3 =
  withManagedPtr a1 $ \a1' ->
  withFloatConv a2 $ \a2' ->
  withFloatConv a3 $ \a3' ->
  deviceToUser'_ a1' a2' a3' >>
  peekFloatConv  a2'>>= \a2'' ->
  peekFloatConv  a3'>>= \a3'' ->
  return (a2'', a3'')

{-# LINE 35 "./GI/Cairo/Render/Internal/Drawing/Transformations.chs" #-}

deviceToUserDistance :: (Cairo) -> (Double) -> (Double) -> IO ((Double), (Double))
deviceToUserDistance a1 a2 a3 =
  withManagedPtr a1 $ \a1' ->
  withFloatConv a2 $ \a2' ->
  withFloatConv a3 $ \a3' ->
  deviceToUserDistance'_ a1' a2' a3' >>
  peekFloatConv  a2'>>= \a2'' ->
  peekFloatConv  a3'>>= \a3'' ->
  return (a2'', a3'')

{-# LINE 36 "./GI/Cairo/Render/Internal/Drawing/Transformations.chs" #-}


foreign import ccall safe "GI/Cairo/Render/Internal/Drawing/Transformations.chs.h cairo_translate"
  translate'_ :: ((CairoPtr) -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (IO ()))))

foreign import ccall safe "GI/Cairo/Render/Internal/Drawing/Transformations.chs.h cairo_scale"
  scale'_ :: ((CairoPtr) -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (IO ()))))

foreign import ccall safe "GI/Cairo/Render/Internal/Drawing/Transformations.chs.h cairo_rotate"
  rotate'_ :: ((CairoPtr) -> (C2HSImp.CDouble -> (IO ())))

foreign import ccall safe "GI/Cairo/Render/Internal/Drawing/Transformations.chs.h cairo_transform"
  transform'_ :: ((CairoPtr) -> ((MatrixPtr) -> (IO ())))

foreign import ccall safe "GI/Cairo/Render/Internal/Drawing/Transformations.chs.h cairo_set_matrix"
  setMatrix'_ :: ((CairoPtr) -> ((MatrixPtr) -> (IO ())))

foreign import ccall safe "GI/Cairo/Render/Internal/Drawing/Transformations.chs.h cairo_get_matrix"
  getMatrix'_ :: ((CairoPtr) -> ((MatrixPtr) -> (IO ())))

foreign import ccall safe "GI/Cairo/Render/Internal/Drawing/Transformations.chs.h cairo_identity_matrix"
  identityMatrix'_ :: ((CairoPtr) -> (IO ()))

foreign import ccall safe "GI/Cairo/Render/Internal/Drawing/Transformations.chs.h cairo_user_to_device"
  userToDevice'_ :: ((CairoPtr) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (IO ()))))

foreign import ccall safe "GI/Cairo/Render/Internal/Drawing/Transformations.chs.h cairo_user_to_device_distance"
  userToDeviceDistance'_ :: ((CairoPtr) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (IO ()))))

foreign import ccall safe "GI/Cairo/Render/Internal/Drawing/Transformations.chs.h cairo_device_to_user"
  deviceToUser'_ :: ((CairoPtr) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (IO ()))))

foreign import ccall safe "GI/Cairo/Render/Internal/Drawing/Transformations.chs.h cairo_device_to_user_distance"
  deviceToUserDistance'_ :: ((CairoPtr) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (IO ()))))