{-# 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 -> Ptr CPath
unPath (CPath Ptr CPath
p) = Ptr CPath
p
getCurrentPoint :: Cairo -> IO (Double, Double)
getCurrentPoint :: Cairo -> IO (Double, Double)
getCurrentPoint Cairo
a1 =
let {a1' :: Ptr Cairo
a1' = Cairo -> Ptr Cairo
unCairo Cairo
a1} in
(Ptr CDouble -> IO (Double, Double)) -> IO (Double, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Double, Double)) -> IO (Double, Double))
-> (Ptr CDouble -> IO (Double, Double)) -> IO (Double, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
a2' ->
(Ptr CDouble -> IO (Double, Double)) -> IO (Double, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Double, Double)) -> IO (Double, Double))
-> (Ptr CDouble -> IO (Double, Double)) -> IO (Double, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr Cairo
a3' ->
getCurrentPoint'_ a1' a2' a3' >>= \res ->
peekFloatConv a2'>>= \a2'' ->
peekFloatConv a3'>>= \Double
a3'' ->
(Double, Double) -> IO (Double, Double)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
a2'', Double
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 :: Cairo -> IO [PathElement]
copyPathFlat Cairo
ctx = do
CPath
p <- Cairo -> IO CPath
copyPathFlatC Cairo
ctx
[PathElement]
xs <- CPath -> IO [PathElement]
pathToList CPath
p
CPath -> IO ()
pathDestroy CPath
p
[PathElement] -> IO [PathElement]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [PathElement]
xs
appendPath :: Cairo -> [PathElement] -> IO ()
appendPath :: Cairo -> [PathElement] -> IO ()
appendPath Cairo
ctx [PathElement]
es = do
CPath
path <- [PathElement] -> IO CPath
mkPathPtr [PathElement]
es
Cairo -> CPath -> IO ()
appendPathC Cairo
ctx CPath
path
CPath -> IO ()
deallocPath CPath
path
pathToList :: CPath -> IO [PathElement]
pathToList :: CPath -> IO [PathElement]
pathToList CPath
p = [PathDataRecord] -> [PathElement]
pathToList' ([PathDataRecord] -> [PathElement])
-> IO [PathDataRecord] -> IO [PathElement]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CPath -> IO [PathDataRecord]
pathToList'' CPath
p
pathToList' :: [PathDataRecord] -> [PathElement]
pathToList' :: [PathDataRecord] -> [PathElement]
pathToList' [] = []
pathToList' ((PathHeaderRecord PathDataRecordType
htype Int
hlen):[PathDataRecord]
rs)
| Int
hlen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 = let ([PathDataRecord]
mine,[PathDataRecord]
rest) = Int -> [PathDataRecord] -> ([PathDataRecord], [PathDataRecord])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
hlenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [PathDataRecord]
rs
in (PathDataRecordType -> [PathDataRecord] -> PathElement
consElem PathDataRecordType
htype [PathDataRecord]
mine) PathElement -> [PathElement] -> [PathElement]
forall a. a -> [a] -> [a]
: [PathDataRecord] -> [PathElement]
pathToList' [PathDataRecord]
rest
| Bool
otherwise = String -> [PathElement]
forall a. HasCallStack => String -> a
error String
"invalid path data (invalid header length)"
pathToList' [PathDataRecord]
_ = String -> [PathElement]
forall a. HasCallStack => String -> a
error String
"invalid path data (expected header record)"
pathToList'' :: CPath -> IO [PathDataRecord]
pathToList'' :: CPath -> IO [PathDataRecord]
pathToList'' (CPath Ptr CPath
p) = do
CInt
numdata <- (\Ptr CPath
ptr -> do {Ptr CPath -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CPath
ptr Int
16 ::IO CInt}) Ptr CPath
p
Ptr ()
dptr <- (\Ptr CPath
ptr -> do {Ptr CPath -> Int -> IO (Ptr ())
forall b. Ptr b -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CPath
ptr Int
8 ::IO (Ptr ())}) Ptr CPath
p
Int -> Int -> Ptr PathDataRecord -> IO [PathDataRecord]
getPathData Int
0 (CInt -> Int
forall a b. (Integral a, Integral b) => a -> b
cIntConv CInt
numdata) (Ptr () -> Ptr PathDataRecord
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
dptr)
where size :: Int
size = Int
16
{-# LINE 106 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
getPathData :: Int -> Int -> Ptr PathDataRecord -> IO [PathDataRecord]
getPathData :: Int -> Int -> Ptr PathDataRecord -> IO [PathDataRecord]
getPathData Int
currpos Int
numdata Ptr PathDataRecord
dptr
| Int
currpos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
numdata = do
let dptr' :: Ptr b
dptr' = Ptr PathDataRecord
dptr Ptr PathDataRecord -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
currpos)
h :: PathDataRecord
h@(PathHeaderRecord PathDataRecordType
_ Int
hlen) <- Ptr PathDataRecord -> IO PathDataRecord
peekHeader Ptr PathDataRecord
forall {b}. Ptr b
dptr'
[PathDataRecord]
ds <- Ptr PathDataRecord -> Int -> IO [PathDataRecord]
peekPoints Ptr PathDataRecord
forall {b}. Ptr b
dptr' Int
hlen
[PathDataRecord]
rest <- Int -> Int -> Ptr PathDataRecord -> IO [PathDataRecord]
getPathData (Int
currposInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
hlen) Int
numdata Ptr PathDataRecord
dptr
[PathDataRecord] -> IO [PathDataRecord]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return([PathDataRecord] -> IO [PathDataRecord])
-> [PathDataRecord] -> IO [PathDataRecord]
forall a b. (a -> b) -> a -> b
$ PathDataRecord
hPathDataRecord -> [PathDataRecord] -> [PathDataRecord]
forall a. a -> [a] -> [a]
:([PathDataRecord]
ds[PathDataRecord] -> [PathDataRecord] -> [PathDataRecord]
forall a. [a] -> [a] -> [a]
++[PathDataRecord]
rest)
| Bool
otherwise = [PathDataRecord] -> IO [PathDataRecord]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
peekHeader :: Ptr PathDataRecord -> IO PathDataRecord
peekHeader :: Ptr PathDataRecord -> IO PathDataRecord
peekHeader Ptr PathDataRecord
p = do
CInt
htype <- Ptr PathDataRecord -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr PathDataRecord
p Int
0 :: IO CInt
CInt
hlen <- (\Ptr PathDataRecord
ptr -> do {Ptr PathDataRecord -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr PathDataRecord
ptr Int
4 ::IO CInt}) Ptr PathDataRecord
p
PathDataRecord -> IO PathDataRecord
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(PathDataRecord -> IO PathDataRecord)
-> PathDataRecord -> IO PathDataRecord
forall a b. (a -> b) -> a -> b
$ PathDataRecordType -> Int -> PathDataRecord
PathHeaderRecord (CInt -> PathDataRecordType
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
htype) (CInt -> Int
forall a b. (Integral a, Integral b) => a -> b
cIntConv CInt
hlen)
peekPoint :: Ptr PathDataRecord -> IO PathDataRecord
peekPoint :: Ptr PathDataRecord -> IO PathDataRecord
peekPoint Ptr PathDataRecord
p = do
CDouble
x <- (\Ptr PathDataRecord
ptr -> do {Ptr PathDataRecord -> Int -> IO CDouble
forall b. Ptr b -> Int -> IO CDouble
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr PathDataRecord
ptr Int
0 ::IO CDouble}) Ptr PathDataRecord
p
CDouble
y <- (\Ptr PathDataRecord
ptr -> do {Ptr PathDataRecord -> Int -> IO CDouble
forall b. Ptr b -> Int -> IO CDouble
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr PathDataRecord
ptr Int
8 ::IO CDouble}) Ptr PathDataRecord
p
PathDataRecord -> IO PathDataRecord
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(PathDataRecord -> IO PathDataRecord)
-> PathDataRecord -> IO PathDataRecord
forall a b. (a -> b) -> a -> b
$ Double -> Double -> PathDataRecord
PathPointRecord (CDouble -> Double
forall a b. (RealFloat a, RealFloat b) => a -> b
cFloatConv CDouble
x) (CDouble -> Double
forall a b. (RealFloat a, RealFloat b) => a -> b
cFloatConv CDouble
y)
peekPoints :: Ptr PathDataRecord -> Int -> IO [PathDataRecord]
peekPoints :: Ptr PathDataRecord -> Int -> IO [PathDataRecord]
peekPoints Ptr PathDataRecord
p Int
n = (Int -> IO PathDataRecord) -> [Int] -> IO [PathDataRecord]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Int
i -> Ptr PathDataRecord -> IO PathDataRecord
peekPoint (Ptr PathDataRecord
p Ptr PathDataRecord -> Int -> Ptr PathDataRecord
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i))) [Int
1..(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]
getPts :: PathDataRecord -> (Double, Double)
getPts = \(PathPointRecord Double
x Double
y) -> (Double
x,Double
y)
pokeRecord :: Ptr PathDataRecord -> PathDataRecord -> IO ()
pokeRecord :: Ptr PathDataRecord -> PathDataRecord -> IO ()
pokeRecord Ptr PathDataRecord
ptr (PathHeaderRecord PathDataRecordType
htype Int
hlen) = do
Ptr PathDataRecord -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr PathDataRecord
ptr Int
0 (PathDataRecordType -> CInt
forall e i. (Enum e, Integral i) => e -> i
cFromEnum PathDataRecordType
htype :: CInt)
(\Ptr PathDataRecord
ptr CInt
val -> do {Ptr PathDataRecord -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr PathDataRecord
ptr Int
4 (CInt
val::CInt)}) Ptr PathDataRecord
ptr (Int -> CInt
forall a b. (Integral a, Integral b) => a -> b
cIntConv Int
hlen)
pokeRecord Ptr PathDataRecord
ptr (PathPointRecord Double
x Double
y) = do
(\Ptr PathDataRecord
ptr CDouble
val -> do {Ptr PathDataRecord -> Int -> CDouble -> IO ()
forall b. Ptr b -> Int -> CDouble -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr PathDataRecord
ptr Int
0 (CDouble
val::CDouble)}) Ptr PathDataRecord
ptr (Double -> CDouble
forall a b. (RealFloat a, RealFloat b) => a -> b
cFloatConv Double
x)
(\Ptr PathDataRecord
ptr CDouble
val -> do {Ptr PathDataRecord -> Int -> CDouble -> IO ()
forall b. Ptr b -> Int -> CDouble -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr PathDataRecord
ptr Int
8 (CDouble
val::CDouble)}) Ptr PathDataRecord
ptr (Double -> CDouble
forall a b. (RealFloat a, RealFloat b) => a -> b
cFloatConv Double
y)
consElem :: PathDataRecordType -> [PathDataRecord] -> PathElement
consElem :: PathDataRecordType -> [PathDataRecord] -> PathElement
consElem PathDataRecordType
PathMoveTo [PathDataRecord]
ps
| [PathDataRecord] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PathDataRecord]
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = String -> PathElement
forall a. HasCallStack => String -> a
error String
"invalid path data (not enough points)"
| Bool
otherwise = (Double -> Double -> PathElement)
-> (Double, Double) -> PathElement
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Double -> PathElement
MoveTo ((Double, Double) -> PathElement)
-> (Double, Double) -> PathElement
forall a b. (a -> b) -> a -> b
$ PathDataRecord -> (Double, Double)
getPts ([PathDataRecord]
ps[PathDataRecord] -> Int -> PathDataRecord
forall a. HasCallStack => [a] -> Int -> a
!!Int
0)
consElem PathDataRecordType
PathLineTo [PathDataRecord]
ps
| [PathDataRecord] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PathDataRecord]
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = String -> PathElement
forall a. HasCallStack => String -> a
error String
"invalid path data (not enough points)"
| Bool
otherwise = (Double -> Double -> PathElement)
-> (Double, Double) -> PathElement
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Double -> PathElement
LineTo ((Double, Double) -> PathElement)
-> (Double, Double) -> PathElement
forall a b. (a -> b) -> a -> b
$ PathDataRecord -> (Double, Double)
getPts ([PathDataRecord]
ps[PathDataRecord] -> Int -> PathDataRecord
forall a. HasCallStack => [a] -> Int -> a
!!Int
0)
consElem PathDataRecordType
PathCurveTo [PathDataRecord]
ps
| [PathDataRecord] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PathDataRecord]
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 = String -> PathElement
forall a. HasCallStack => String -> a
error String
"invalid path data (not enough points)"
| Bool
otherwise = let ps' :: [(Double, Double)]
ps' = (PathDataRecord -> (Double, Double))
-> [PathDataRecord] -> [(Double, Double)]
forall a b. (a -> b) -> [a] -> [b]
map PathDataRecord -> (Double, Double)
getPts (Int -> [PathDataRecord] -> [PathDataRecord]
forall a. Int -> [a] -> [a]
take Int
3 [PathDataRecord]
ps)
in (Double -> Double -> PathElement)
-> (Double, Double) -> PathElement
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Double -> Double -> Double -> Double -> PathElement)
-> (Double, Double) -> Double -> Double -> PathElement
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Double
-> Double -> Double -> Double -> Double -> Double -> PathElement)
-> (Double, Double)
-> Double
-> Double
-> Double
-> Double
-> PathElement
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double
-> Double -> Double -> Double -> Double -> Double -> PathElement
CurveTo ([(Double, Double)]
ps'[(Double, Double)] -> Int -> (Double, Double)
forall a. HasCallStack => [a] -> Int -> a
!!Int
0)) ([(Double, Double)]
ps'[(Double, Double)] -> Int -> (Double, Double)
forall a. HasCallStack => [a] -> Int -> a
!!Int
1)) ([(Double, Double)]
ps'[(Double, Double)] -> Int -> (Double, Double)
forall a. HasCallStack => [a] -> Int -> a
!!Int
2)
consElem PathDataRecordType
PathClosePath [PathDataRecord]
ps = PathElement
ClosePath
consRecs :: PathElement -> [PathDataRecord]
consRecs :: PathElement -> [PathDataRecord]
consRecs (MoveTo Double
x Double
y) =
[ PathDataRecordType -> Int -> PathDataRecord
PathHeaderRecord PathDataRecordType
PathMoveTo Int
2, Double -> Double -> PathDataRecord
PathPointRecord Double
x Double
y]
consRecs (LineTo Double
x Double
y) =
[ PathDataRecordType -> Int -> PathDataRecord
PathHeaderRecord PathDataRecordType
PathLineTo Int
2, Double -> Double -> PathDataRecord
PathPointRecord Double
x Double
y]
consRecs (CurveTo Double
x₀ Double
y₀ Double
x₁ Double
y₁ Double
x₂ Double
y₂) =
[ PathDataRecordType -> Int -> PathDataRecord
PathHeaderRecord PathDataRecordType
PathCurveTo Int
4
, Double -> Double -> PathDataRecord
PathPointRecord Double
x₀ Double
y₀
, Double -> Double -> PathDataRecord
PathPointRecord Double
x₁ Double
y₁
, Double -> Double -> PathDataRecord
PathPointRecord Double
x₂ Double
y₂
]
consRecs PathElement
ClosePath = [PathDataRecordType -> Int -> PathDataRecord
PathHeaderRecord PathDataRecordType
PathClosePath Int
1]
mkPathPtr :: [PathElement] -> IO CPath
mkPathPtr :: [PathElement] -> IO CPath
mkPathPtr [PathElement]
es = do
(Ptr PathDataRecord
dptr,Int
numdata) <- [PathElement] -> IO (Ptr PathDataRecord, Int)
mkDataPtr [PathElement]
es
Ptr CPath
ptr <- Int -> IO (Ptr CPath)
forall a. Int -> IO (Ptr a)
mallocBytes Int
24
{-# LINE 186 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
(\ptr val -> do {pokeByteOff ptr 0 (val::CInt)}) ptr (cFromEnum StatusSuccess)
(\Ptr CPath
ptr Ptr ()
val -> do {Ptr CPath -> Int -> Ptr () -> IO ()
forall b. Ptr b -> Int -> Ptr () -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CPath
ptr Int
8 (Ptr ()
val::(Ptr ()))}) Ptr CPath
ptr (Ptr PathDataRecord -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr PathDataRecord
dptr)
(\Ptr CPath
ptr CInt
val -> do {Ptr CPath -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CPath
ptr Int
16 (CInt
val::CInt)}) Ptr CPath
ptr (Int -> CInt
forall a b. (Integral a, Integral b) => a -> b
cIntConv Int
numdata)
CPath -> IO CPath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr CPath -> CPath
CPath Ptr CPath
ptr)
mkDataPtr :: [PathElement] -> IO (Ptr PathDataRecord, Int)
mkDataPtr :: [PathElement] -> IO (Ptr PathDataRecord, Int)
mkDataPtr [PathElement]
es = do
let rs :: [PathDataRecord]
rs = (PathElement -> [PathDataRecord])
-> [PathElement] -> [PathDataRecord]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PathElement -> [PathDataRecord]
consRecs [PathElement]
es
len :: Int
len = [PathDataRecord] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PathDataRecord]
rs
size :: Int
size = Int
16
{-# LINE 198 "./Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs" #-}
dptr <- mallocBytes (len*size) :: IO (Ptr PathDataRecord)
((PathDataRecord, Int) -> IO ())
-> [(PathDataRecord, Int)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(PathDataRecord
r,Int
i) -> Ptr PathDataRecord -> PathDataRecord -> IO ()
pokeRecord (Ptr PathDataRecord
dptr Ptr PathDataRecord -> Int -> Ptr PathDataRecord
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
size)) PathDataRecord
r) ([PathDataRecord] -> [Int] -> [(PathDataRecord, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [PathDataRecord]
rs [Int
0..])
(Ptr PathDataRecord, Int) -> IO (Ptr PathDataRecord, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr PathDataRecord
dptr,Int
len)
deallocPath :: CPath -> IO ()
deallocPath :: CPath -> IO ()
deallocPath (CPath Ptr CPath
ptr) = do
Ptr ()
dptr <- (\Ptr CPath
ptr -> do {Ptr CPath -> Int -> IO (Ptr ())
forall b. Ptr b -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CPath
ptr Int
8 ::IO (Ptr ())}) Ptr CPath
ptr
Ptr () -> IO ()
forall a. Ptr a -> IO ()
free Ptr ()
dptr
Ptr CPath -> IO ()
forall a. Ptr a -> IO ()
free Ptr CPath
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 ()))))))