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


{-# LINE 1 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Cairo.Internal.Drawing.Paths
-- Copyright   :  (c) Paolo Martini 2005
-- License     :  BSD-style (see cairo/COPYRIGHT)
--
-- Maintainer  :  p.martini@neuralnoise.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Creating paths and manipulating path data.
-----------------------------------------------------------------------------

module Graphics.Rendering.Cairo.Internal.Drawing.Paths where

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

import Foreign
import Foreign.C
import Foreign.Marshal.Alloc (mallocBytes,finalizerFree)

import Graphics.Rendering.Cairo.Internal.Utilities (CairoString(..))


{-# LINE 24 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}

newtype CPath = CPath (Ptr (CPath))
{-# LINE 26 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
unPath :: CPath -> Ptr CPath
unPath (CPath p) = p


getCurrentPoint :: Cairo -> IO (Double, Double)
getCurrentPoint a1 =
  let {a1' = unCairo a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  getCurrentPoint'_ a1' a2' a3' >>= \res ->
  peekFloatConv a2'>>= \a2'' -> 
  peekFloatConv a3'>>= \a3'' -> 
  return (a2'', a3'')
{-# LINE 31 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
newPath :: Cairo -> IO ()
newPath a1 =
  let {a1' = unCairo a1} in 
  newPath'_ a1' >>= \res ->
  return ()
{-# LINE 32 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
closePath :: Cairo -> IO ()
closePath a1 =
  let {a1' = unCairo a1} in 
  closePath'_ a1' >>= \res ->
  return ()
{-# LINE 33 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
arc :: Cairo -> Double -> Double -> Double -> Double -> Double -> IO ()
arc a1 a2 a3 a4 a5 a6 =
  let {a1' = unCairo a1} in 
  let {a2' = cFloatConv a2} in 
  let {a3' = cFloatConv a3} in 
  let {a4' = cFloatConv a4} in 
  let {a5' = cFloatConv a5} in 
  let {a6' = cFloatConv a6} in 
  arc'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  return ()
{-# LINE 34 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
arcNegative :: Cairo -> Double -> Double -> Double -> Double -> Double -> IO ()
arcNegative a1 a2 a3 a4 a5 a6 =
  let {a1' = unCairo a1} in 
  let {a2' = cFloatConv a2} in 
  let {a3' = cFloatConv a3} in 
  let {a4' = cFloatConv a4} in 
  let {a5' = cFloatConv a5} in 
  let {a6' = cFloatConv a6} in 
  arcNegative'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  return ()
{-# LINE 35 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
curveTo :: Cairo -> Double -> Double -> Double -> Double -> Double -> Double -> IO ()
curveTo a1 a2 a3 a4 a5 a6 a7 =
  let {a1' = unCairo a1} in 
  let {a2' = cFloatConv a2} in 
  let {a3' = cFloatConv a3} in 
  let {a4' = cFloatConv a4} in 
  let {a5' = cFloatConv a5} in 
  let {a6' = cFloatConv a6} in 
  let {a7' = cFloatConv a7} in 
  curveTo'_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
  return ()
{-# LINE 36 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
lineTo :: Cairo -> Double -> Double -> IO ()
lineTo a1 a2 a3 =
  let {a1' = unCairo a1} in 
  let {a2' = cFloatConv a2} in 
  let {a3' = cFloatConv a3} in 
  lineTo'_ a1' a2' a3' >>= \res ->
  return ()
{-# LINE 37 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
moveTo :: Cairo -> Double -> Double -> IO ()
moveTo a1 a2 a3 =
  let {a1' = unCairo a1} in 
  let {a2' = cFloatConv a2} in 
  let {a3' = cFloatConv a3} in 
  moveTo'_ a1' a2' a3' >>= \res ->
  return ()
{-# LINE 38 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
rectangle :: Cairo -> Double -> Double -> Double -> Double -> IO ()
rectangle a1 a2 a3 a4 a5 =
  let {a1' = unCairo a1} in 
  let {a2' = cFloatConv a2} in 
  let {a3' = cFloatConv a3} in 
  let {a4' = cFloatConv a4} in 
  let {a5' = cFloatConv a5} in 
  rectangle'_ a1' a2' a3' a4' a5' >>= \res ->
  return ()
{-# LINE 39 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
textPath :: CairoString string => Cairo -> string -> IO ()
textPath c string =
    withUTFString string $ \string' ->
    (\(Cairo arg1) arg2 -> cairo_text_path arg1 arg2)
{-# LINE 43 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
        c string'
relCurveTo :: Cairo -> Double -> Double -> Double -> Double -> Double -> Double -> IO ()
relCurveTo a1 a2 a3 a4 a5 a6 a7 =
  let {a1' = unCairo a1} in 
  let {a2' = cFloatConv a2} in 
  let {a3' = cFloatConv a3} in 
  let {a4' = cFloatConv a4} in 
  let {a5' = cFloatConv a5} in 
  let {a6' = cFloatConv a6} in 
  let {a7' = cFloatConv a7} in 
  relCurveTo'_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
  return ()
{-# LINE 45 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
relLineTo :: Cairo -> Double -> Double -> IO ()
relLineTo a1 a2 a3 =
  let {a1' = unCairo a1} in 
  let {a2' = cFloatConv a2} in 
  let {a3' = cFloatConv a3} in 
  relLineTo'_ a1' a2' a3' >>= \res ->
  return ()
{-# LINE 46 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
relMoveTo :: Cairo -> Double -> Double -> IO ()
relMoveTo a1 a2 a3 =
  let {a1' = unCairo a1} in 
  let {a2' = cFloatConv a2} in 
  let {a3' = cFloatConv a3} in 
  relMoveTo'_ a1' a2' a3' >>= \res ->
  return ()
{-# LINE 47 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
copyPathC :: Cairo -> IO (CPath)
copyPathC a1 =
  let {a1' = unCairo a1} in 
  copyPathC'_ a1' >>= \res ->
  let {res' = CPath res} in
  return (res')
{-# LINE 48 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
copyPathFlatC :: Cairo -> IO (CPath)
copyPathFlatC a1 =
  let {a1' = unCairo a1} in 
  copyPathFlatC'_ a1' >>= \res ->
  let {res' = CPath res} in
  return (res')
{-# LINE 49 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
appendPathC :: Cairo -> CPath -> IO ()
appendPathC a1 a2 =
  let {a1' = unCairo a1} in 
  let {a2' = unPath a2} in 
  appendPathC'_ a1' a2' >>= \res ->
  return ()
{-# LINE 50 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
pathDestroy :: CPath -> IO ()
pathDestroy a1 =
  let {a1' = unPath a1} in 
  pathDestroy'_ a1' >>= \res ->
  return ()
{-# LINE 51 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
pathExtents :: Cairo -> IO (Double, Double, Double, Double)
pathExtents a1 =
  let {a1' = unCairo a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  alloca $ \a4' -> 
  alloca $ \a5' -> 
  pathExtents'_ a1' a2' a3' a4' a5' >>= \res ->
  peekFloatConv a2'>>= \a2'' -> 
  peekFloatConv a3'>>= \a3'' -> 
  peekFloatConv a4'>>= \a4'' -> 
  peekFloatConv a5'>>= \a5'' -> 
  return (a2'', a3'', a4'', a5'')
{-# LINE 52 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}

data PathDataRecordType = PathMoveTo
                        | PathLineTo
                        | PathCurveTo
                        | PathClosePath
                        deriving (Enum,Eq,Show)

{-# LINE 54 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}

data PathDataRecord
 = PathHeaderRecord PathDataRecordType Int
 | PathPointRecord Double Double
 deriving (Eq,Show)


copyPath :: Cairo -> IO [PathElement]
copyPath ctx = do
   p <- copyPathC ctx
   xs <- pathToList p
   pathDestroy p
   return xs


copyPathFlat :: Cairo -> IO [PathElement]
copyPathFlat ctx = do
   p <- copyPathFlatC ctx
   xs <- pathToList p
   pathDestroy p
   return xs


appendPath :: Cairo -> [PathElement] -> IO ()
appendPath ctx es = do
   path <- mkPathPtr es
   appendPathC ctx path
   deallocPath path


pathToList :: CPath -> IO [PathElement]
pathToList p  =  pathToList' <$> pathToList'' p



pathToList' :: [PathDataRecord] -> [PathElement]
pathToList' [] = []
pathToList' ((PathHeaderRecord htype hlen):rs)
   | hlen >= 1 = let (mine,rest) = splitAt (hlen-1) rs
                 in  (consElem htype mine) : pathToList' rest
   | otherwise = error "invalid path data (invalid header length)"
pathToList' _ = error "invalid path data (expected header record)"



pathToList'' :: CPath -> IO [PathDataRecord]
pathToList'' (CPath p) = do
      numdata <- (\ptr -> do {peekByteOff ptr 16 ::IO CInt}) p
      dptr    <- (\ptr -> do {peekByteOff ptr 8 ::IO (Ptr ())}) p
      getPathData 0 (cIntConv numdata) (castPtr dptr)

  where  size = 16
{-# LINE 106 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
         getPathData :: Int -> Int -> Ptr PathDataRecord -> IO [PathDataRecord]
         getPathData currpos numdata dptr
            | currpos < numdata = do
               let dptr' = dptr `plusPtr` (size*currpos)
               h@(PathHeaderRecord _ hlen) <- peekHeader dptr'
               ds <- peekPoints dptr' hlen
               rest <- getPathData (currpos+hlen) numdata dptr
               return$ h:(ds++rest)
            | otherwise = return []

         peekHeader :: Ptr PathDataRecord -> IO PathDataRecord
         peekHeader p = do
            -- the more intuitive statement
            --     htype <- {#get path_data_t->header.type #} p
            -- generates an error
            -- "CHS module contains errors: The phrase `type' is not allowed here."
            htype <- peekByteOff p 0 :: IO CInt
            hlen <- (\ptr -> do {peekByteOff ptr 4 ::IO CInt}) p
            return$ PathHeaderRecord (cToEnum htype) (cIntConv hlen)

         peekPoint :: Ptr PathDataRecord -> IO PathDataRecord
         peekPoint p = do
            x <- (\ptr -> do {peekByteOff ptr 0 ::IO CDouble}) p
            y <- (\ptr -> do {peekByteOff ptr 8 ::IO CDouble}) p
            return$ PathPointRecord (cFloatConv x) (cFloatConv y)

         peekPoints :: Ptr PathDataRecord -> Int -> IO [PathDataRecord]
         peekPoints p n = mapM (\i -> peekPoint (p `plusPtr` (size*i))) [1..(n-1)]



getPts = \(PathPointRecord x y) -> (x,y)


pokeRecord :: Ptr PathDataRecord -> PathDataRecord -> IO ()
pokeRecord ptr (PathHeaderRecord htype hlen) = do
   pokeByteOff ptr 0 (cFromEnum htype :: CInt)  -- the member named 'type' of the header is misunderstood by c2hs (see above)
   (\ptr val -> do {pokeByteOff ptr 4 (val::CInt)}) ptr (cIntConv hlen)

pokeRecord ptr (PathPointRecord x y) = do
   (\ptr val -> do {pokeByteOff ptr 0 (val::CDouble)}) ptr (cFloatConv x)
   (\ptr val -> do {pokeByteOff ptr 8 (val::CDouble)}) ptr (cFloatConv y)





consElem :: PathDataRecordType -> [PathDataRecord] -> PathElement
consElem PathMoveTo ps
   | length ps < 1   = error "invalid path data (not enough points)"
   | otherwise       = uncurry MoveTo $ getPts (ps!!0)
consElem PathLineTo ps
   | length ps < 1   = error "invalid path data (not enough points)"
   | otherwise       = uncurry LineTo $ getPts (ps!!0)
consElem PathCurveTo ps
   | length ps < 3   = error "invalid path data (not enough points)"
   | otherwise       = let ps' = map getPts (take 3 ps)
                       in uncurry (uncurry (uncurry CurveTo (ps'!!0)) (ps'!!1)) (ps'!!2)
consElem PathClosePath ps = ClosePath


consRecs :: PathElement -> [PathDataRecord]
consRecs (MoveTo x y) =
   [ PathHeaderRecord PathMoveTo 2, PathPointRecord x y]
consRecs (LineTo x y) =
   [ PathHeaderRecord PathLineTo 2, PathPointRecord x y]
consRecs (CurveTo x₀ y₀ x₁ y₁ x₂ y₂) =
   [ PathHeaderRecord PathCurveTo 4
   , PathPointRecord x₀ y₀
   , PathPointRecord x₁ y₁
   , PathPointRecord x₂ y₂
   ]
consRecs ClosePath = [PathHeaderRecord PathClosePath 1]



mkPathPtr :: [PathElement] -> IO CPath
mkPathPtr es = do
   (dptr,numdata) <- mkDataPtr es
   ptr <- mallocBytes 24
{-# LINE 186 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
   (\ptr val -> do {pokeByteOff ptr 0 (val::CInt)}) ptr (cFromEnum StatusSuccess)
   (\ptr val -> do {pokeByteOff ptr 8 (val::(Ptr ()))}) ptr (castPtr dptr)
   (\ptr val -> do {pokeByteOff ptr 16 (val::CInt)}) ptr (cIntConv numdata)
   return (CPath ptr)



mkDataPtr :: [PathElement] -> IO (Ptr PathDataRecord, Int)
mkDataPtr es = do
   let rs = concatMap consRecs es
       len  = length rs
       size = 16
{-# LINE 198 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
   dptr <- mallocBytes (len*size) :: IO (Ptr PathDataRecord)
   mapM_ (\(r,i) -> pokeRecord (dptr `plusPtr` (i*size)) r) (zip rs [0..])
   return (dptr,len)


deallocPath :: CPath -> IO ()
deallocPath (CPath ptr) = do
   dptr <- (\ptr -> do {peekByteOff ptr 8 ::IO (Ptr ())}) ptr
   free dptr
   free ptr


foreign import ccall safe "cairo_get_current_point"
  getCurrentPoint'_ :: ((Ptr Cairo) -> ((Ptr CDouble) -> ((Ptr CDouble) -> (IO ()))))

foreign import ccall safe "cairo_new_path"
  newPath'_ :: ((Ptr Cairo) -> (IO ()))

foreign import ccall safe "cairo_close_path"
  closePath'_ :: ((Ptr Cairo) -> (IO ()))

foreign import ccall safe "cairo_arc"
  arc'_ :: ((Ptr Cairo) -> (CDouble -> (CDouble -> (CDouble -> (CDouble -> (CDouble -> (IO ())))))))

foreign import ccall safe "cairo_arc_negative"
  arcNegative'_ :: ((Ptr Cairo) -> (CDouble -> (CDouble -> (CDouble -> (CDouble -> (CDouble -> (IO ())))))))

foreign import ccall safe "cairo_curve_to"
  curveTo'_ :: ((Ptr Cairo) -> (CDouble -> (CDouble -> (CDouble -> (CDouble -> (CDouble -> (CDouble -> (IO ()))))))))

foreign import ccall safe "cairo_line_to"
  lineTo'_ :: ((Ptr Cairo) -> (CDouble -> (CDouble -> (IO ()))))

foreign import ccall safe "cairo_move_to"
  moveTo'_ :: ((Ptr Cairo) -> (CDouble -> (CDouble -> (IO ()))))

foreign import ccall safe "cairo_rectangle"
  rectangle'_ :: ((Ptr Cairo) -> (CDouble -> (CDouble -> (CDouble -> (CDouble -> (IO ()))))))

foreign import ccall safe "cairo_text_path"
  cairo_text_path :: ((Ptr Cairo) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "cairo_rel_curve_to"
  relCurveTo'_ :: ((Ptr Cairo) -> (CDouble -> (CDouble -> (CDouble -> (CDouble -> (CDouble -> (CDouble -> (IO ()))))))))

foreign import ccall safe "cairo_rel_line_to"
  relLineTo'_ :: ((Ptr Cairo) -> (CDouble -> (CDouble -> (IO ()))))

foreign import ccall safe "cairo_rel_move_to"
  relMoveTo'_ :: ((Ptr Cairo) -> (CDouble -> (CDouble -> (IO ()))))

foreign import ccall safe "cairo_copy_path"
  copyPathC'_ :: ((Ptr Cairo) -> (IO (Ptr CPath)))

foreign import ccall safe "cairo_copy_path_flat"
  copyPathFlatC'_ :: ((Ptr Cairo) -> (IO (Ptr CPath)))

foreign import ccall safe "cairo_append_path"
  appendPathC'_ :: ((Ptr Cairo) -> ((Ptr CPath) -> (IO ())))

foreign import ccall safe "cairo_path_destroy"
  pathDestroy'_ :: ((Ptr CPath) -> (IO ()))

foreign import ccall safe "cairo_path_extents"
  pathExtents'_ :: ((Ptr Cairo) -> ((Ptr CDouble) -> ((Ptr CDouble) -> ((Ptr CDouble) -> ((Ptr CDouble) -> (IO ()))))))