{-# LINE 1 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
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
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)
(\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 ()))))))